ARSperl
view release on metacpan or search on metacpan
return newRV_noinc((SV *) hash);
}
SV *
perl_ARActiveLinkMacroStruct(ARControlStruct * ctrl, ARActiveLinkMacroStruct * in)
{
HV *hash = newHV();
hv_store(hash, "macroParms", strlen("macroParms") ,
perl_ARMacroParmList(ctrl, &in->macroParms), 0);
hv_store(hash, "macroText", strlen("macroText") , newSVpv(in->macroText, 0), 0);
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
hv_store(hash, "fieldp", strlen("fieldp") ,
perl_ARPushFieldsActionStruct(ctrl,&(in->u.pushFields)), 0 );
* 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);
return newRV_noinc((SV *) hash);
}
#endif /* ARS3.x */
#if AR_EXPORT_VERSION >= 6
SV *
perl_ARAssignFilterApiStruct(ARControlStruct * ctrl, ARAssignFilterApiStruct * in)
{
HV *hash = newHV();
hv_store(hash, "serviceName", strlen("serviceName") , newSVpv(in->serviceName, 0), 0);
hv_store(hash, "numItems", strlen("numItems") , newSViv(in->numItems), 0);
{
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;
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)
{
( run in 0.749 second using v1.01-cache-2.11-cpan-600a1bdf6e4 )