ARSperl
view release on metacpan or search on metacpan
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);
a = (AV *) SvRV(*messageText);
t2 = newSVpv(text, strlen(text));
(void) av_push(a, t2);
return ret;
}
/* ROUTINE
* ARError(returnCode, statusList)
*
* DESCRIPTION
* This routine processes the given status list
* and pushes any data it contains into the err_hash.
*
* RETURNS
* 0 -> returnCode indicates no problems
* 1 -> returnCode indicates failure/warning
*/
/* GetListSQL cores for 4.0 in this routine */
int
ARError(int returncode, ARStatusList status)
{
unsigned int item;
int ret = 0;
for (item = 0; item < status.numItems; item++) {
#if AR_EXPORT_VERSION >= 4
char *messageText, *appendedText;
/* printf( "messageType = %d\n", status.statusList[item].messageType );
printf( "messageNum = %d\n", status.statusList[item].messageNum );
printf( "messageText = %s\n", status.statusList[item].messageText );
printf( "appendedText = %s\n", status.statusList[item].appendedText );
printf( "-----\n" ); */
if( status.statusList[item].appendedText != NULL ){
appendedText = status.statusList[item].appendedText;
}else{
appendedText = "-";
}
messageText = (char*) MALLOCNN( strlen(status.statusList[item].messageText) +
strlen(appendedText) + 4 );
sprintf( messageText, "%s (%s)",
status.statusList[item].messageText,
appendedText );
#endif
if (ARError_add(status.statusList[item].messageType,
status.statusList[item].messageNum,
#if AR_EXPORT_VERSION < 4
status.statusList[item].messageText
#else
messageText
#endif
) != 0)
ret = 1;
#if AR_EXPORT_VERSION >= 4
AP_FREE(messageText);
#endif
}
if(status.numItems > 0) {
FreeARStatusList(&status, FALSE);
status.numItems = 0;
}
return ret;
}
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
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_ACTIVE_LINK_ACTION_SQL:
/*ARSQLStruct;*/
hv_store(hash, "sqlCommand", strlen("sqlCommand") ,
perl_ARSQLStruct(ctrl, &(in->u.sqlCommand)), 0);
break;
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;*/
{
SV *val;
val = newSVpv( p->sampleServer, 0 );
ret = val;
}
hv_store( hash, "sampleServer", 12, ret, 0 );
ret = newRV_noinc((SV *) hash);
}
return ret;
}
#endif
SV *
perl_ARFilterActionStruct(ARControlStruct * ctrl, ARFilterActionStruct * in)
{
HV *hash = newHV();
DBG( ("enter\n") );
DBG( ("action %d\n", in->action) );
switch (in->action) {
case AR_FILTER_ACTION_NOTIFY:
hv_store(hash, "notify", strlen("notify") ,
perl_ARFilterActionNotify(ctrl, &in->u.notify), 0);
break;
case AR_FILTER_ACTION_MESSAGE:
#ifdef ARS452
DBG( ("452+ message action\n") );
hv_store(hash, "message", strlen("message") ,
perl_ARFilterStatusStruct(ctrl, &in->u.message), 0);
#else
DBG( ("pre-452 message action\n") );
hv_store(hash, "message", strlen("message") ,
perl_ARStatusStruct(ctrl, &in->u.message), 0);
#endif
break;
case AR_FILTER_ACTION_LOG:
hv_store(hash, "log", strlen("log") , newSVpv(in->u.logFile, 0), 0);
break;
case AR_FILTER_ACTION_FIELDS:
{
ARList *setFields = NULL;
#if AR_EXPORT_VERSION >= 8L
hv_store(hash, "assign_fields", strlen("assign_fields") ,
perl_ARSetFieldsActionStruct(ctrl,&(in->u.setFields)), 0 );
#else
setFields = (ARList *) & in->u.fieldList;
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);
}
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);
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;
p++;
tok++;
}
*(tok) = 0;
return p;
}
/* ROUTINE
* perl_BuildEntryList(eList, entry_id)
*
* DESCRIPTION
* given a scalar entry-id and an empty AREntryIdList buffer,
* this routine will populate the buffer with the appropriate
* data, taking into consideration join schema id's and such.
*
* the calling routine should call FreeAREntryIdList() to
* free up what this routine makes.
*
* RETURNS
* 0 on success
* -1 on failure
*/
int
perl_BuildEntryList(ARControlStruct * ctrl, AREntryIdList * entryList, char *entry_id)
{
if (entry_id && *entry_id) {
/*
* if the entry id contains at least one AR_ENTRY_ID_SEPARATOR, it is probably refering to a
( run in 0.794 second using v1.01-cache-2.11-cpan-39bf76dae61 )