//TODO - This function does not appear to be working correctly
void r_finalize(void)
{
unsigned char buf[1024];
char * tmpdir;
R_dot_Last();
R_gc(); /* Remove any remaining R objects from memory */
}
int execute_tool2(const wchar_t* script_path, IArray* pParameters)
{
if (pParameters == 0)
return 0;
//gp_connect_impl connect;
//if (!connect.init())
// return 1;
if (pParameters == 0)
return 0;
_bstr_t file_path(script_path);
long nParams = 0;
pParameters->get_Count(&nParams);
//CComQIPtr<IGPScriptTool>(pGPTool)->get_FileName(file_path.GetAddress());
bool ok = true;
int errorOccurred = 0;
if (file_path.length() && nParams)
{
std::vector< CAdapt<CComPtr<IGPParameter> > > return_params;
//ipParameters->get_Count(&n);
SEXP arc_env = Rf_findVar(Rf_install("arc"), R_GlobalEnv);
{
std::vector<SEXP> in_params;
std::vector<std::string> in_params_names;
std::vector<SEXP> out_params;
std::vector<std::string> out_params_names;
tools::protect pt;
for (int i = 0; i < nParams; i++)
{
CComPtr<IUnknown> ipUnk;
pParameters->get_Element(i, &ipUnk);
CComQIPtr<IGPParameter> ipParam(ipUnk);
esriGPParameterDirection eD;
ipParam->get_Direction(&eD);
std::pair<SEXP, std::string> p = param2r(ipParam);
if (eD == esriGPParameterDirectionInput)
{
in_params.push_back(pt.add(p.first));
in_params_names.push_back(p.second);
}
else
{
out_params.push_back(pt.add(p.first));
out_params_names.push_back(p.second);
return_params.push_back(ipParam);
}
}
SEXP p1 = tools::newVal(in_params, pt);
tools::nameIt(p1, in_params_names);
SEXP p2 = tools::newVal(out_params, pt);
tools::nameIt(p2, out_params_names);
Rf_defineVar(Rf_install(".file"), tools::newVal(file_path, pt), arc_env);
Rf_defineVar(Rf_install(".in"), p1, arc_env);
Rf_defineVar(Rf_install(".out"), p2, arc_env);
}
const static wchar_t eval_str[] = L"arc$.ret<-local({"
L"en<-new.env(hash=TRUE);"
L"eval(parse(file=arc$.file), envir=en);"
L"tool_exec<-get('tool_exec',en);"
L"tool_exec(in_param, out_param)"
L"},envir=list('in_param'=arc$.in,'out_param'=arc$.out))";
ok = current_connect->eval_one(eval_str) == 1;
current_connect->print_out(NULL, -1);
Rf_defineVar(Rf_install(".file"), R_NilValue, arc_env);
Rf_defineVar(Rf_install(".in"), R_NilValue, arc_env);
Rf_defineVar(Rf_install(".out"), R_NilValue, arc_env);
R_gc();
//TODO: handle ok
if (ok)
{
/*CComPtr<IGPMessages> ipMsgs;
if (connect.m_ipGeoProcessor)
connect.m_ipGeoProcessor->GetReturnMessages(&ipMsgs);
if (ipMsgs)
{
VARIANT_BOOL bErr = VARIANT_FALSE;
CComQIPtr<IGPMessage>(ipMsgs)->IsError(&bErr);
if (bErr != VARIANT_FALSE)
ok = false;
}*/
if (!return_params.empty())
{
//connect.m_ipGeoProcessor->Is
SEXP ret = Rf_findVar(Rf_install(".ret"), arc_env);
tools::vectorGeneric ret_out(ret);
//tools::vectorGeneric ret_out(ret.get());
for (size_t i = 0, n = return_params.size(); i < n; i++)
{
_bstr_t name;
return_params[i].m_T->get_Name(name.GetAddress());
size_t idx = ret_out.idx(std::string(name));
if (idx != (size_t)-1)
{
if (!r2param(ret_out.at(idx), return_params[i].m_T))
{
std::wstring msg(L"failed to set output parameter - ");
msg += name;
current_connect->print_out(msg.c_str(), 2);
}
}
}
//TODO list
}
Rf_defineVar(Rf_install(".ret"), R_NilValue, arc_env);
}
}
return ok ? 0 : 1;
}
