ARSperl
view release on metacpan or search on metacpan
if (!ni)
return -2;
t1 = hv_store(err_hash, EH_COUNT, strlen(EH_COUNT) , ni, 0);
if (!t1)
return -3;
/* create array refs (with empty arrays) */
t3 = newAV();
if (!t3)
return -4;
t1 = hv_store(err_hash, EH_TYPE, strlen(EH_TYPE) , newRV_noinc((SV *) t3), 0);
if (!t1 || !*t1)
return -5;
t3 = newAV();
if (!t3)
return -6;
t1 = hv_store(err_hash, EH_NUM, strlen(EH_NUM) , newRV_noinc((SV *) t3), 0);
if (!t1 || !*t1)
return -7;
t3 = newAV();
if (!t3)
return -8;
t1 = hv_store(err_hash, EH_TEXT, strlen(EH_TEXT) , newRV_noinc((SV *) t3), 0);
if (!t1 || !*t1)
return -9;
return 0;
}
int
ARError_add(int type, long num, char *text)
{
SV **numItems, **messageType, **messageNum, **messageText;
AV *a;
SV *t2;
HV *err_hash = (HV *) NULL;
unsigned int ni, ret = 0;
#ifdef ARSPERL_DEBUG
printf("ARError_add(%d, %d, %s)\n", type, num, text ? text : "NULL");
#endif
/* this is used to insert 'traceback' (debugging) messages into the
* error hash. these can be filtered out by modifying the FETCH clause
* of the ARSERRSTR package in ARS.pm
*/
switch (type) {
case ARSPERL_TRACEBACK:
case AR_RETURN_OK:
case AR_RETURN_WARNING:
ret = 0;
break;
case AR_RETURN_ERROR:
case AR_RETURN_FATAL:
ret = -1;
break;
default:
return -1;
}
if (!text || !*text)
return -2;
/*
* fetch base hash and numItems reference, it should already exist
* because you should call ARError_reset before using this routine.
* if you forgot.. no big deal.. we'll do it for you.
*/
err_hash = perl_get_hv(ERRHASH, FALSE);
if (!err_hash) {
ret = ARError_reset();
if (ret != 0)
return -3;
}
numItems = hv_fetch(err_hash, "numItems", strlen("numItems") , FALSE);
if (!numItems)
return -4;
messageType = hv_fetch(err_hash, "messageType", strlen("messageType") , FALSE);
if (!messageType)
return -5;
messageNum = hv_fetch(err_hash, "messageNum", strlen("messageNum") , FALSE);
if (!messageNum)
return -6;
messageText = hv_fetch(err_hash, "messageText", strlen("messageText") , FALSE);
if (!messageText)
return -7;
/*
* add the num, type and text to the appropriate arrays and then
* increase the counter by 1 (one).
*/
if (!SvIOK(*numItems))
return -8;
ni = (int) SvIV(*numItems) + 1;
(void) sv_setiv(*numItems, ni);
/* push type, num, and text onto each of the arrays */
if (!SvROK(*messageType) || (SvTYPE(SvRV(*messageType)) != SVt_PVAV))
return -9;
if (!SvROK(*messageNum) || (SvTYPE(SvRV(*messageNum)) != SVt_PVAV))
return -10;
if (!SvROK(*messageText) || (SvTYPE(SvRV(*messageText)) != SVt_PVAV))
return -11;
a = (AV *) SvRV(*messageType);
t2 = newSViv(type);
(void) av_push(a, t2);
a = (AV *) SvRV(*messageNum);
t2 = newSViv(num);
(void) av_push(a, t2);
perl_ARNameType(ctrl, &(in->itemName)), 0);
hv_store(hash, "itemNumber", strlen("itemNumber"),
newSViv(in->itemNumber), 0); /* unsigned long */
return newRV_noinc((SV *) hash);
}
SV *
perl_AREnumQueryStruct(ARControlStruct * ctrl, AREnumQueryStruct * in)
{
HV *hash = newHV();
hv_store(hash, "schema", strlen("schema"),
perl_ARNameType(ctrl, &(in->schema)), 0);
hv_store(hash, "server", strlen("server"),
newSVpv(in->server, 0), 0);
hv_store(hash, "qualifier", strlen("qualifier"),
newRV_noinc((SV *) perl_qualifier(ctrl,
&(in->qualifier))
)
,0
);
hv_store(hash, "nameField", strlen("nameField"),
perl_ARInternalId(ctrl, &(in->nameField)), 0);
hv_store(hash, "numberField", strlen("numberField"),
perl_ARInternalId(ctrl, &(in->numberField)), 0);
return newRV_noinc((SV *) hash);
}
SV *
perl_AREnumLimitsStruct(ARControlStruct * ctrl, AREnumLimitsStruct * in)
{
HV *hash = newHV();
switch (in->listStyle) {
case AR_ENUM_STYLE_REGULAR:
hv_store(hash, "regularList", strlen("regularList"),
perl_ARList(ctrl,
(ARList *) & in->u.regularList,
(ARS_fn) perl_ARNameType,
sizeof(ARNameType)
)
,0
);
break;
case AR_ENUM_STYLE_CUSTOM:
hv_store(hash, "customList", strlen("customList"),
perl_ARList(ctrl,
(ARList *) & in->u.customList,
(ARS_fn) perl_AREnumItemStruct,
sizeof(AREnumItemStruct)
)
,0
);
break;
case AR_ENUM_STYLE_QUERY:
hv_store(hash, "queryList", strlen("queryList"),
perl_AREnumQueryStruct(ctrl, &(in->u.queryList)), 0);
break;
default:
hv_store(hash, "error", 5,
newSVpv("unknown listStyle", 0), 0);
hv_store(hash, "listStyle", strlen("listStyle"),
newSViv(in->listStyle), 0);
ARError_add(AR_RETURN_ERROR, AP_ERR_ENUM_LISTSTYLE);
}
return newRV_noinc((SV *) hash);
}
#endif
#if AR_EXPORT_VERSION >= 7L
void
dup_ARFuncCurrencyList(ARFuncCurrencyList *dst, ARFuncCurrencyList *src)
{
if( dst && src ) {
dst->numItems = src->numItems;
AMALLOCNN(dst->funcCurrencyList,
src->numItems,
ARFuncCurrencyStruct);
memcpy(dst->funcCurrencyList,
src->funcCurrencyList,
sizeof(ARFuncCurrencyStruct) * src->numItems);
}
}
ARCurrencyStruct *
dup_ARCurrencyStruct(ARControlStruct * ctrl, ARCurrencyStruct * in)
{
if ( in && in->value ) {
ARCurrencyStruct *n = MALLOCNN(sizeof(ARCurrencyStruct));
if ( !n ) return NULL;
if (in->value)
strcpy(n->value, in->value);
n->conversionDate = in->conversionDate;
strncpy(n->currencyCode, in->currencyCode,
sizeof(ARCurrencyCodeType));
dup_ARFuncCurrencyList(&(n->funcList), &(in->funcList));
}
return NULL;
}
SV *
perl_ARFuncCurrencyStruct(ARControlStruct * ctrl, ARFuncCurrencyStruct * in)
{
HV *hash = newHV();
if(in->value) {
hv_store(hash, "value", strlen("value"),
newSVpv(in->value, 0), 0);
} else {
hv_store(hash, "value", strlen("value"),
&PL_sv_undef, 0);
}
if(in->currencyCode) {
hv_store(hash, "currencyCode", strlen("currencyCode"),
newSVpv(in->currencyCode, 0), 0);
} else {
hv_store(hash, "currencyCode", strlen("currencyCode"),
perl_ARValueStruct_Assign(ARControlStruct * ctrl, ARValueStruct * in)
{
ARStatusList status;
int i;
Zero(&status, 1, ARStatusList);
switch (in->dataType) {
case AR_DATA_TYPE_KEYWORD:
for (i = 0; KeyWordMap[i].number != TYPEMAP_LAST; i++) {
if (KeyWordMap[i].number == in->u.keyNum)
break;
}
return newSVpv(KeyWordMap[i].name, KeyWordMap[i].len);
break;
case AR_DATA_TYPE_INTEGER:
return newSViv(in->u.intVal);
case AR_DATA_TYPE_REAL:
return newSVnv(in->u.realVal);
case AR_DATA_TYPE_DIARY: /* this is the set-fields special
* case */
case AR_DATA_TYPE_CHAR:
return newSVpv(in->u.charVal, 0);
case AR_DATA_TYPE_ENUM:
return newSViv(in->u.enumVal);
case AR_DATA_TYPE_TIME:
return newSViv(in->u.timeVal);
case AR_DATA_TYPE_BITMASK:
return newSViv(in->u.maskVal);
#if AR_EXPORT_VERSION >= 3
case AR_DATA_TYPE_BYTES:
return perl_ARByteList(ctrl, in->u.byteListVal);
case AR_DATA_TYPE_ULONG:
return newSViv(in->u.ulongVal); /* FIX -- does perl have
* unsigned long? */
case AR_DATA_TYPE_COORDS:
return perl_ARList(ctrl,
(ARList *) in->u.coordListVal,
(ARS_fn) perl_ARCoordStruct,
sizeof(ARCoordStruct));
#endif
#if AR_EXPORT_VERSION >= 7L
case AR_DATA_TYPE_TIME_OF_DAY:
return newSViv(in->u.timeOfDayVal);
case AR_DATA_TYPE_DATE:
return newSViv(in->u.dateVal);
case AR_DATA_TYPE_CURRENCY:
return perl_ARCurrencyStruct(ctrl, in->u.currencyVal);
case AR_DATA_TYPE_VIEW:
case AR_DATA_TYPE_DISPLAY:
return newSVpv(in->u.charVal, 0);
#endif
#if AR_EXPORT_VERSION >= 4
case AR_DATA_TYPE_ATTACH:
return perl_ARAttach(ctrl, in->u.attachVal);
case AR_DATA_TYPE_DECIMAL:
return newSVpv(in->u.decimalVal, 0);
#endif
case AR_DATA_TYPE_NULL:
return newSVsv(&PL_sv_undef);
default:
{
char dt[128];
sprintf(dt, "%u (in function perl_ARValueStruct_Assign)", in->dataType);
ARError_add(AR_RETURN_WARNING, AP_ERR_DATATYPE);
ARError_add(AR_RETURN_WARNING, AP_ERR_CONTINUE, dt);
}
return newSVsv(&PL_sv_undef); /* FIX */
}
}
/* this one is for "normal" field/value decoding */
SV *
perl_ARValueStruct(ARControlStruct * ctrl, ARValueStruct * in)
{
ARDiaryList diaryList;
ARStatusList status;
int ret, i;
Zero(&status, 1, ARStatusList);
switch (in->dataType) {
case AR_DATA_TYPE_KEYWORD:
for (i = 0; KeyWordMap[i].number != TYPEMAP_LAST; i++) {
if (KeyWordMap[i].number == in->u.keyNum)
break;
}
return newSVpv(KeyWordMap[i].name, KeyWordMap[i].len);
break;
case AR_DATA_TYPE_INTEGER:
return newSViv(in->u.intVal);
case AR_DATA_TYPE_REAL:
return newSVnv(in->u.realVal);
case AR_DATA_TYPE_CHAR:
return newSVpv(in->u.charVal, 0);
case AR_DATA_TYPE_DIARY:
#if AR_EXPORT_VERSION >= 4
ret = ARDecodeDiary(ctrl, in->u.diaryVal, &diaryList, &status);
#else
ret = ARDecodeDiary(in->u.diaryVal, &diaryList, &status);
#endif
if (ARError(ret, status)) {
return newSVsv(&PL_sv_undef);
} else {
SV *array;
array = perl_ARList(ctrl,
(ARList *) & diaryList,
(ARS_fn) perl_diary,
sizeof(ARDiaryStruct));
FreeARDiaryList(&diaryList, FALSE);
return array;
}
case AR_DATA_TYPE_ENUM:
return newSViv(in->u.enumVal);
case AR_DATA_TYPE_TIME:
return newSViv(in->u.timeVal);
case AR_DATA_TYPE_BITMASK:
return newSViv(in->u.maskVal);
#if AR_EXPORT_VERSION >= 3
case AR_DATA_TYPE_BYTES:
return perl_ARByteList(ctrl, in->u.byteListVal);
case AR_DATA_TYPE_ULONG:
return newSViv(in->u.ulongVal); /* FIX -- does perl have
* unsigned long? */
case AR_DATA_TYPE_COORDS:
return perl_ARList(ctrl,
(ARList *) in->u.coordListVal,
(ARS_fn) perl_ARCoordStruct,
sizeof(ARCoordStruct));
#endif
#if AR_EXPORT_VERSION >= 4
case AR_DATA_TYPE_ATTACH:
return perl_ARAttach(ctrl, in->u.attachVal);
case AR_DATA_TYPE_DECIMAL:
return newSVpv(in->u.decimalVal, 0);
#endif
#if AR_EXPORT_VERSION >= 7L
case AR_DATA_TYPE_TIME_OF_DAY:
return newSViv(in->u.timeOfDayVal);
case AR_DATA_TYPE_DATE:
return newSViv(in->u.dateVal);
case AR_DATA_TYPE_CURRENCY:
return perl_ARCurrencyStruct(ctrl, in->u.currencyVal);
#endif
case AR_DATA_TYPE_NULL:
default:
return newSVsv(&PL_sv_undef); /* FIX */
}
}
SV *
perl_ARStatHistoryValue(ARControlStruct * ctrl, ARStatHistoryValue * in)
{
HV *hash = newHV();
hv_store(hash, "userOrTime", strlen("userOrTime") , newSViv(in->userOrTime), 0);
hv_store(hash, "enumVal", strlen("enumVal") , newSViv(in->enumVal), 0);
return newRV_noinc((SV *) hash);
}
#if AR_EXPORT_VERSION >= 7L
SV *
perl_ARCurrencyPartStruct( ARControlStruct *ctrl, ARCurrencyPartStruct *p ){
SV *ret;
{
HV *hash;
hash = newHV();
{
SV *val;
val = newSVpv( p->currencyCode, 0 );
ret = val;
}
hv_store( hash, "currencyCode", 12, ret, 0 );
{
SV *val;
val = newSViv( p->partTag );
ret = val;
}
hv_store( hash, "partTag", 7, ret, 0 );
{
SV *val;
val = newSViv( p->fieldId );
ret = val;
}
hv_store( hash, "fieldId", 7, ret, 0 );
ret = newRV_noinc((SV *) hash);
}
return ret;
}
#endif
#if AR_EXPORT_VERSION >= 4
SV *
perl_ARPushFieldsStruct(ARControlStruct * ctrl, ARPushFieldsStruct * in)
{
HV *hash = newHV();
hv_store(hash, "field", strlen("field") ,
perl_ARAssignFieldStruct(ctrl, &(in->field)), 0);
hv_store(hash, "assign", strlen("assign") ,
perl_ARAssignStruct(ctrl, &(in->assign)), 0);
return newRV_noinc((SV *) hash);
#if AR_EXPORT_VERSION >= 3
/* translate the noMatchOption value into english */
for (i = 0; NoMatchOptionMap[i].number != TYPEMAP_LAST; i++)
if (NoMatchOptionMap[i].number == in->noMatchOption)
break;
if (NoMatchOptionMap[i].number == TYPEMAP_LAST) {
char optnum[25];
sprintf(optnum, "%u", in->noMatchOption);
ARError_add(AR_RETURN_WARNING, AP_ERR_GENERAL,
"perl_ARAssignFieldStruct: unknown noMatchOption value");
ARError_add(AR_RETURN_WARNING, AP_ERR_GENERAL, optnum);
}
/* if we didn't find a match, store "" */
hv_store(hash, "noMatchOption", strlen("noMatchOption") , newSVpv(NoMatchOptionMap[i].name, 0), 0);
/* translate the multiMatchOption value into english */
for (i = 0; MultiMatchOptionMap[i].number != TYPEMAP_LAST; i++)
if (MultiMatchOptionMap[i].number == in->multiMatchOption)
break;
if (MultiMatchOptionMap[i].number == TYPEMAP_LAST) {
char optnum[25];
sprintf(optnum, "%u", in->multiMatchOption);
ARError_add(AR_RETURN_WARNING, AP_ERR_GENERAL,
"perl_ARAssignFieldStruct: unknown multiMatchOption value");
ARError_add(AR_RETURN_WARNING, AP_ERR_GENERAL, optnum);
}
hv_store(hash, "multiMatchOption", strlen("multiMatchOption") ,
newSVpv(MultiMatchOptionMap[i].name, 0),
0);
#endif
qual = dup_qualifier(ctrl, &(in->qualifier));
ref = newSViv(0);
sv_setref_pv(ref, "ARQualifierStructPtr", (void *) qual);
hv_store(hash, "qualifier", strlen("qualifier") , ref, 0);
/*
hv_store( hash, "qualifier", strlen("qualifier"),
newRV_inc((SV*) perl_qualifier(ctrl,&(in->qualifier))), 0 );
*/
switch (in->tag) {
case AR_FIELD:
hv_store(hash, "fieldId", strlen("fieldId") , newSViv(in->u.fieldId), 0);
break;
case AR_STAT_HISTORY:
hv_store(hash, "statHistory", strlen("statHistory") ,
perl_ARStatHistoryValue(ctrl, &in->u.statHistory), 0);
break;
#if AR_EXPORT_VERSION >= 7L
case AR_CURRENCY_FLD:
in->u.currencyField = (ARCurrencyPartStruct*) MALLOCNN(sizeof(ARCurrencyPartStruct));
hv_store(hash, "currencyField", strlen("currencyField") ,
perl_ARCurrencyPartStruct(ctrl, in->u.currencyField), 0);
break;
#endif
default:
break;
}
return newRV_noinc((SV *) hash);
}
SV *
perl_ARFieldAssignStruct(ARControlStruct * ctrl, ARFieldAssignStruct * in)
{
HV *hash = newHV();
hv_store(hash, "fieldId", strlen("fieldId") , newSViv(in->fieldId), 0);
hv_store(hash, "assignment", strlen("assignment") ,
perl_ARAssignStruct(ctrl, &in->assignment), 0);
return newRV_noinc((SV *) hash);
}
SV *
perl_ARDisplayStruct(ARControlStruct * ctrl, ARDisplayStruct * in)
{
char *string;
HV *hash = newHV();
/* FIX. use typeMap array? */
string = in->displayTag;
hv_store(hash, "displayTag", strlen("displayTag") , newSVpv(string, 0), 0);
string = in->label;
hv_store(hash, "label", strlen("label") , newSVpv(string, 0), 0);
switch (in->labelLocation) {
case AR_DISPLAY_LABEL_LEFT:
hv_store(hash, "labelLocation", strlen("labelLocation") , newSVpv("Left", 0), 0);
break;
case AR_DISPLAY_LABEL_TOP:
hv_store(hash, "labelLocation", strlen("labelLocation") , newSVpv("Top", 0), 0);
break;
}
switch (in->type) {
case AR_DISPLAY_TYPE_NONE:
hv_store(hash, "type", strlen("type") , newSVpv("NONE", 0), 0);
break;
case AR_DISPLAY_TYPE_TEXT:
hv_store(hash, "type", strlen("type") , newSVpv("TEXT", 0), 0);
break;
case AR_DISPLAY_TYPE_NUMTEXT:
hv_store(hash, "type", strlen("type") , newSVpv("NUMTEXT", 0), 0);
break;
case AR_DISPLAY_TYPE_CHECKBOX:
hv_store(hash, "type", strlen("type") , newSVpv("CHECKBOX", 0), 0);
break;
case AR_DISPLAY_TYPE_CHOICE:
hv_store(hash, "type", strlen("type") , newSVpv("CHOICE", 0), 0);
break;
case AR_DISPLAY_TYPE_BUTTON:
hv_store(hash, "type", strlen("type") , newSVpv("BUTTON", 0), 0);
break;
}
hv_store(hash, "length", strlen("length") , newSViv(in->length), 0);
hv_store(hash, "numRows", strlen("numRows") , newSViv(in->numRows), 0);
switch (in->option) {
hv_store(hash, "macroName", strlen("macroName") , newSVpv(in->macroName, 0), 0);
return newRV_noinc((SV *) hash);
}
SV *
perl_ARFieldCharacteristics(ARControlStruct * ctrl, ARFieldCharacteristics * in)
{
HV *hash = newHV();
#if AR_EXPORT_VERSION >= 8L
hv_store(hash, "option", strlen("option") , newSViv(in->option), 0);
#endif
hv_store(hash, "accessOption", strlen("accessOption") , newSViv(in->accessOption), 0);
hv_store(hash, "focus", strlen("focus") , newSViv(in->focus), 0);
#if AR_EXPORT_VERSION < 3
if (in->display)
hv_store(hash, "display", strlen("display") ,
perl_ARDisplayStruct(ctrl, in->display), 0);
#else
hv_store(hash, "props", strlen("props") ,
perl_ARList(ctrl,
(ARList *) & in->props,
(ARS_fn) perl_ARPropStruct,
sizeof(ARPropStruct)), 0);
#endif
if (in->charMenu)
hv_store(hash, "charMenu", strlen("charMenu") , newSVpv(in->charMenu, 0), 0);
hv_store(hash, "fieldId", strlen("fieldId") , newSViv(in->fieldId), 0);
return newRV_noinc((SV *) hash);
}
SV *
perl_ARDDEStruct(ARControlStruct * ctrl, ARDDEStruct * in)
{
HV *hash = newHV();
int action = 0;
hv_store(hash, "serviceName", strlen("serviceName") , newSVpv(in->serviceName, 0), 0);
hv_store(hash, "topic", strlen("topic") , newSVpv(in->topic, 0), 0);
hv_store(hash, "pathToProgram", strlen("pathToProgram") , newSVpv(in->pathToProgram, 0), 0);
hv_store(hash, "action", strlen("action") , newSViv(in->action), 0);
action = in->action;
hv_store(hash, "actionName", strlen("actionName") ,
newSVpv(DDEActionMap[action].name, strlen(DDEActionMap[action].name)), 0);
switch (action) {
case AR_DDE_EXECUTE:
hv_store(hash, "command", strlen("command") , newSVpv(in->command, 0), 0);
hv_store(hash, "item", strlen("item") , &PL_sv_undef, 0);
break;
case AR_DDE_POKE:
hv_store(hash, "item", strlen("item") , newSVpv(in->item, 0), 0);
hv_store(hash, "command", strlen("command") , newSVpv(in->command, 0), 0);
break;
case AR_DDE_REQUEST:
hv_store(hash, "item", strlen("item") , newSVpv(in->item, 0), 0);
hv_store(hash, "command", strlen("command") , &PL_sv_undef, 0);
break;
default:
hv_store(hash, "item", strlen("item") , &PL_sv_undef, 0);
hv_store(hash, "command", strlen("command") , &PL_sv_undef, 0);
break;
}
return newRV_noinc((SV *) hash);
}
SV *
perl_ARActiveLinkActionStruct(ARControlStruct * ctrl, ARActiveLinkActionStruct * in)
{
HV *hash = newHV();
int i = 0;
switch (in->action) {
case AR_ACTIVE_LINK_ACTION_MACRO:
hv_store(hash, "macro", strlen("macro") ,
perl_ARActiveLinkMacroStruct(ctrl, &in->u.macro), 0);
break;
case AR_ACTIVE_LINK_ACTION_FIELDS:
{
ARList *fieldList = NULL;
#if AR_EXPORT_VERSION >= 8L
hv_store(hash, "assign_fields", strlen("assign_fields") ,
perl_ARSetFieldsActionStruct(ctrl,&(in->u.setFields)), 0 );
#else
fieldList = (ARList *) & in->u.fieldList;
hv_store(hash, "assign_fields", strlen("assign_fields") ,
perl_ARList(ctrl,
fieldList,
(ARS_fn) perl_ARFieldAssignStruct,
sizeof(ARFieldAssignStruct)), 0);
#endif
}
break;
case AR_ACTIVE_LINK_ACTION_PROCESS:
hv_store(hash, "process", strlen("process") , newSVpv(in->u.process, 0), 0);
break;
case AR_ACTIVE_LINK_ACTION_MESSAGE:
#if AR_EXPORT_VERSION >= 4
hv_store(hash, "message", strlen("message") ,
perl_ARMessageStruct(ctrl, &(in->u.message)), 0);
#else
hv_store(hash, "message", strlen("message") ,
perl_ARStatusStruct(ctrl, &(in->u.message)), 0);
#endif
break;
case AR_ACTIVE_LINK_ACTION_SET_CHAR:
hv_store(hash, "characteristics", strlen("characteristics") ,
perl_ARFieldCharacteristics(ctrl, &in->u.characteristics), 0);
break;
case AR_ACTIVE_LINK_ACTION_DDE:
hv_store(hash, "dde", strlen("dde") ,
perl_ARDDEStruct(ctrl, &in->u.dde), 0);
break;
#if AR_EXPORT_VERSION >= 4
case AR_ACTIVE_LINK_ACTION_FIELDP:
{
ARList *pushFields = NULL;
#if AR_EXPORT_VERSION >= 8L
case AR_ACTIVE_LINK_ACTION_AUTO:
/*ARAutomationStruct;*/
hv_store(hash, "automation", strlen("automation") ,
perl_ARAutomationStruct(ctrl,
&in->u.automation), 0);
break;
case AR_ACTIVE_LINK_ACTION_OPENDLG:
/*AROpenDlgStruct;*/
hv_store(hash, "openDlg", strlen("openDlg") ,
perl_AROpenDlgStruct(ctrl,
&in->u.openDlg), 0);
break;
case AR_ACTIVE_LINK_ACTION_COMMITC:
/*ARCommitChangesStruct;*/
hv_store(hash, "commitChanges", strlen("commitChanges") ,
perl_ARCommitChangesStruct(ctrl, &in->u.commitChanges), 0);
break;
case AR_ACTIVE_LINK_ACTION_CLOSEWND:
/*ARCloseWndStruct;*/
hv_store(hash, "closeWnd", strlen("closeWnd") ,
perl_ARCloseWndStruct(ctrl,
&in->u.closeWnd), 0);
break;
case AR_ACTIVE_LINK_ACTION_CALLGUIDE:
/*ARCallGuideStruct;*/
hv_store(hash, "callGuide", strlen("callGuide") ,
perl_ARCallGuideStruct(ctrl,
&in->u.callGuide), 0);
break;
case AR_ACTIVE_LINK_ACTION_EXITGUIDE:
/*ARExitGuideStruct;*/
hv_store(hash, "exitGuide", strlen("exitGuide") ,
perl_ARExitGuideStruct(ctrl,
&in->u.exitGuide), 0);
break;
case AR_ACTIVE_LINK_ACTION_GOTOGUIDELABEL:
/*ARGotoGuideLabelStruct;*/
hv_store(hash, "gotoGuideLabel", strlen("gotoGuideLabel") ,
newSVpv(in->u.gotoGuide.label, 0), 0);
break;
case AR_ACTIVE_LINK_ACTION_WAIT:
/*ARWaitStruct;*/
hv_store(hash, "waitAction", strlen("waitAction") ,
perl_ARWaitStruct(ctrl, &in->u.waitAction), 0);
break;
case AR_ACTIVE_LINK_ACTION_GOTOACTION:
/*ARGotoActionStruct;*/
hv_store(hash, "gotoAction", strlen("gotoAction") ,
perl_ARGotoActionStruct(ctrl, &in->u.gotoAction), 0);
break;
#endif
#if AR_CURRENT_API_VERSION >= 13
case AR_ACTIVE_LINK_ACTION_SERVICE:
hv_store(hash, "service", strlen("service") ,
perl_ARActiveLinkSvcActionStruct(ctrl, &in->u.service), 0);
break;
#endif
case AR_ACTIVE_LINK_ACTION_NONE:
hv_store(hash, "none", strlen("none") , &PL_sv_undef, 0);
break;
default:
hv_store(hash, "[unknown]", strlen("[unknown]") , &PL_sv_undef, 0);
break;
}
return newRV_noinc((SV *) hash);
}
SV *
perl_ARFilterActionNotify(ARControlStruct * ctrl, ARFilterActionNotify * in)
{
HV *hash = newHV();
DBG( ("enter\n") );
hv_store(hash, "user", strlen("user") , newSVpv(in->user, 0), 0);
if (in->notifyText) {
hv_store(hash, "notifyText", strlen("notifyText") ,
newSVpv(in->notifyText, 0), 0);
}
hv_store(hash, "notifyPriority", strlen("notifyPriority") ,
newSViv(in->notifyPriority), 0);
hv_store(hash, "notifyMechanism", strlen("notifyMechanism") ,
newSViv(in->notifyMechanism), 0);
hv_store(hash, "notifyMechanismXRef", strlen("notifyMechanismXRef") ,
newSViv(in->notifyMechanismXRef), 0);
if (in->subjectText) {
hv_store(hash, "subjectText", strlen("subjectText") ,
newSVpv(in->subjectText, 0), 0);
}
hv_store(hash, "fieldIdListType", strlen("fieldIdListType") ,
newSViv(in->fieldIdListType), 0);
hv_store(hash, "fieldList", strlen("fieldList") ,
perl_ARList(ctrl,
(ARList *) & in->fieldIdList,
(ARS_fn) perl_ARInternalId,
sizeof(ARInternalId)), 0);
#if AR_EXPORT_VERSION >= 7L
hv_store(hash, "notifyBehavior", strlen("notifyBehavior") ,
newSViv(in->notifyBehavior), 0);
hv_store(hash, "notifyPermission", strlen("notifyPermission") ,
newSViv(in->notifyPermission), 0);
if (in->notifyAdvanced) {
hv_store(hash, "notifyAdvanced", strlen("notifyAdvanced") ,
perl_ARFilterActionNotifyAdvanced(ctrl,in->notifyAdvanced), 0);
}
#endif
return newRV_noinc((SV *) hash);
}
#if AR_EXPORT_VERSION >= 7L
SV *
perl_ARFilterActionNotifyAdvanced( ARControlStruct *ctrl, ARFilterActionNotifyAdvanced *p ){
SV *ret;
{
HV *hash;
hash = newHV();
hv_store(hash, "assign_fields", strlen("assign_fields") ,
perl_ARList(ctrl,
setFields,
(ARS_fn) perl_ARFieldAssignStruct,
sizeof(ARFieldAssignStruct)), 0);
#endif
}
break;
case AR_FILTER_ACTION_PROCESS:
hv_store(hash, "process", strlen("process") , newSVpv(in->u.process, 0), 0);
break;
#if AR_EXPORT_VERSION >= 4
/* added cases for new ACTIONS in ARS v4.0 API, Geoff Endresen, 6/28/2000
copied from AR_ACTIVE_LINK_ACTION_FIELP */
case AR_FILTER_ACTION_FIELDP:
{
ARList *pushFields = NULL;
#if AR_EXPORT_VERSION >= 8L
hv_store(hash, "fieldp", strlen("fieldp") ,
perl_ARPushFieldsActionStruct(ctrl,&(in->u.pushFields)), 0 );
#else
pushFields = (ARList *)& in->u.pushFieldsList;
/*ARPushFieldsList;*/
hv_store(hash, "fieldp", strlen("fieldp") ,
perl_ARList(ctrl,
pushFields,
(ARS_fn) perl_ARPushFieldsStruct,
sizeof(ARPushFieldsStruct)),0);
#endif
}
break;
case AR_FILTER_ACTION_SQL:
/*ARSQLStruct;*/
hv_store(hash, "sqlCommand", strlen("sqlCommand") ,
perl_ARSQLStruct(ctrl, &(in->u.sqlCommand)),0);
break;
case AR_FILTER_ACTION_GOTOACTION:
/*ARGotoActionStruct;*/
hv_store(hash, "gotoAction", strlen("gotoAction") ,
perl_ARGotoActionStruct(ctrl, &in->u.gotoAction), 0);
break;
# if AR_EXPORT_VERSION >= 6L
case AR_FILTER_ACTION_CALLGUIDE:
/*ARCallGuideStruct;*/
hv_store(hash, "callGuide", strlen("callGuide") ,
perl_ARCallGuideStruct(ctrl, &in->u.callGuide), 0);
break;
case AR_FILTER_ACTION_EXITGUIDE:
/*ARExitGuideStruct;*/
hv_store(hash, "exitGuide", strlen("exitGuide") ,
perl_ARExitGuideStruct(ctrl, &in->u.exitGuide), 0);
break;
case AR_FILTER_ACTION_GOTOGUIDELABEL:
/*ARGotoGuideLabelStruct;*/
hv_store(hash, "gotoGuide", strlen("gotoGuide") ,
newSVpv(in->u.gotoGuide.label, 0), 0);
break;
# endif
#endif
case AR_FILTER_ACTION_NONE:
default:
hv_store(hash, "none", strlen("none") , &PL_sv_undef, 0);
break;
}
DBG( ("leave\n") );
return newRV_noinc((SV *) hash);
}
SV *
perl_expandARCharMenuStruct(ARControlStruct * ctrl,
ARCharMenuStruct * in)
{
ARCharMenuStruct menu, *which;
int ret;
unsigned int i;
ARStatusList status;
AV *array;
SV *sub;
char *string;
DBG( ("enter\n") );
Zero(&status, 1, ARStatusList);
Zero(&menu, 1, ARCharMenuStruct);
if (in->menuType != AR_CHAR_MENU_LIST) {
DBG( ("input menu is not a LIST, calling ARExpandCharMenu\n") );
ret = ARExpandCharMenu(ctrl, in,
#if AR_CURRENT_API_VERSION >= 18
0, /* maxRetrieve */
#endif
&menu,
#if AR_CURRENT_API_VERSION >= 18
NULL, /* numMatches */
#endif
&status);
DBG( ("ARECM ret=%d\n", ret) );
if (ARError(ret, status)) {
FreeARCharMenuStruct(&menu, FALSE);
return &PL_sv_undef;
}
which = &menu;
} else {
DBG( ("input menu is a LIST, just using that\n") );
which = in;
}
array = newAV();
DBG( ("expanded menu has %d items\n",
which->u.menuList.numItems) );
for (i = 0; i < which->u.menuList.numItems; i++) {
string = which->u.menuList.charMenuList[i].menuLabel;
av_push(array, newSVpv(string, strlen(string)));
switch (which->u.menuList.charMenuList[i].menuType) {
case AR_MENU_TYPE_VALUE:
string = which->u.menuList.charMenuList[i].u.menuValue;
av_push(array, newSVpv(string, strlen(string)));
break;
case AR_MENU_TYPE_MENU:
sub = perl_expandARCharMenuStruct(ctrl,
which->u.menuList.charMenuList[i].u.childMenu);
if (!sub) {
FreeARCharMenuStruct(&menu, FALSE);
return &PL_sv_undef;
}
av_push(array, sub);
break;
case AR_MENU_TYPE_NONE:
default:
av_push(array, &PL_sv_undef);
break;
}
}
FreeARCharMenuStruct(&menu, FALSE);
return newRV_noinc((SV *) array);
}
SV *
perl_MenuRefreshCode2Str(ARControlStruct * ctrl, unsigned int rc)
{
int i;
for (i = 0;
CharMenuRefreshCodeTypeMap[i].number != TYPEMAP_LAST &&
CharMenuRefreshCodeTypeMap[i].number != rc;
i++);
return newSVpv(CharMenuRefreshCodeTypeMap[i].name, 0);
}
SV *
perl_AREntryListFieldStruct(ARControlStruct * ctrl, AREntryListFieldStruct * in)
{
HV *hash = newHV();
hv_store(hash, "fieldId", strlen("fieldId") , newSViv(in->fieldId), 0);
hv_store(hash, "columnWidth", strlen("columnWidth") , newSViv(in->columnWidth), 0);
hv_store(hash, "separator", strlen("separator") , newSVpv(in->separator, 0), 0);
return newRV_noinc((SV *) hash);
}
SV *
perl_ARIndexStruct(ARControlStruct * ctrl, ARIndexStruct * in)
{
HV *hash = newHV();
AV *array = newAV();
unsigned int i;
if (in->unique)
hv_store(hash, "unique", strlen("unique") , newSViv(1), 0);
for (i = 0; i < in->numFields; i++)
av_push(array, perl_ARInternalId(ctrl, &(in->fieldIds[i])));
hv_store(hash, "fieldIds", strlen("fieldIds") , newRV_noinc((SV *) array), 0);
return newRV_noinc((SV *) hash);
}
SV *
perl_ARFieldLimitStruct(ARControlStruct * ctrl, ARFieldLimitStruct * in)
{
HV *hash = newHV();
SV *qual = newSViv(0);
DBG( ("FLS dt=%d\n", in->dataType) );
hv_store(hash, "dataType", strlen("dataType") , newSViv(in->dataType), 0);
switch (in->dataType) {
case AR_DATA_TYPE_KEYWORD:
hv_store(hash, "precision", strlen("precision") ,
newSViv(in->u.realLimits.precision), 0);
return newRV_noinc((SV *) hash);
case AR_DATA_TYPE_CHAR:
hv_store(hash, "maxLength", strlen("maxLength") ,
newSViv(in->u.charLimits.maxLength), 0);
switch (in->u.charLimits.menuStyle) {
case AR_MENU_APPEND:
hv_store(hash, "menuStyle", strlen("menuStyle") , newSVpv("append", 0), 0);
break;
case AR_MENU_OVERWRITE:
hv_store(hash, "menuStyle", strlen("menuStyle") , newSVpv("overwrite", 0), 0);
break;
}
switch (in->u.charLimits.qbeMatchOperation) {
case AR_QBE_MATCH_ANYWHERE:
hv_store(hash, "match", strlen("match") , newSVpv("anywhere", 0), 0);
break;
case AR_QBE_MATCH_LEADING:
hv_store(hash, "match", strlen("match") , newSVpv("leading", 0), 0);
break;
case AR_QBE_MATCH_EQUAL:
hv_store(hash, "match", strlen("match") , newSVpv("equal", 0), 0);
break;
}
hv_store(hash, "charMenu", strlen("charMenu") ,
newSVpv(in->u.charLimits.charMenu, 0), 0);
if(in->u.charLimits.pattern) {
hv_store(hash, "pattern", strlen("pattern") ,
newSVpv(in->u.charLimits.pattern, 0), 0);
} else {
hv_store(hash, "pattern", strlen("pattern"),
&PL_sv_undef, 0);
}
switch (in->u.charLimits.fullTextOptions) {
case AR_FULLTEXT_OPTIONS_NONE:
hv_store(hash, "fullTextOptions", strlen("fullTextOptions") , newSVpv("none", 0), 0);
break;
case AR_FULLTEXT_OPTIONS_INDEXED:
hv_store(hash, "fullTextOptions", strlen("fullTextOptions") , newSVpv("indexed", 0), 0);
break;
}
#if AR_CURRENT_API_VERSION >= 14
switch (in->u.charLimits.lengthUnits) {
case AR_LENGTH_UNIT_BYTE:
hv_store(hash, "lengthUnits", strlen("lengthUnits") , newSVpv("byte", 0), 0);
break;
case AR_LENGTH_UNIT_CHAR:
hv_store(hash, "lengthUnits", strlen("lengthUnits") , newSVpv("char", 0), 0);
break;
}
switch (in->u.charLimits.storageOptionForCLOB) {
case AR_STORE_OPT_DEF:
hv_store(hash, "storageOptionForCLOB", strlen("storageOptionForCLOB") , newSVpv("default", 0), 0);
break;
case AR_STORE_OPT_INROW:
hv_store(hash, "storageOptionForCLOB", strlen("storageOptionForCLOB") , newSVpv("inrow", 0), 0);
break;
case AR_STORE_OPT_OUTROW:
hv_store(hash, "storageOptionForCLOB", strlen("storageOptionForCLOB") , newSVpv("outrow", 0), 0);
break;
}
#endif
return newRV_noinc((SV *) hash);
case AR_DATA_TYPE_DIARY:
switch (in->u.diaryLimits.fullTextOptions) {
case AR_FULLTEXT_OPTIONS_NONE:
hv_store(hash, "fullTextOptions", strlen("fullTextOptions") , newSVpv("none", 0), 0);
break;
case AR_FULLTEXT_OPTIONS_INDEXED:
hv_store(hash, "fullTextOptions", strlen("fullTextOptions") , newSVpv("indexed", 0), 0);
break;
}
return newRV_noinc((SV *) hash);
case AR_DATA_TYPE_ENUM:
/*
* as of 5.x, eunmLimits went from a list of ARNameType
* to an AREnumLimitsStruct (true for 5.0.1 and beyond -
* 5.0beta still had it as a list of NameTypes)
*/
#if AR_EXPORT_VERSION >= 6L
DBG( ("case ENUM api v6+\n") );
hv_store(hash, "enumLimits", strlen("enumLimits") ,
perl_AREnumLimitsStruct(ctrl,
&(in->u.enumLimits))
,0
);
#else
DBG( ("case ENUM api v-6\n") );
hv_store(hash, "enumLimits", strlen("enumLimits") ,
perl_ARList(ctrl, (ARList *) & (in->u.enumLimits),
(ARS_fn) perl_ARNameType,
sizeof(ARNameType)),
0);
#endif
return newRV_noinc((SV *) hash);
case AR_DATA_TYPE_TIME:
return &PL_sv_undef;
case AR_DATA_TYPE_BITMASK:
DBG( ("case BITMASK\n") );
#if AR_EXPORT_VERSION >= 6L
hv_store(hash, "maskLimits", strlen("maskLimits") ,
perl_AREnumLimitsStruct(ctrl,
&(in->u.enumLimits))
,0
);
hv_store(hash, "attachType", strlen("attachType") , newSViv(in->u.attachLimits.attachType), 0);
return newRV_noinc((SV *) hash);
#if AR_EXPORT_VERSION >= 7
case AR_DATA_TYPE_CURRENCY:
hv_store(hash, "rangeLow", strlen("rangeLow") , newSVpv(in->u.currencyLimits.rangeLow, 0), 0);
hv_store(hash, "rangeHigh", strlen("rangeHigh") , newSVpv(in->u.currencyLimits.rangeHigh, 0), 0);
hv_store(hash, "precision", strlen("precision") , newSViv(in->u.currencyLimits.precision), 0);
hv_store(hash, "functionalCurrencies", strlen("functionalCurrencies"), perl_ARCurrencyDetailList(ctrl,&(in->u.currencyLimits.functionalCurrencies)), 0 );
hv_store(hash, "allowableCurrencies", strlen("allowableCurrencies"), perl_ARCurrencyDetailList(ctrl,&(in->u.currencyLimits.allowableCurrencies)), 0 );
return newRV_noinc((SV *) hash);
case AR_DATA_TYPE_DATE:
return &PL_sv_undef;
case AR_DATA_TYPE_TIME_OF_DAY:
return &PL_sv_undef;
#endif
case AR_DATA_TYPE_TABLE:
hv_store(hash, "numColumns", strlen("numColumns") , newSViv(in->u.tableLimits.numColumns), 0);
hv_store(hash, "qualifier", strlen("qualifier"), newRV_inc((SV*) perl_qualifier(ctrl,&(in->u.tableLimits.qualifier))), 0);
hv_store(hash, "maxRetrieve", strlen("maxRetrieve") , newSViv(in->u.tableLimits.maxRetrieve), 0);
hv_store(hash, "schema", strlen("schema") , newSVpv(in->u.tableLimits.schema, 0), 0);
hv_store(hash, "server", strlen("server") , newSVpv(in->u.tableLimits.server, 0), 0);
#if AR_EXPORT_VERSION >= 8L
hv_store(hash, "sampleSchema", strlen("sampleSchema") , newSVpv(in->u.tableLimits.sampleSchema, 0), 0);
hv_store(hash, "sampleServer", strlen("sampleServer") , newSVpv(in->u.tableLimits.sampleServer, 0), 0);
#endif
return newRV_noinc((SV *) hash);
case AR_DATA_TYPE_COLUMN:
hv_store(hash, "parent", strlen("parent"), perl_ARInternalId(ctrl, &(in->u.columnLimits.parent)), 0);
hv_store(hash, "dataField", strlen("dataField"), perl_ARInternalId(ctrl, &(in->u.columnLimits.dataField)), 0);
#if AR_EXPORT_VERSION >= 6L
hv_store(hash, "dataSource", strlen("dataSource") , newSViv(in->u.columnLimits.dataSource), 0);
#endif
hv_store(hash, "colLength", strlen("colLength") , newSViv(in->u.columnLimits.colLength), 0);
return newRV_noinc((SV *) hash);
#if AR_EXPORT_VERSION >= 6L
case AR_DATA_TYPE_VIEW:
hv_store(hash, "maxLength", strlen("maxLength") , newSViv(in->u.viewLimits.maxLength), 0);
return newRV_noinc((SV *) hash);
case AR_DATA_TYPE_DISPLAY:
hv_store(hash, "maxLength", strlen("maxLength") , newSViv(in->u.displayLimits.maxLength), 0);
#if AR_API_VERSION >= 14
switch (in->u.charLimits.lengthUnits) {
case AR_LENGTH_UNIT_BYTE:
hv_store(hash, "lengthUnits", strlen("lengthUnits") , newSVpv("byte", 0), 0);
break;
case AR_LENGTH_UNIT_CHAR:
hv_store(hash, "lengthUnits", strlen("lengthUnits") , newSVpv("char", 0), 0);
break;
}
#endif
return newRV_noinc((SV *) hash);
#endif
case AR_DATA_TYPE_NULL:
default:
/* no meaningful limits */
return &PL_sv_undef;
}
}
SV *
perl_ARAssignStruct(ARControlStruct * ctrl, ARAssignStruct * in)
{
HV *hash = newHV();
switch (in->assignType) {
case AR_ASSIGN_TYPE_NONE:
hv_store(hash, "none", strlen("none") , &PL_sv_undef, 0);
break;
case AR_ASSIGN_TYPE_VALUE:
/*
* we will also be storing the specific AR_DATA_TYPE_* since
* this is used in the rev_* routines to translate back. we
* wouldnt be able to derive the datatype in any other
* fashion.
*/
/*
* 1998-03-12 patch the assign struct stores assign field
* actions on diary fields as character assignments (makes
* sense). but this means we can't use the standard
* perl_ARValueStruct call to decode. we need to have a
* 'special' one that will decode DIARY or CHAR types as if
* they are both CHAR types.
*/
hv_store(hash, "value", strlen("value") ,
perl_ARValueStruct_Assign(ctrl, &in->u.value), 0);
hv_store(hash, "valueType", strlen("valueType") ,
perl_ARValueStructType_Assign(ctrl, &in->u.value), 0);
break;
case AR_ASSIGN_TYPE_FIELD:
hv_store(hash, "field", strlen("field") ,
perl_ARAssignFieldStruct(ctrl, in->u.field), 0);
break;
case AR_ASSIGN_TYPE_PROCESS:
hv_store(hash, "process", strlen("process") , newSVpv(in->u.process, 0), 0);
break;
case AR_ASSIGN_TYPE_ARITH:
hv_store(hash, "arith", strlen("arith") ,
perl_ARArithOpAssignStruct(ctrl, in->u.arithOp), 0);
break;
case AR_ASSIGN_TYPE_FUNCTION:
hv_store(hash, "function", strlen("function") ,
perl_ARFunctionAssignStruct(ctrl, in->u.function), 0);
break;
case AR_ASSIGN_TYPE_DDE:
hv_store(hash, "dde", strlen("dde") , perl_ARDDEStruct(ctrl, in->u.dde), 0);
break;
#if AR_EXPORT_VERSION >= 3
case AR_ASSIGN_TYPE_SQL:
hv_store(hash, "sql", strlen("sql") , perl_ARAssignSQLStruct(ctrl, in->u.sql), 0);
break;
#endif
#if AR_EXPORT_VERSION >= 6L
case AR_ASSIGN_TYPE_FILTER_API:
hv_store(hash, "filterApi", strlen("filterApi") , perl_ARAssignFilterApiStruct(ctrl, in->u.filterApi), 0);
break;
#endif /* ARS 3.x */
default:
hv_store(hash, "none", strlen("none") , &PL_sv_undef, 0);
break;
}
return newRV_noinc((SV *) hash);
}
#if AR_EXPORT_VERSION >= 4
SV *
perl_ARSQLStruct(ARControlStruct * ctrl, ARSQLStruct * in)
{
HV *hash = newHV();
hv_store(hash, "server", strlen("server") , newSVpv(in->server, 0), 0);
hv_store(hash, "command", strlen("command") , newSVpv(in->command, 0), 0);
return newRV_noinc((SV *) hash);
}
#endif
#if AR_EXPORT_VERSION >= 3
SV *
perl_ARAssignSQLStruct(ARControlStruct * ctrl, ARAssignSQLStruct * in)
{
HV *hash = newHV();
int i;
hv_store(hash, "server", strlen("server") , newSVpv(in->server, 0), 0);
hv_store(hash, "sqlCommand", strlen("sqlCommand") , newSVpv(in->sqlCommand, 0), 0);
hv_store(hash, "valueIndex", strlen("valueIndex") , newSViv(in->valueIndex), 0);
/* translate the noMatchOption value into english */
for (i = 0; NoMatchOptionMap[i].number != TYPEMAP_LAST; i++)
if (NoMatchOptionMap[i].number == in->noMatchOption)
break;
if (NoMatchOptionMap[i].number == TYPEMAP_LAST) {
char optnum[25];
sprintf(optnum, "%u", in->noMatchOption);
ARError_add(AR_RETURN_WARNING, AP_ERR_GENERAL,
"perl_ARAssignSQLStruct: unknown noMatchOption value");
ARError_add(AR_RETURN_WARNING, AP_ERR_GENERAL, optnum);
}
/* if we didn't find a match, store "" */
hv_store(hash, "noMatchOption", strlen("noMatchOption") , newSVpv(NoMatchOptionMap[i].name, 0), 0);
/* translate the multiMatchOption value into english */
for (i = 0; MultiMatchOptionMap[i].number != TYPEMAP_LAST; i++)
if (MultiMatchOptionMap[i].number == in->multiMatchOption)
break;
if (MultiMatchOptionMap[i].number == TYPEMAP_LAST) {
char optnum[25];
sprintf(optnum, "%u", in->multiMatchOption);
ARError_add(AR_RETURN_WARNING, AP_ERR_GENERAL,
"perl_ARAssignFieldStruct: unknown multiMatchOption value");
ARError_add(AR_RETURN_WARNING, AP_ERR_GENERAL, optnum);
}
hv_store(hash, "multiMatchOption", strlen("multiMatchOption") ,
newSVpv(MultiMatchOptionMap[i].name, 0), 0);
hv_store(hash, "inputValues", strlen("inputValues") , perl_ARAssignStruct(ctrl, in->inputValues), 0);
hv_store(hash, "valueIndex", strlen("valueIndex") , newSViv(in->valueIndex), 0);
return newRV_noinc((SV *) hash);
}
#endif
SV *
perl_ARFunctionAssignStruct(ARControlStruct * ctrl, ARFunctionAssignStruct * in)
{
AV *array = newAV();
unsigned int i;
for (i = 0; FunctionMap[i].number != TYPEMAP_LAST; i++)
if (FunctionMap[i].number == in->functionCode)
break;
av_push(array, newSVpv(FunctionMap[i].name, 0));
for (i = 0; i < in->numItems; i++)
av_push(array, perl_ARAssignStruct(ctrl, &in->parameterList[i]));
return newRV_noinc((SV *) array);
}
SV *
perl_ARArithOpAssignStruct(ARControlStruct * ctrl, ARArithOpAssignStruct * in)
{
HV *hash = newHV();
int i;
for (i = 0; ArithOpMap[i].number != TYPEMAP_LAST; i++)
if (ArithOpMap[i].number == in->operation)
break;
hv_store(hash, "oper", strlen("oper") , newSVpv(ArithOpMap[i].name, 0), 0);
if (in->operation == AR_ARITH_OP_NEGATE) {
hv_store(hash, "right", strlen("right") , perl_ARAssignStruct(ctrl, &in->operandRight), 0);
} else {
hv_store(hash, "right", strlen("right") , perl_ARAssignStruct(ctrl, &in->operandRight), 0);
hv_store(hash, "left", strlen("left") , perl_ARAssignStruct(ctrl, &in->operandLeft), 0);
}
return newRV_noinc((SV *) hash);
}
SV *
perl_ARPermissionList(ARControlStruct * ctrl, ARPermissionList * in, int permType)
{
HV *hash = newHV();
char groupid[20];
int j;
unsigned int i;
TypeMapStruct *tmap;
switch (permType) {
case PERMTYPE_SCHEMA:
tmap = (TypeMapStruct *) SchemaPermissionTypeMap;
break;
case PERMTYPE_FIELD:
default:
tmap = (TypeMapStruct *) FieldPermissionTypeMap;
}
/* printf("numItems = %d\n", in->numItems); */
for (i = 0; i < in->numItems; i++) {
/* printf("[%d] %i\n", i, (int) in->permissionList[i].groupId); */
sprintf(groupid, "%i", (int) in->permissionList[i].groupId);
for (j = 0; tmap[j].number != TYPEMAP_LAST; j++) {
if (tmap[j].number == in->permissionList[i].permissions)
break;
}
hv_store(hash, groupid, strlen(groupid) , newSVpv( tmap[j].name, strlen(tmap[j].name) ), 0);
}
return newRV_noinc((SV *) hash);
}
#if AR_EXPORT_VERSION >= 3
/* ROUTINE
* my_strtok(string, token-buffer, token-buffer-length, separator)
*
* DESCRIPTION
* since strtok doesn't handle things like:
* "a||b" -> "a" "" "b"
* well, i wrote this tokenizer which behaves more like
* the perl "split" command.
*
* RETURNS
* non-NULL char pointer on success (more string to process)
* NULL char ptr on end-of-string
*
* AUTHOR
* jeff murphy
*/
static char *
my_strtok(char *str, char *tok, int tlen, char sep)
{
char *p = str;
int i;
/* str is NULL, we're done */
if ( !str )
return NULL;
for (i = 0; i < tlen; i++)
*(tok + i) = 0;
/* if p is sep, then tok is null */
if (*p == sep) {
*tok = 0;
return p;
}
/* else copy p to tok until end of string or sep */
while (*p && (*p != sep)) {
*tok = *p;
case AR_COND_OP_NONE:
break;
}
return n;
}
/* assumes qual struct is not pre-allocated */
ARQualifierStruct *
dup_qualifier(ARControlStruct * ctrl, ARQualifierStruct * in)
{
ARQualifierStruct *n;
if (!in)
return NULL;
n = MALLOCNN(sizeof(ARQualifierStruct));
n->operation = in->operation;
switch (in->operation) {
case AR_COND_OP_AND:
case AR_COND_OP_OR:
n->u.andor.operandLeft = dup_qualifier(ctrl, in->u.andor.operandLeft);
n->u.andor.operandRight = dup_qualifier(ctrl, in->u.andor.operandRight);
break;
case AR_COND_OP_NOT:
n->u.not = dup_qualifier(ctrl, in->u.not);
break;
case AR_COND_OP_REL_OP:
n->u.relOp = dup_RelOp(ctrl, in->u.relOp);
break;
case AR_COND_OP_NONE:
break;
}
return n;
}
SV *
perl_ARArithOpStruct(ARControlStruct * ctrl, ARArithOpStruct * in)
{
HV *hash = newHV();
char *oper = "";
switch (in->operation) {
case AR_ARITH_OP_ADD:
oper = "+";
break;
case AR_ARITH_OP_SUBTRACT:
oper = "-";
break;
case AR_ARITH_OP_MULTIPLY:
oper = "*";
break;
case AR_ARITH_OP_DIVIDE:
oper = "/";
break;
case AR_ARITH_OP_MODULO:
oper = "%";
break;
case AR_ARITH_OP_NEGATE:
oper = "-";
break;
default:
{
char _em[80];
(void) sprintf(_em,
"Unknown arith operation in ARArithOpStruct: %8.8i\n",
in->operation);
(void) ARError_add(AR_RETURN_ERROR, AP_ERR_INV_ARITH,
_em);
}
break;
}
hv_store(hash, "oper", strlen("oper") , newSVpv(oper, 0), 0);
if (in->operation == AR_ARITH_OP_NEGATE) {
/* hv_store(hash, "left", strlen("left") ,
perl_ARFieldValueOrArithStruct(ctrl, &in->operandLeft), 0); */
hv_store(hash, "right", strlen("right") ,
perl_ARFieldValueOrArithStruct(ctrl, &in->operandRight), 0);
} else {
hv_store(hash, "right", strlen("right") ,
perl_ARFieldValueOrArithStruct(ctrl, &in->operandRight), 0);
hv_store(hash, "left", strlen("left") ,
perl_ARFieldValueOrArithStruct(ctrl, &in->operandLeft), 0);
}
return newRV_noinc((SV *) hash);
}
SV *
perl_ARQueryValueStruct(ARControlStruct * ctrl, ARQueryValueStruct * in)
{
HV *hash = newHV();
SV *ref;
ARQualifierStruct *qual;
hv_store(hash, "schema", strlen("schema") , newSVpv(in->schema, 0), 0);
hv_store(hash, "server", strlen("server") , newSVpv(in->server, 0), 0);
qual = dup_qualifier(ctrl, in->qualifier);
ref = newSViv(0);
sv_setref_pv(ref, "ARQualifierStructPtr", (void *) qual);
hv_store(hash, "qualifier", strlen("qualifier") , ref, 0);
hv_store(hash, "valueField", strlen("valueField") , newSViv(in->valueField), 0);
switch (in->multiMatchCode) {
case AR_QUERY_VALUE_MULTI_ERROR:
hv_store(hash, "multi", strlen("multi") , newSVpv("error", 0), 0);
break;
case AR_QUERY_VALUE_MULTI_FIRST:
hv_store(hash, "multi", strlen("multi") , newSVpv("first", 0), 0);
break;
case AR_QUERY_VALUE_MULTI_SET:
hv_store(hash, "multi", strlen("multi") , newSVpv("set", 0), 0);
break;
}
return newRV_noinc((SV *) hash);
}
#if AR_EXPORT_VERSION >= 5
SV *
perl_ARWorkflowConnectStruct(ARControlStruct * ctrl, ARWorkflowConnectStruct * in)
{
HV *hash = newHV();
switch (in->type) {
switch (in->operation) {
case AR_COND_OP_AND:
s = "and";
hv_store(hash, "left", strlen("left") ,
newRV_noinc((SV *) perl_qualifier(ctrl, in->u.andor.operandLeft)), 0);
hv_store(hash, "right", strlen("right") ,
newRV_noinc((SV *) perl_qualifier(ctrl, in->u.andor.operandRight)), 0);
break;
case AR_COND_OP_OR:
s = "or";
hv_store(hash, "left", strlen("left") ,
newRV_noinc((SV *) perl_qualifier(ctrl, in->u.andor.operandLeft)), 0);
hv_store(hash, "right", strlen("right") ,
newRV_noinc((SV *) perl_qualifier(ctrl, in->u.andor.operandRight)), 0);
break;
case AR_COND_OP_NOT:
s = "not";
hv_store(hash, "not", strlen("not") ,
newRV_noinc((SV *) perl_qualifier(ctrl, in->u.not)), 0);
break;
case AR_COND_OP_REL_OP:
s = "rel_op";
hv_store(hash, "rel_op", strlen("rel_op") ,
perl_relOp(ctrl, in->u.relOp), 0);
break;
#if AR_EXPORT_VERSION >= 6L
case AR_COND_OP_FROM_FIELD:
s = "external";
hv_store(hash, "fieldId", strlen("fieldId") ,
newSViv(in->u.fieldId), 0);
break;
#endif
}
hv_store(hash, "oper", strlen("oper") , newSVpv(s, 0), 0);
}
return hash;
}
ARDisplayList *
dup_DisplayList(ARControlStruct * ctrl, ARDisplayList * disp)
{
ARDisplayList *new_disp;
new_disp = MALLOCNN(sizeof(ARDisplayList));
new_disp->numItems = disp->numItems;
new_disp->displayList = MALLOCNN(sizeof(ARDisplayStruct) * disp->numItems);
memcpy(new_disp->displayList, disp->displayList,
sizeof(ARDisplayStruct) * disp->numItems);
return new_disp;
}
int
ARGetFieldCached(ARControlStruct * ctrl, ARNameType schema, ARInternalId id,
ARNameType fieldName, ARFieldMappingStruct * fieldMap,
unsigned int *dataType, unsigned int *option,
unsigned int *createMode,
#if AR_CURRENT_API_VERSION >= 12
unsigned int *fieldOption,
#endif
ARValueStruct * defaultVal,
#if AR_CURRENT_API_VERSION >= 17
ARPermissionList * assignedGroupList,
#endif
ARPermissionList * perm, ARFieldLimitStruct * limit,
ARDisplayInstanceList * display,
char **help, ARTimestamp * timestamp,
ARNameType owner, ARNameType lastChanged, char **changeDiary,
#if AR_CURRENT_API_VERSION >= 17
ARPropList * objPropList,
#endif
ARStatusList * Status)
{
int ret;
HV *fields, *base;
SV **field, **val;
unsigned int my_dataType;
ARNameType my_fieldName;
char field_string[20];
#if AR_CURRENT_API_VERSION >= 17
/* cache fieldName and dataType */
if (fieldMap || option || createMode || fieldOption || defaultVal || assignedGroupList || perm || limit ||
display || help || timestamp || owner || lastChanged || changeDiary || objPropList) {
(void) ARError_add(ARSPERL_TRACEBACK, 1,
"ARGetFieldCached: uncached parameter requested.");
goto cache_fail;
}
#elif AR_CURRENT_API_VERSION >= 12
/* cache fieldName and dataType */
if (fieldMap || option || createMode || fieldOption || defaultVal || perm || limit ||
display || help || timestamp || owner || lastChanged || changeDiary) {
(void) ARError_add(ARSPERL_TRACEBACK, 1,
"ARGetFieldCached: uncached parameter requested.");
goto cache_fail;
}
#else
/* cache fieldName and dataType */
if (fieldMap || option || createMode || defaultVal || perm || limit ||
display || help || timestamp || owner || lastChanged || changeDiary) {
(void) ARError_add(ARSPERL_TRACEBACK, 1,
"ARGetFieldCached: uncached parameter requested.");
goto cache_fail;
}
#endif
fields = fieldcache_get_schema_fields( ctrl, schema, FALSE );
if( ! fields ) goto cache_fail;
sprintf(field_string, "%i", (int) id);
field = hv_fetch(fields, field_string, strlen(field_string) , TRUE);
if (!(field && SvROK(*field) && SvTYPE(base = (HV *) SvRV(*field)))) {
(void) ARError_add(ARSPERL_TRACEBACK, 1,
"GetFieldCached failed to fetch fieldId from hash");
goto cache_fail;
}
/* fetch values */
val = hv_fetch(base, "name", strlen("name") , FALSE);
if (!val) {
(void) ARError_add(ARSPERL_TRACEBACK, 1,
"GetFieldCached failed to fetch name key");
goto cache_fail;
}
if (fieldName) {
strcpy(fieldName, SvPV((*val), PL_na));
}
val = hv_fetch(base, "type", strlen("type") , FALSE);
if (!val) {
(void) ARError_add(ARSPERL_TRACEBACK, 1,
"GetFieldCached failed to fetch type key");
goto cache_fail;
}
if (dataType) {
*dataType = SvIV(*val);
}
return 0;
/*
* if we don't cache one of the arguments or we couldn't find field
* in cache.. then we need to do a query to find the data.
*/
cache_fail:;
#if AR_CURRENT_API_VERSION >= 17
ret = ARGetField(ctrl, schema, id, my_fieldName, fieldMap, &my_dataType,
option, createMode, fieldOption, defaultVal, assignedGroupList, perm, limit,
display, help, timestamp, owner, lastChanged,
changeDiary, objPropList, Status);
#elif AR_CURRENT_API_VERSION >= 12
ret = ARGetField(ctrl, schema, id, my_fieldName, fieldMap, &my_dataType,
option, createMode, fieldOption, defaultVal, perm, limit,
display, help, timestamp, owner, lastChanged,
changeDiary, Status);
#else
ret = ARGetField(ctrl, schema, id, my_fieldName, fieldMap, &my_dataType,
option, createMode, defaultVal, perm, limit,
display, help, timestamp, owner, lastChanged,
changeDiary, Status);
#endif
#ifdef PROFILE
((ars_ctrl *) ctrl)->queries++;
#endif
if (dataType) *dataType = my_dataType;
if (fieldName) strcpy(fieldName, my_fieldName);
if (ret == 0) { /* if ARGetField was successful */
fields = fieldcache_get_schema_fields( ctrl, schema, FALSE );
if( fields ){
fieldcache_store_field_info( fields, id, my_fieldName, my_dataType, NULL );
}else{
return ret;
}
} else {
(void) ARError_add(ARSPERL_TRACEBACK, 1,
"GetFieldCached: ARGetField call failed.");
}
return ret;
}
HV*
fieldcache_get_schema_fields( ARControlStruct *ctrl, char *schema_name, int load_if_incomplete )
{
HV *cache, *server, *fields;
SV **servers, **schema_fields;
char server_tag[100];
/* Add pointer address of ARControlStruct to field_cache hash key to avoid collisions
between different server instances on the same host system. The server_tag should
really rather be "server:tcpport", but there seems to be no efficient way to get
the port number from ARControlStruct, so we'll have to live with this (quite ugly)
solution */
sprintf( server_tag, "%s:%p", ctrl->server, ctrl );
/* get variable */
cache = perl_get_hv("ARS::field_cache", TRUE);
/* dereference hash with server */
servers = hv_fetch(cache, server_tag, strlen(server_tag) , TRUE);
if (!servers) {
(void) ARError_add(ARSPERL_TRACEBACK, 1,
"GetFieldCached (part 2) failed to fetch/create servers key");
return NULL;
}
if (!SvROK(*servers) || SvTYPE(SvRV(*servers)) != SVt_PVHV) {
sv_setsv(*servers, newRV_noinc((SV *) (server = newHV())));
} else {
server = (HV *) SvRV(*servers);
}
/* dereference hash with schema */
schema_fields = hv_fetch(server, schema_name, strlen(schema_name) , TRUE);
SV **val;
HV *base;
char field_string[20];
sprintf(field_string, "%i", (int) fieldId);
field = hv_fetch(fields, field_string, strlen(field_string), FALSE );
if( !field ){
/* (void) ARError_add(ARSPERL_TRACEBACK, 1,
"GetFieldCached (part 2) failed to fetch/create field key"); */
return dataType; /* invalid value */
}
base = (HV *) SvRV(*field);
val = hv_fetch( base, "type", 4, FALSE );
if( val && *val ){ /* && SvUOK(*val) ){ */
dataType = SvUV( (SV*) *val );
}else{
(void) ARError_add(ARSPERL_TRACEBACK, 1, "Invalid field cache data");
return dataType; /* invalid value */
}
return dataType;
}
int
fieldcache_load_schema( ARControlStruct *ctrl, char *schema, ARInternalIdList *getFieldIds, char **attrs )
{
int ret = 0;
unsigned int loop = 0;
ARInternalIdList idList;
ARStatusList status;
ARBooleanList existList;
ARNameList nameList;
ARUnsignedIntList dataTypeList;
HV *fields;
fields = fieldcache_get_schema_fields( ctrl, schema, FALSE );
if( ! fields ){
return AR_RETURN_ERROR;
}
Zero(&idList, 1, ARInternalIdList);
Zero(&status, 1, ARStatusList);
Zero(&existList, 1, ARBooleanList);
Zero(&nameList, 1, ARNameList);
Zero(&dataTypeList, 1, ARUnsignedIntList);
ret = ARGetMultipleFields( ctrl, schema,
getFieldIds, /* fieldIdList (input) */
&existList,
&idList,
&nameList,
NULL, /* fieldMappingList */
&dataTypeList,
NULL, /* option */
NULL, /* createMode */
#if AR_CURRENT_API_VERSION >= 12
NULL, /* fieldOption */
#endif
NULL, /* defaultVal */
#if AR_CURRENT_API_VERSION >= 17
NULL, /* assginedGrouList */
#endif
NULL, /* permissions */
NULL, /* limit */
NULL, /* dInstanceList */
NULL, /* helptext */
NULL, /* timestamp */
NULL, /* owner */
NULL, /* lastChanged */
NULL, /* changeDiary */
#if AR_CURRENT_API_VERSION >= 17
NULL, /* objPropListList */
#endif
&status );
#ifdef PROFILE
((ars_ctrl *)control)->queries++;
#endif
if( ! ARError( ret, status) ){
for( loop=0; loop < idList.numItems; loop++ ){
#ifdef ARSPERL_DEBUG
printf( "-- %s [%d] -> load\n", schema, idList.internalIdList[loop] ); fflush(stdout);
#endif
fieldcache_store_field_info( fields, idList.internalIdList[loop], nameList.nameList[loop], dataTypeList.intList[loop], NULL );
}
if( getFieldIds == NULL ){
fieldcache_store_field_info( fields, 0, "__COMPLETE__", 0, NULL );
}
}
FreeARInternalIdList(&idList, FALSE);
FreeARNameList(&nameList, FALSE);
FreeARUnsignedIntList(&dataTypeList, FALSE);
FreeARBooleanList(&existList, FALSE);
return ret;
}
int
sv_to_ARValue(ARControlStruct * ctrl, SV * in, unsigned int dataType,
ARValueStruct * out)
{
AV *array, *array2;
HV *hash;
SV **fetch, *type, *val, **fetch2;
char *bytelist;
unsigned int i;
STRLEN len;
out->dataType = dataType;
if (!SvOK(in)) {
/* pass a NULL */
out->dataType = AR_DATA_TYPE_NULL;
} else {
switch (dataType) {
case AR_DATA_TYPE_NULL:
break;
case AR_DATA_TYPE_KEYWORD:
out->u.keyNum = SvIV(in);
break;
#if AR_EXPORT_VERSION >= 3
case AR_DATA_TYPE_BYTES:
if (SvROK(in)) {
if (SvTYPE(hash = (HV *) SvRV(in)) == SVt_PVHV) {
fetch = hv_fetch(hash, "type", 4, FALSE);
if (!fetch) {
ARError_add(AR_RETURN_ERROR, AP_ERR_BYTE_LIST);
return -1;
}
type = *fetch;
if (!(SvOK(type) && SvTYPE(type) < SVt_PVAV)) {
ARError_add(AR_RETURN_ERROR, AP_ERR_BYTE_LIST);
return -1;
}
fetch = hv_fetch(hash, "value", strlen("value") , FALSE);
if (!fetch) {
ARError_add(AR_RETURN_ERROR, AP_ERR_BYTE_LIST);
return -1;
}
val = *fetch;
if (!(SvOK(val) && SvTYPE(val) < SVt_PVAV)) {
ARError_add(AR_RETURN_ERROR, AP_ERR_BYTE_LIST);
return -1;
}
out->u.byteListVal = MALLOCNN(sizeof(ARByteList));
out->u.byteListVal->type = SvIV(type);
bytelist = SvPV(val, len);
out->u.byteListVal->numItems = len;
out->u.byteListVal->bytes = MALLOCNN(len);
memcpy(out->u.byteListVal->bytes, bytelist, len);
break;
}
}
ARError_add(AR_RETURN_ERROR, AP_ERR_BYTE_LIST);
return -1;
case AR_DATA_TYPE_ULONG:
out->u.ulongVal = SvIV(in); /* FIX -- does perl have
* ulong ? */
break;
#if AR_EXPORT_VERSION >= 4
case AR_DATA_TYPE_DECIMAL:
out->u.decimalVal = strdup(SvPV(in, PL_na));
break;
case AR_DATA_TYPE_ATTACH:
/* value must be a hash reference */
if (SvROK(in)) {
if (SvTYPE(hash = (HV *) SvRV(in)) == SVt_PVHV) {
ARAttachStruct *attachp = MALLOCNN(sizeof(ARAttachStruct));
ARLocStruct *locp = &(attachp->loc);
long size = 0;
SV *name = NULL;
/*
* the hash should contain keys:
* file (a filename) or
* buffer (a buffer)
* and all of:
* size (length of file or buffer)
* name (the name to give the attachment)
* name defaults to the filename or "Anonymous Incore Buffer"
*/
/* first: decode the size key */
fetch = hv_fetch(hash, "size", strlen("size") , FALSE);
if (!fetch) {
AP_FREE(attachp);
ARError_add(AR_RETURN_ERROR, AP_ERR_ATTACH,
"Must specify 'size' key.");
return -1;
}
if (!(SvOK(*fetch) && SvTYPE(*fetch) < SVt_PVAV)) {
AP_FREE(attachp);
ARError_add(AR_RETURN_ERROR, AP_ERR_ATTACH,
"'size' key does not map to scalar value.");
return -1;
}
size = SvIV(*fetch);
/* now get the name, if any */
fetch = hv_fetch(hash, "name", strlen("name") , FALSE);
if( !fetch)
name = NULL;
else
name = *fetch;
/*
* next: determine if we are dealing
* with an in core buffer or a
* filename and setup the
* AttachStruct.name field
* accordingly
*/
fetch = hv_fetch(hash, "file", strlen("file") , FALSE);
fetch2 = hv_fetch(hash, "buffer", strlen("buffer") , FALSE);
/*
* either/or must be specifed: not
* both and not neither
*/
if ((!fetch && !fetch2) || (fetch && fetch2)) {
AP_FREE(attachp);
ARError_add(AR_RETURN_ERROR, AP_ERR_ATTACH,
"Must specify one either 'file' or 'buffer' key.");
return -1;
}
/* we've been given a filename */
if (fetch) {
char *filename;
STRLEN filenamelen;
if (!(SvOK(*fetch) && SvTYPE(*fetch) < SVt_PVAV)) {
AP_FREE(attachp);
ARError_add(AR_RETURN_ERROR, AP_ERR_ATTACH,
"'file' key does not map to scalar value.");
return -1;
else {
STRLEN __len; /* dummy variable */
if (!(SvOK(*fetch2) && SvTYPE(*fetch2) < SVt_PVAV)) {
AP_FREE(attachp);
ARError_add(AR_RETURN_ERROR, AP_ERR_ATTACH,
"'buffer' key does not map to scalar value.");
return -1;
}
if (name)
attachp->name = strdup(SvPV(name, __len));
else
attachp->name = strdup("Anonymous In-core Buffer");
locp->locType = AR_LOC_BUFFER;
locp->u.buf.bufSize = size;
locp->u.buf.buffer = MALLOCNN(size);
memcpy(locp->u.buf.buffer, SvPV(*fetch2, __len), size);
}
out->u.attachVal = attachp;
break;
}
}
ARError_add(AR_RETURN_ERROR, AP_ERR_ATTACH,
"Non hash-reference passed as attachment value.");
return -1;
break;
#endif
case AR_DATA_TYPE_COORDS:
if (SvTYPE(array = (AV *) SvRV(in)) == SVt_PVAV) {
len = av_len(array) + 1;
out->u.coordListVal = MALLOCNN(sizeof(ARCoordList));
out->u.coordListVal->numItems = len;
out->u.coordListVal->coords = MALLOCNN(sizeof(ARCoordStruct) * len);
for (i = 0; i < len; i++) {
fetch = av_fetch(array, i, 0);
if (fetch && SvTYPE(array2 = (AV *) SvRV(*fetch)) == SVt_PVAV &&
av_len(array2) == 1) {
fetch2 = av_fetch(array2, 0, 0);
if (!*fetch2)
goto fetch_puke;
out->u.coordListVal->coords[i].x = SvIV(*fetch);
fetch2 = av_fetch(array2, 1, 0);
if (!*fetch2)
goto fetch_puke;
out->u.coordListVal->coords[i].y = SvIV(*fetch);
} else {
fetch_puke: ;
AP_FREE(out->u.coordListVal->coords);
AP_FREE(out->u.coordListVal);
ARError_add(AR_RETURN_ERROR, AP_ERR_COORD_STRUCT);
return -1;
}
}
return 0;
}
ARError_add(AR_RETURN_ERROR, AP_ERR_COORD_LIST);
return -1;
#endif
default:
ARError_add(AR_RETURN_ERROR, AP_ERR_FIELD_TYPE);
return -1;
}
}
return 0;
}
#if AR_EXPORT_VERSION >= 7L
int
sv_to_ARCurrencyStruct(ARControlStruct *ctrl, SV *in, ARCurrencyStruct *out)
{
SV **fetch, *val, *type, *val2, *fl;
AV *afl;
HV *hash;
unsigned int i;
if (SvROK(in)) {
if (SvTYPE (hash = (HV *)SvRV(in)) == SVt_PVHV) {
fetch = hv_fetch(hash, "value", strlen("value"), FALSE);
if (!fetch) {
ARError_add(AR_RETURN_ERROR, AP_ERR_CURRENCY_STRUCT);
return -1;
}
val = *fetch;
if(!(SvOK(val) && SvTYPE(val) < SVt_PVAV)) {
ARError_add(AR_RETURN_ERROR, AP_ERR_CURRENCY_STRUCT);
return -1;
}
fetch = hv_fetch(hash, "currencyCode",
strlen("currencyCode"), FALSE);
if (!fetch) {
ARError_add(AR_RETURN_ERROR, AP_ERR_CURRENCY_STRUCT);
return -1;
}
type = *fetch;
if(!(SvOK(type) && SvTYPE(type) == SVt_PV)) {
ARError_add(AR_RETURN_ERROR, AP_ERR_CURRENCY_STRUCT);
return -1;
}
fetch = hv_fetch(hash, "conversionDate",
strlen("conversionDate"), FALSE);
if (!fetch) {
ARError_add(AR_RETURN_ERROR, AP_ERR_CURRENCY_STRUCT);
return -1;
}
val2 = *fetch;
if( !(SvOK(val2)) ){
ARError_add(AR_RETURN_ERROR, AP_ERR_CURRENCY_STRUCT);
return -1;
}
fetch = hv_fetch(hash, "funcList",
strlen("funcList"), FALSE);
if (!fetch) {
case AR_BULK_ENTRY_MERGE:
{
HV *hash;
hash = newHV();
{
SV *val;
val = perl_AREntryReturn( ctrl, &(p->u.mergeEntryReturn) );
ret = val;
}
hv_store( hash, "mergeEntryReturn", 16, ret, 0 );
ret = newRV_noinc((SV *) hash);
}
break;
case AR_BULK_ENTRY_XMLDELETE:
{
HV *hash;
hash = newHV();
{
SV *val;
val = perl_ARStatusList( ctrl, &(p->u.xmlDeleteEntryReturn) );
ret = val;
}
hv_store( hash, "xmlDeleteEntryReturn", 20, ret, 0 );
ret = newRV_noinc((SV *) hash);
}
break;
case AR_BULK_ENTRY_DELETE:
{
HV *hash;
hash = newHV();
{
SV *val;
val = perl_ARStatusList( ctrl, &(p->u.deleteEntryReturn) );
ret = val;
}
hv_store( hash, "deleteEntryReturn", 17, ret, 0 );
ret = newRV_noinc((SV *) hash);
}
break;
case AR_BULK_ENTRY_CREATE:
{
HV *hash;
hash = newHV();
{
SV *val;
val = perl_AREntryReturn( ctrl, &(p->u.createEntryReturn) );
ret = val;
}
hv_store( hash, "createEntryReturn", 17, ret, 0 );
ret = newRV_noinc((SV *) hash);
}
break;
default:
ARError_add( AR_RETURN_ERROR, AP_ERR_GENERAL, ": Invalid case" );
ret = &PL_sv_undef;
break;
}
// ret = val;
}
return ret;
}
SV *
perl_AREntryReturn( ARControlStruct *ctrl, AREntryReturn *p ){
SV *ret;
{
HV *hash;
hash = newHV();
{
SV *val;
val = newSVpv( p->entryId, 0 );
ret = val;
}
hv_store( hash, "entryId", 7, ret, 0 );
{
SV *val;
val = perl_ARStatusList( ctrl, &(p->status) );
ret = val;
}
hv_store( hash, "status", 6, ret, 0 );
ret = newRV_noinc((SV *) hash);
}
return ret;
}
SV *
perl_ARXMLEntryReturn( ARControlStruct *ctrl, ARXMLEntryReturn *p ){
SV *ret;
{
HV *hash;
hash = newHV();
{
SV *val;
val = perl_ARStatusList( ctrl, &(p->status) );
ret = val;
}
hv_store( hash, "status", 6, ret, 0 );
{
SV *val;
val = newSVpv( p->outputDoc, 0 );
ret = val;
}
hv_store( hash, "outputDoc", 9, ret, 0 );
ret = newRV_noinc((SV *) hash);
}
return ret;
AV *array;
SV *val;
unsigned int i;
array = newAV();
av_extend( array, p->numItems-1 );
for( i = 0; i < p->numItems; ++i ){
val = perl_ARStatusStruct( ctrl, &(p->statusList[i]) );
av_store( array, i, val );
}
ret = newRV_noinc((SV *) array);
}
return ret;
}
#endif
SV *
perl_ARCharMenuList( ARControlStruct *ctrl, ARCharMenuList *p ){
SV *ret;
{
AV *array;
SV *val;
U32 i;
array = newAV();
av_extend( array, p->numItems-1 );
for( i = 0; i < p->numItems; ++i ){
val = perl_ARCharMenuItemStruct( ctrl, &(p->charMenuList[i]) );
av_store( array, i, val );
}
ret = newRV_noinc((SV *) array);
}
return ret;
}
SV *
perl_ARCharMenuItemStruct( ARControlStruct *ctrl, ARCharMenuItemStruct *p ){
SV *ret;
HV *hash;
hash = newHV();
hv_store( hash, "menuLabel", 9, newSVpv(p->menuLabel,0), 0 );
switch( p->menuType ){
case AR_MENU_TYPE_VALUE:
hv_store( hash, "menuValue", 9, newSVpv(p->u.menuValue,0), 0 );
break;
case AR_MENU_TYPE_MENU:
hv_store( hash, "childMenu", 9, perl_ARCharMenuStruct(ctrl, p->u.childMenu), 0 );
break;
default:
ARError_add( AR_RETURN_ERROR, AP_ERR_GENERAL, ": Invalid case" );
break;
}
ret = newRV_noinc((SV *) hash);
return ret;
}
SV *
perl_ARCharMenuStruct( ARControlStruct *ctrl, ARCharMenuStruct *p ){
SV *ret;
{
switch( p->menuType ){
case AR_CHAR_MENU_LIST:
{
SV *val;
val = perl_ARCharMenuList( ctrl, &(p->u.menuList) );
ret = val;
}
break;
case AR_CHAR_MENU_SQL:
case AR_CHAR_MENU_SS:
case AR_CHAR_MENU_FILE:
case AR_CHAR_MENU_DATA_DICTIONARY:
case AR_CHAR_MENU_QUERY:
ARError_add( AR_RETURN_ERROR, AP_ERR_GENERAL, ": Unsupported case" );
ret = &PL_sv_undef;
break;
default:
ARError_add( AR_RETURN_ERROR, AP_ERR_GENERAL, ": Invalid case" );
ret = &PL_sv_undef;
break;
}
}
return ret;
}
#if AR_CURRENT_API_VERSION >= 13
SV *
perl_ARActiveLinkSvcActionStruct( ARControlStruct *ctrl, ARActiveLinkSvcActionStruct *p ){
SV *ret;
{
HV *hash;
hash = newHV();
{
SV *val;
val = newSVpv( p->sampleSchema, 0 );
ret = val;
}
hv_store( hash, "sampleSchema", 12, ret, 0 );
{
SV *val;
/* val = perl_ARFieldAssignList( ctrl, &(p->inputFieldMapping) ); */
val = perl_ARList(ctrl,
(ARList *)& p->inputFieldMapping,
(ARS_fn) perl_ARFieldAssignStruct,
sizeof(ARFieldAssignStruct));
ret = val;
}
hv_store( hash, "inputFieldMapping", 17, ret, 0 );
{
SV *val;
val = newSVpv( p->sampleServer, 0 );
ret = val;
}
hv_store( hash, "sampleServer", 12, ret, 0 );
{
SV *val;
val = newSViv( p->requestIdMap );
ret = val;
}
hv_store( hash, "requestIdMap", 12, ret, 0 );
{
SV *val;
val = newSVpv( p->serviceSchema, 0 );
ret = val;
}
hv_store( hash, "serviceSchema", 13, ret, 0 );
{
SV *val;
/* val = perl_ARFieldAssignList( ctrl, &(p->outputFieldMapping) ); */
( run in 0.559 second using v1.01-cache-2.11-cpan-39bf76dae61 )