/** Read settings flags from a list
*
* may call Rf_error
*
* @param opts_fixed list
* @param allow_overlap
* @return flags
*
* @version 0.4-1 (Marek Gagolewski, 2014-12-07)
*
* @version 0.4-1 (Marek Gagolewski, 2014-12-08)
* add `overlap` option
*/
uint32_t StriContainerByteSearch::getByteSearchFlags(SEXP opts_fixed, bool allow_overlap)
{
uint32_t flags = 0;
if (!isNull(opts_fixed) && !Rf_isVectorList(opts_fixed))
Rf_error(MSG__ARG_EXPECTED_LIST, "opts_fixed"); // error() call allowed here
R_len_t narg = isNull(opts_fixed)?0:LENGTH(opts_fixed);
if (narg > 0) {
SEXP names = Rf_getAttrib(opts_fixed, R_NamesSymbol);
if (names == R_NilValue || LENGTH(names) != narg)
Rf_error(MSG__FIXED_CONFIG_FAILED); // error() call allowed here
for (R_len_t i=0; i<narg; ++i) {
if (STRING_ELT(names, i) == NA_STRING)
Rf_error(MSG__FIXED_CONFIG_FAILED); // error() call allowed here
const char* curname = CHAR(STRING_ELT(names, i));
if (!strcmp(curname, "case_insensitive")) {
bool val = stri__prepare_arg_logical_1_notNA(VECTOR_ELT(opts_fixed, i), "case_insensitive");
if (val) flags |= BYTESEARCH_CASE_INSENSITIVE;
} else if (!strcmp(curname, "overlap") && allow_overlap) {
bool val = stri__prepare_arg_logical_1_notNA(VECTOR_ELT(opts_fixed, i), "overlap");
if (val) flags |= BYTESEARCH_OVERLAP;
} else {
Rf_warning(MSG__INCORRECT_FIXED_OPTION, curname);
}
}
}
return flags;
}
/** Convert from UTF-32
*
* @param vec integer vector or list with integer vectors
* @return character vector
*
* @version 0.1 (Marek Gagolewski)
*/
SEXP stri_enc_fromutf32(SEXP vec)
{
if (Rf_isVectorList(vec)) {
R_len_t n = LENGTH(vec);
R_len_t bufsize = 0;
for (R_len_t i=0; i<n; ++i) {
SEXP cur = VECTOR_ELT(vec, i);
if (isNull(cur))
continue;
if (!Rf_isInteger(cur)) // this cannot be treated with stri_prepare_arg*, as vec may be a mem-shared object
Rf_error(MSG__ARG_EXPECTED_INTEGER_NO_COERCION, "vec[[i]]"); // error() allowed here
if (LENGTH(cur) > bufsize) bufsize = LENGTH(cur);
}
bufsize = U8_MAX_LENGTH*bufsize+1;
char* buf = new char[bufsize]; // no call to error() between new and delete -> OK
SEXP ret;
PROTECT(ret = Rf_allocVector(STRSXP, n));
for (R_len_t i=0; i<n; ++i) {
SEXP cur = VECTOR_ELT(vec, i);
if (isNull(cur)) {
SET_STRING_ELT(ret, i, NA_STRING);
continue;
}
R_len_t chars = stri__enc_fromutf32(INTEGER(cur), LENGTH(cur), buf, bufsize);
if (chars < 0)
SET_STRING_ELT(ret, i, NA_STRING);
else
SET_STRING_ELT(ret, i, Rf_mkCharLenCE(buf, chars, CE_UTF8));
}
delete [] buf;
UNPROTECT(1);
return ret;
}
else {
vec = stri_prepare_arg_integer(vec, "vec"); // integer vector
SEXP ret;
PROTECT(ret = Rf_allocVector(STRSXP, 1));
int* data = INTEGER(vec);
R_len_t ndata = LENGTH(vec);
R_len_t bufsize = U8_MAX_LENGTH*ndata+1;
char* buf = new char[bufsize]; // no call to error() between new and delete -> OK
R_len_t chars = stri__enc_fromutf32(data, ndata, buf, bufsize);
if (chars < 0)
SET_STRING_ELT(ret, 0, NA_STRING);
else
SET_STRING_ELT(ret, 0, Rf_mkCharLenCE(buf, chars, CE_UTF8));
delete [] buf;
UNPROTECT(1);
return ret;
}
}
/**
* Create & set up an ICU Collator
*
* WARNING: this fuction is allowed to call the error() function.
* Use before STRI__ERROR_HANDLER_BEGIN (with other prepareargs).
*
* @param opts_collator named R list
* @return a Collator object that should be closed with ucol_close() after use
*
*
* @version 0.1-?? (Marek Gagolewski)
*
* @version 0.2-1 (Marek Gagolewski, 2014-04-17)
* allow for NULL opts_collator (identical to list())
*
* @version 0.2-3 (Marek Gagolewski, 2014-05-09)
* disallow NA as opts_collator
*
* @version 0.3-1 (Marek Gagolewski, 2014-11-05)
* Issue #112: str_prepare_arg* retvals were not PROTECTed from gc;
* + many other bugs in settings establishment
*
* @version 0.3-1 (Marek Gagolewski, 2014-11-06)
* Fetch opts vals first to avoid memleaks (missing ucol_close calls on Rf_error)
*
* @version 0.4-1 (Marek Gagolewski, 2014-12-08)
* #23: add `overlap` option
*/
UCollator* stri__ucol_open(SEXP opts_collator)
{
if (!isNull(opts_collator) && !Rf_isVectorList(opts_collator))
Rf_error(MSG__INCORRECT_COLLATOR_OPTION_SPEC); // error() allowed here
R_len_t narg = isNull(opts_collator)?0:LENGTH(opts_collator);
if (narg <= 0) { // no custom settings - use default Collator
UErrorCode status = U_ZERO_ERROR;
UCollator* col = ucol_open(NULL, &status);
STRI__CHECKICUSTATUS_RFERROR(status, {/* do nothing special on err */}) // error() allowed here
return col;
/**
* Construct String Container from R object
* @param rstr R object
*
* if you want nrecycle > n, call set_nrecycle
*/
StriContainerListRaw::StriContainerListRaw(SEXP rstr)
{
this->data = NULL;
if (isNull(rstr)) {
this->init_Base(1, 1, true);
this->data = new String8[this->n]; // 1 string, NA
if (!this->data) throw StriException(MSG__MEM_ALLOC_ERROR);
}
else if (isRaw(rstr)) {
this->init_Base(1, 1, true);
this->data = new String8[this->n];
if (!this->data) throw StriException(MSG__MEM_ALLOC_ERROR);
this->data[0].initialize((const char*)RAW(rstr), LENGTH(rstr),
false/*memalloc*/, false/*killbom*/, false/*isASCII*/); // shallow copy
}
else if (Rf_isVectorList(rstr)) {
R_len_t nv = LENGTH(rstr);
this->init_Base(nv, nv, true);
this->data = new String8[this->n];
if (!this->data) throw StriException(MSG__MEM_ALLOC_ERROR);
for (R_len_t i=0; i<this->n; ++i) {
SEXP cur = VECTOR_ELT(rstr, i);
if (!isNull(cur))
this->data[i].initialize((const char*)RAW(cur), LENGTH(cur),
false/*memalloc*/, false/*killbom*/, false/*isASCII*/); // shallow copy
// else leave as-is, i.e. NA
}
}
else { // it's surely a character vector (args have been checked)
R_len_t nv = LENGTH(rstr);
this->init_Base(nv, nv, true);
this->data = new String8[this->n];
if (!this->data) throw StriException(MSG__MEM_ALLOC_ERROR);
for (R_len_t i=0; i<this->n; ++i) {
SEXP cur = STRING_ELT(rstr, i);
if (cur != NA_STRING)
this->data[i].initialize(CHAR(cur), LENGTH(cur),
false/*memalloc*/, false/*killbom*/, false/*isASCII*/); // shallow copy
// else leave as-is, i.e. NA
}
}
}
/**
* Construct String Container from R character vector
* @param rvec R list vector
* @param nrecycle extend length of each character vector stored [vectorization]
* @param shallowrecycle will stored character vectors be ever modified?
*/
StriContainerListUTF8::StriContainerListUTF8(SEXP rvec, R_len_t _nrecycle, bool _shallowrecycle)
{
this->data = NULL;
#ifndef NDEBUG
if (!Rf_isVectorList(rvec))
throw StriException("DEBUG: !isVectorList in StriContainerListUTF8::StriContainerListUTF8(SEXP rvec)");
#endif
R_len_t rvec_length = LENGTH(rvec);
this->init_Base(rvec_length, rvec_length, true);
if (this->n > 0) {
this->data = new StriContainerUTF8*[this->n];
if (!this->data) throw StriException(MSG__MEM_ALLOC_ERROR);
for (R_len_t i=0; i<this->n; ++i)
this->data[i] = NULL; // in case it fails during conversion (this is "NA")
for (R_len_t i=0; i<this->n; ++i) {
this->data[i] = new StriContainerUTF8(VECTOR_ELT(rvec, i), _nrecycle, _shallowrecycle);
if (!this->data[i]) throw StriException(MSG__MEM_ALLOC_ERROR);
}
}
}
/**
* Construct String Container from R character vector
* @param rstr R character vector
*
* if you want nrecycle > n, call set_nrecycle
*/
StriContainerListRaw::StriContainerListRaw(SEXP rstr)
{
this->data = NULL;
if (isNull(rstr)) {
this->init_Base(1, 1, true);
this->data = new String8*[this->n];
this->data[0] = NULL;
}
else if (isRaw(rstr)) {
this->init_Base(1, 1, true);
this->data = new String8*[this->n];
this->data[0] = new String8((const char*)RAW(rstr), LENGTH(rstr), false); // shallow copy
}
else if (Rf_isVectorList(rstr)) {
R_len_t nv = LENGTH(rstr);
this->init_Base(nv, nv, true);
this->data = new String8*[this->n];
for (R_len_t i=0; i<this->n; ++i) {
SEXP cur = VECTOR_ELT(rstr, i);
if (isNull(cur))
this->data[i] = NULL;
else
this->data[i] = new String8((const char*)RAW(cur), LENGTH(cur), false); // shallow copy
}
}
else {
R_len_t nv = LENGTH(rstr);
this->init_Base(nv, nv, true);
this->data = new String8*[this->n];
for (R_len_t i=0; i<this->n; ++i) {
SEXP cur = STRING_ELT(rstr, i);
if (cur == NA_STRING)
this->data[i] = NULL;
else
this->data[i] = new String8(CHAR(cur), LENGTH(cur), false); // shallow copy
}
}
}
/*
* Takes the prepared plan rsaved_plan and creates a cursor
* for it using the values specified in ragvalues.
*
*/
SEXP
plr_SPI_cursor_open(SEXP cursor_name_arg,SEXP rsaved_plan, SEXP rargvalues)
{
saved_plan_desc *plan_desc = (saved_plan_desc *) R_ExternalPtrAddr(rsaved_plan);
void *saved_plan = plan_desc->saved_plan;
int nargs = plan_desc->nargs;
Oid *typeids = plan_desc->typeids;
FmgrInfo *typinfuncs = plan_desc->typinfuncs;
int i;
Datum *argvalues = NULL;
char *nulls = NULL;
bool isnull = false;
SEXP obj;
SEXP result = NULL;
MemoryContext oldcontext;
char cursor_name[64];
Portal portal=NULL;
PREPARE_PG_TRY;
PUSH_PLERRCONTEXT(rsupport_error_callback, "pg.spi.cursor_open");
/* Divide rargvalues */
if (nargs > 0)
{
if (!Rf_isVectorList(rargvalues))
error("%s", "second parameter must be a list of arguments " \
"to the prepared plan");
if (length(rargvalues) != nargs)
error("list of arguments (%d) is not the same length " \
"as that of the prepared plan (%d)",
length(rargvalues), nargs);
argvalues = (Datum *) palloc(nargs * sizeof(Datum));
nulls = (char *) palloc(nargs * sizeof(char));
}
for (i = 0; i < nargs; i++)
{
PROTECT(obj = VECTOR_ELT(rargvalues, i));
argvalues[i] = get_scalar_datum(obj, typeids[i], typinfuncs[i], &isnull);
if (!isnull)
nulls[i] = ' ';
else
nulls[i] = 'n';
UNPROTECT(1);
}
strncpy(cursor_name, CHAR(STRING_ELT(cursor_name_arg,0)), 64);
/* switch to SPI memory context */
oldcontext = MemoryContextSwitchTo(plr_SPI_context);
/*
* trap elog/ereport so we can let R finish up gracefully
* and generate the error once we exit the interpreter
*/
PG_TRY();
{
/* Open the cursor */
portal = SPI_cursor_open(cursor_name,saved_plan, argvalues, nulls,1);
}
PLR_PG_CATCH();
PLR_PG_END_TRY();
/* back to caller's memory context */
MemoryContextSwitchTo(oldcontext);
if(portal==NULL)
error("SPI_cursor_open() failed");
else
result = R_MakeExternalPtr(portal, R_NilValue, R_NilValue);
POP_PLERRCONTEXT;
return result;
}
/*
* plr_SPI_execp - The builtin SPI_execp command for the R interpreter
*/
SEXP
plr_SPI_execp(SEXP rsaved_plan, SEXP rargvalues)
{
saved_plan_desc *plan_desc = (saved_plan_desc *) R_ExternalPtrAddr(rsaved_plan);
void *saved_plan = plan_desc->saved_plan;
int nargs = plan_desc->nargs;
Oid *typeids = plan_desc->typeids;
FmgrInfo *typinfuncs = plan_desc->typinfuncs;
int i;
Datum *argvalues = NULL;
char *nulls = NULL;
bool isnull = false;
SEXP obj;
int spi_rc = 0;
char buf[64];
int count = 0;
int ntuples;
SEXP result = NULL;
MemoryContext oldcontext;
PREPARE_PG_TRY;
/* set up error context */
PUSH_PLERRCONTEXT(rsupport_error_callback, "pg.spi.execp");
if (nargs > 0)
{
if (!Rf_isVectorList(rargvalues))
error("%s", "second parameter must be a list of arguments " \
"to the prepared plan");
if (length(rargvalues) != nargs)
error("list of arguments (%d) is not the same length " \
"as that of the prepared plan (%d)",
length(rargvalues), nargs);
argvalues = (Datum *) palloc(nargs * sizeof(Datum));
nulls = (char *) palloc(nargs * sizeof(char));
}
for (i = 0; i < nargs; i++)
{
PROTECT(obj = VECTOR_ELT(rargvalues, i));
argvalues[i] = get_scalar_datum(obj, typeids[i], typinfuncs[i], &isnull);
if (!isnull)
nulls[i] = ' ';
else
nulls[i] = 'n';
UNPROTECT(1);
}
/* switch to SPI memory context */
oldcontext = MemoryContextSwitchTo(plr_SPI_context);
/*
* trap elog/ereport so we can let R finish up gracefully
* and generate the error once we exit the interpreter
*/
PG_TRY();
{
/* Execute the plan */
spi_rc = SPI_execp(saved_plan, argvalues, nulls, count);
}
PLR_PG_CATCH();
PLR_PG_END_TRY();
/* back to caller's memory context */
MemoryContextSwitchTo(oldcontext);
/* check the result */
switch (spi_rc)
{
case SPI_OK_UTILITY:
snprintf(buf, sizeof(buf), "%d", 0);
SPI_freetuptable(SPI_tuptable);
PROTECT(result = NEW_CHARACTER(1));
SET_STRING_ELT(result, 0, COPY_TO_USER_STRING(buf));
UNPROTECT(1);
break;
case SPI_OK_SELINTO:
case SPI_OK_INSERT:
case SPI_OK_DELETE:
case SPI_OK_UPDATE:
snprintf(buf, sizeof(buf), "%d", SPI_processed);
SPI_freetuptable(SPI_tuptable);
PROTECT(result = NEW_CHARACTER(1));
SET_STRING_ELT(result, 0, COPY_TO_USER_STRING(buf));
UNPROTECT(1);
break;
case SPI_OK_SELECT:
ntuples = SPI_processed;
if (ntuples > 0)
{
result = rpgsql_get_results(ntuples, SPI_tuptable);
SPI_freetuptable(SPI_tuptable);
}
else
result = R_NilValue;
break;
case SPI_ERROR_ARGUMENT:
error("SPI_execp() failed: SPI_ERROR_ARGUMENT");
break;
case SPI_ERROR_UNCONNECTED:
error("SPI_execp() failed: SPI_ERROR_UNCONNECTED");
break;
case SPI_ERROR_COPY:
error("SPI_execp() failed: SPI_ERROR_COPY");
break;
case SPI_ERROR_CURSOR:
error("SPI_execp() failed: SPI_ERROR_CURSOR");
break;
case SPI_ERROR_TRANSACTION:
error("SPI_execp() failed: SPI_ERROR_TRANSACTION");
break;
case SPI_ERROR_OPUNKNOWN:
error("SPI_execp() failed: SPI_ERROR_OPUNKNOWN");
break;
default:
error("SPI_execp() failed: %d", spi_rc);
break;
}
POP_PLERRCONTEXT;
return result;
}
long shape_extractor::init(SEXP sh, SEXP sinfo)
{
if (sh == NULL || Rf_isNull(sh))
return S_FALSE;
//SEXP sinfo = Rf_getAttrib(sh, Rf_install(SHAPE_INFO));
if (Rf_isNull(sinfo))
return S_FALSE;
m_shape = sh;
tools::vectorGeneric shape_info(sinfo);
std::string gt_type;
tools::copy_to(shape_info.at("type"), gt_type);
m_gt = str2geometryType(gt_type.c_str());
if (m_gt == esriGeometryNull)
return S_FALSE;
tools::copy_to(shape_info.at("hasZ"), m_hasZ);
tools::copy_to(shape_info.at("hasM"), m_hasM);
//m_len = tools::size(m_shape);
if (m_gt == esriGeometryPoint)
{
if (Rf_isMatrix(m_shape))
{
if (TYPEOF(m_shape) != REALSXP)
return showError<false>(L"expected type of double for shape list"), E_FAIL;E_FAIL;
m_as_matrix = true;
//return showError<false>(L"for Point geometry 'shape' shoud be matrix"), E_FAIL;E_FAIL;
SEXP dims = Rf_getAttrib(sh, R_DimSymbol);
size_t ndim = tools::size(dims);
if (ndim != 2)
return showError<false>(L"dimention != 2"), E_FAIL;
m_len = (size_t)INTEGER(dims)[0];
int c = INTEGER(dims)[1];
if (m_hasZ && m_hasM && c != 4)
return showError<false>(L"incorrect structue. matrix with 4 columns expected"), E_FAIL;
if ((m_hasZ ^ m_hasM) && c != 3)
return showError<false>(L"incorrect structue. matrix with 3 columns expected"), E_FAIL;
if (!m_hasZ && !m_hasM && c != 2)
return showError<false>(L"incorrect structue. matrix with 2 columns expected"), E_FAIL;
}
else if (Rf_isVectorList(m_shape))
{
m_as_matrix = false;
size_t nn = 2;
nn += m_hasZ ? 1 : 0;
nn += m_hasM ? 1 : 0;
size_t n = (R_len_t)tools::size(m_shape);
if (n < nn)
return showError<false>(L"incorrect list size for Point geometry"), E_FAIL;
n = std::min(n, nn);
//check all arrays must be same len
for (size_t i = 0; i < n; i++)
{
m_parts[i] = VECTOR_ELT(sh, (R_len_t)i);
if (TYPEOF(m_parts[i]) != REALSXP)
return showError<false>(L"expected type of double for shape list"), E_FAIL;E_FAIL;
size_t n = tools::size(m_parts[i]);
if (i == 0)
m_len = n;
else
{
if (m_len != n)
return showError<false>(L"lists are not same sizes"), E_FAIL;
}
}
}
else return showError<false>(L"for Point geometry 'shape' shoud be matrix or list"), E_FAIL;E_FAIL;
}
else
m_len = tools::size(sh);
//CComPtr<ISpatialReferenceFactory3> ipSpatialRefFactory; ipSpatialRefFactory.CoCreateInstance(CLSID_SpatialReferenceEnvironment);
int srid = 0;
std::wstring wkt;
m_ipSR.Release();
if (!tools::copy_to(shape_info.at("WKID"), srid))
tools::copy_to(shape_info.at("WKT"), wkt);
create_sr(srid, wkt, &m_ipSR);
return S_OK;
}
SEXP R_export2dataset(SEXP path, SEXP dataframe, SEXP shape, SEXP shape_info)
{
std::wstring dataset_name;
tools::copy_to(path, dataset_name);
struct _cleanup
{
typedef std::vector<cols_base*> c_type;
std::vector<std::wstring> name;
c_type c;
~_cleanup()
{
for (size_t i = 0, n = c.size(); i < n; i++)
delete c[i];
}
}cols;
shape_extractor extractor;
bool isShape = extractor.init(shape, shape_info) == S_OK;
tools::getNames(dataframe, cols.name);
R_xlen_t nlen = 0;
ATLTRACE("dataframe type:%s", Rf_type2char(TYPEOF(dataframe)));
if (Rf_isVectorList(dataframe))
{
size_t k = tools::size(dataframe);
ATLASSERT(cols.name.size() == k);
cols.name.resize(k);
for (size_t i = 0; i < k; i++)
{
nlen = std::max(nlen, tools::size(VECTOR_ELT(dataframe, i)));
if (cols.name[i].empty())
cols.name[i] = L"data";
}
}
else
{
if (Rf_isNull(dataframe))
nlen = extractor.size();
else
return showError<false>("unsupported datat type"), R_NilValue;
}
if (nlen == 0)
return showError<false>("nothing to save: 0 length"), R_NilValue;
if (isShape && nlen != extractor.size() )
Rf_warning("length of shape != data.frame length");
//return showError<false>("length of shape != data.frame"), R_NilValue;
std::unique_ptr<arcobject::cursor> acur(arcobject::create_insert_cursor(dataset_name, extractor.geometry_info()));
if (acur.get() == NULL)
return showError<true>(), R_NilValue;
arcobject::cursor* cur = acur.get();
for (size_t i = 0; i < cols.name.size(); i++)
{
ATLASSERT(!cols.name[i].empty());
SEXP it = VECTOR_ELT(dataframe, i);
bool skip = false;
if (isShape)//if(gt == esriGeometryPolygon || gt == esriGeometryLine)
{
skip = cols.name[i] == L"Shape_Area";
skip = !skip ? cols.name[i] == L"Shape_Length" : true;
}
if (!skip)
{
cols_base* item = setup_field(cur, it, cols.name[i]);
if (!item)
Rf_warning("unsupported data.field column type");//return showError<false>(L"unsupported data.field column type"), R_NilValue;
else
cols.c.push_back(item);
}
}
if (!cur->begin())
return showError<true>(), R_NilValue;
for (R_xlen_t i = 0; i < nlen; i++)
{
//ATLTRACE("\n");
for (const auto &c : cols.c)
{
if (c->pos < 0)
continue;
CComVariant val;
c->get(i, val);
if (!cur->setValue(c->pos, val))
return showError<true>("insert row value failed"), R_NilValue;
}
if (isShape)
{
if (extractor.isPoints())
cur->set_point(extractor.getPoint(i));
else
cur->set_shape(extractor.getShape(i));
}
if (!cur->next())
return showError<true>("insert row failed"), R_NilValue;
}
cur->commit();
return R_NilValue;
}
long shape_extractor::init(SEXP sh, SEXP sinfo)
{
if (sh == NULL || Rf_isNull(sh))
return S_FALSE;
if (Rf_isNull(sinfo))
return S_FALSE;
m_shape = sh;
tools::vectorGeneric shape_info(sinfo);
tools::copy_to(shape_info.at("type"), m_geometry_info.first);
m_geometry_info.second.second = 0;
if (m_geometry_info.first.empty())
return S_FALSE;
tools::copy_to(shape_info.at("hasZ"), m_hasZ);
tools::copy_to(shape_info.at("hasM"), m_hasM);
if (m_geometry_info.first == "Point")//esriGeometryPoint)
{
m_points = true;
if (Rf_isMatrix(m_shape))
{
if (TYPEOF(m_shape) != REALSXP)
return showError<false>("expected type of double for shape list"), E_FAIL;E_FAIL;
m_as_matrix = true;
//return showError<false>("for Point geometry 'shape' shoud be matrix"), E_FAIL;E_FAIL;
SEXP dims = Rf_getAttrib(sh, R_DimSymbol);
size_t ndim = tools::size(dims);
if (ndim != 2)
return showError<false>("dimention != 2"), E_FAIL;
m_len = (size_t)INTEGER(dims)[0];
int c = INTEGER(dims)[1];
if (m_hasZ && m_hasM && c != 4)
return showError<false>("incorrect structue. matrix with 4 columns expected"), E_FAIL;
if ((m_hasZ ^ m_hasM) && c != 3)
return showError<false>("incorrect structue. matrix with 3 columns expected"), E_FAIL;
if (!m_hasZ && !m_hasM && c != 2)
return showError<false>("incorrect structue. matrix with 2 columns expected"), E_FAIL;
}
else if (Rf_isVectorList(m_shape))
{
m_as_matrix = false;
size_t nn = 2;
nn += m_hasZ ? 1 : 0;
nn += m_hasM ? 1 : 0;
size_t n = (R_len_t)tools::size(m_shape);
if (n < nn)
return showError<false>("incorrect list size for Point geometry"), E_FAIL;
n = std::min(n, nn);
//check all arrays must be same len
for (size_t i = 0; i < n; i++)
{
m_parts[i] = VECTOR_ELT(sh, (R_len_t)i);
if (TYPEOF(m_parts[i]) != REALSXP)
return showError<false>("expected type of double for shape list"), E_FAIL;
size_t n = tools::size(m_parts[i]);
if (i == 0)
m_len = n;
else
{
if (m_len != n)
return showError<false>("lists are not same sizes"), E_FAIL;
}
}
}
else
return showError<false>("for Point geometry 'shape' shoud be matrix or list"), E_FAIL;
if (m_hasZ)
m_geometry_info.first += ":Z";
if (m_hasM)
m_geometry_info.first += ":M";
}
else
m_len = tools::size(sh);
if (!tools::copy_to(shape_info.at("WKID"), m_geometry_info.second.second))
{
std::wstring wkt;
if (tools::copy_to(shape_info.at("WKT"), wkt))
{
struct eq
{
static bool op(const wchar_t &c) { return c == L'\''; }
};
std::replace_if(wkt.begin(), wkt.end(), eq::op, L'\"');
m_geometry_info.second.first = wkt;
}
}
return S_OK;
}
SEXP R_export2dataset(SEXP path, SEXP dataframe, SEXP shape, SEXP shape_info)
{
std::wstring dataset_name;
tools::copy_to(path, dataset_name);
struct _cleanup
{
typedef std::vector<cols_base*> c_type;
std::vector<std::wstring> name;
c_type c;
//std::vector<c_type::const_iterator> shape;
c_type shape;
~_cleanup()
{
for (size_t i = 0; i < c.size(); i++)
delete c[i];
for (size_t i = 0; i < shape.size(); i++)
delete shape[i];
}
}cols;
shape_extractor extractor;
bool isShape = extractor.init(shape, shape_info) == S_OK;
//SEXP sinfo = Rf_getAttrib(shape, Rf_mkChar("shape_info"));
//cols.name = df.attr("names");
tools::getNames(dataframe, cols.name);
//tools::vectorGeneric shape_info(sinfo);
//std::string gt_type;
//tools::copy_to(shape_info.at("type"), gt_type);
esriGeometryType gt = extractor.type();//str2geometryType(gt_type.c_str());
R_xlen_t n = 0;
ATLTRACE("dataframe type:%s", Rf_type2char(TYPEOF(dataframe)));
if (Rf_isVectorList(dataframe))
{
size_t k = tools::size(dataframe);
cols.name.resize(k);
for (size_t i = 0; i < k; i++)
{
n = std::max(n, tools::size(VECTOR_ELT(dataframe, (R_xlen_t)i)));
if (cols.name[i].empty())
cols.name[i] = L"data";
}
}
else
{
n = tools::size(dataframe);
ATLASSERT(cols.name.empty());
}
if (isShape == false && n == 0)
return showError<false>(L"nothing to save"), R_NilValue;
if (isShape && n != extractor.size() )
return showError<false>(L"length of shape != data.frame"), R_NilValue;
CComPtr<IGPUtilities> ipDEUtil;
if (ipDEUtil.CoCreateInstance(CLSID_GPUtilities) != S_OK)
return showError<true>(L"IDEUtilitiesImpl - CoCreateInstance has failed"), R_NilValue;
HRESULT hr = 0;
CComPtr<IName> ipName;
if (isShape)
hr = ipDEUtil->CreateFeatureClassName(CComBSTR(dataset_name.c_str()), &ipName);
else
hr = ipDEUtil->CreateTableName(CComBSTR(dataset_name.c_str()), &ipName);
CComQIPtr<IDatasetName> ipDatasetName(ipName);
CComPtr<IWorkspaceName> ipWksName;
CComQIPtr<IWorkspace> ipWks;
if (hr == S_OK)
hr = ipDatasetName->get_WorkspaceName(&ipWksName);
if (hr == S_OK)
{
CComPtr<IUnknown> ipUnk;
hr = CComQIPtr<IName>(ipWksName)->Open(&ipUnk);
ipWks = ipUnk;
}
if (hr != S_OK)
return showError<true>(L"invalid table name"), R_NilValue;
CComQIPtr<IFeatureWorkspace> ipFWKS(ipWks);
ATLASSERT(ipFWKS);
if (!ipFWKS)
return showError<true>(L"not a FeatureWorkspace"), R_NilValue;
CComBSTR bstrTableName;
ipDatasetName->get_Name(&bstrTableName);
CComPtr<IFieldsEdit> ipFields;
hr = ipFields.CoCreateInstance(CLSID_Fields);
if (hr != S_OK) return showError<true>(L"CoCreateInstance"), R_NilValue;
createField(NULL, esriFieldTypeOID, ipFields);
CComPtr<ISpatialReference> ipSR;
if (isShape)
{
long pos = createField(NULL, esriFieldTypeGeometry, ipFields);
CComPtr<IGeometryDef> ipGeoDef;
CComPtr<IField> ipField;
ipFields->get_Field(pos, &ipField);
ipField->get_GeometryDef(&ipGeoDef);
CComQIPtr<IGeometryDefEdit> ipGeoDefEd(ipGeoDef);
ipGeoDefEd->put_GeometryType(gt);
ipGeoDefEd->putref_SpatialReference(extractor.sr());
}
if (cols.name.empty())
{
cols.name.push_back(L"data");
cols_base* item = setup_field(ipFields, dataframe, cols.name[0].c_str());
if (!item)
return showError<false>(L"unsupported datat.field column type"), NULL;
cols.c.push_back(item);
item->name_ref = &cols.name[0];
}
else
for (size_t i = 0; i < cols.name.size(); i++)
{
if (cols.name[i].empty())
continue;
const wchar_t* str = cols.name[i].c_str();
SEXP it = VECTOR_ELT(dataframe, (R_len_t)i);
cols_base* item = setup_field(ipFields, it, str);
if (!item)
return showError<false>(L"unsupported datat.field column type"), NULL;
cols.c.push_back(item);
item->name_ref = &cols.name[i];
}
CComPtr<IFieldChecker> ipFieldChecker; ipFieldChecker.CoCreateInstance(CLSID_FieldChecker);
if (ipFieldChecker)
{
ipFieldChecker->putref_ValidateWorkspace(ipWks);
long error = 0;
//fix fields names
CComPtr<IFields> ipFixedFields;
CComPtr<IEnumFieldError> ipEError;
hr = ipFieldChecker->Validate(ipFields, &ipEError, &ipFixedFields);
if (hr != S_OK)
return showError<true>(L"validate fields failed"), NULL;
if (ipFixedFields)
{
ipFields = ipFixedFields;
for (size_t c = 0; c < cols.c.size(); c++)
{
CComPtr<IField> ipFixedField;
ipFixedFields->get_Field(cols.c[c]->pos, &ipFixedField);
_bstr_t name;
ipFixedField->get_Name(name.GetAddress());
cols.c[c]->name_ref->assign(name);
}
}
}
CComPtr<IUID> ipUID; ipUID.CoCreateInstance(CLSID_UID);
if (ipUID)
{
OLECHAR buf[256];
::StringFromGUID2(isShape ? CLSID_Feature : CLSID_Row, buf, 256);
ipUID->put_Value(CComVariant(buf));
}
CComQIPtr<ITable> ipTableNew;
CComBSTR keyword(L"");
hr = E_FAIL;
if (isShape)
{
CComPtr<IFeatureClass> ipFClass;
hr = ipFWKS->CreateFeatureClass(bstrTableName, ipFields, ipUID, 0, esriFTSimple, CComBSTR(L"Shape"), keyword, &ipFClass);
ipTableNew = ipFClass;
}
else
{
hr = ipFWKS->CreateTable(bstrTableName, ipFields, ipUID, 0, keyword, &ipTableNew);
}
if (hr != S_OK)
{
std::wstring err_txt(isShape ? L"Create FeatureClass :" : L"Create Table :");
err_txt += bstrTableName;
err_txt += L" has failed";
return showError<true>(err_txt.c_str()), R_NilValue;
}
CComVariant oid;
CComPtr<ICursor> ipCursor;
CComPtr<IRowBuffer> ipRowBuffer;
hr = ipTableNew->Insert(VARIANT_TRUE, &ipCursor);
if (hr != S_OK)
return showError<true>(L"Insert cursor failed"), R_NilValue;
hr = ipTableNew->CreateRowBuffer(&ipRowBuffer);
if (hr != S_OK)
return showError<true>(L"Insert cursor failed"), R_NilValue;
//re-map fields
CComPtr<IFields> ipRealFields;
ipCursor->get_Fields(&ipRealFields);
for (size_t c = 0; c < cols.c.size(); c++)
{
ipRealFields->FindField(CComBSTR(cols.c[c]->name_ref->c_str()), &(cols.c[c]->pos));
CComPtr<IField> ipField;
ipRealFields->get_Field(cols.c[c]->pos, &ipField);
VARIANT_BOOL b = VARIANT_FALSE;
ipField->get_IsNullable(&b);
if (b == VARIANT_FALSE)
{
esriFieldType ft = esriFieldTypeInteger;
ipField->get_Type(&ft);
switch(ft)
{
case esriFieldTypeInteger:
cols.c[c]->vNULL = 0;//std::numeric_limits<int>::min();
break;
case esriFieldTypeDouble:
cols.c[c]->vNULL = 0.0;//-std::numeric_limits<double>::max();
break;
case esriFieldTypeString:
cols.c[c]->vNULL = L"";
}
}
}
CComQIPtr<IFeatureBuffer> ipFBuffer(ipRowBuffer);
for (R_len_t i = 0; i < n; i++)
{
//ATLTRACE("\n");
for (size_t c = 0; c < cols.c.size(); c++)
{
if (cols.c[c]->pos < 0)
continue;
CComVariant val;
cols.c[c]->get(i, val);
if (val.vt == VT_NULL)
hr = ipRowBuffer->put_Value(cols.c[c]->pos, cols.c[c]->vNULL);
else
hr = ipRowBuffer->put_Value(cols.c[c]->pos, val);
if (FAILED(hr))
return showError<true>(L"insert row value failed"), R_NilValue;
}
VARIANT oid;
if (isShape)
{
ATLASSERT(ipFBuffer);
CComQIPtr<IGeometry> ipNewShape;
hr = extractor.at(i, &ipNewShape);
if (hr != S_OK)
return R_NilValue;
hr = ipFBuffer->putref_Shape(ipNewShape);
if (FAILED(hr))
return showError<true>(L"insert shape failed"), R_NilValue;
}
hr = ipCursor->InsertRow(ipRowBuffer, &oid);
if (hr != S_OK)
return showError<true>(L"insert row failed"), R_NilValue;
}
return R_NilValue;
}