ARSperl
view release on metacpan or search on metacpan
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) {
case AR_DISPLAY_OPT_VISIBLE:
hv_store(hash, "option", strlen("option") , newSVpv("VISIBLE", 0), 0);
break;
case AR_DISPLAY_OPT_HIDDEN:
hv_store(hash, "option", strlen("option") , newSVpv("HIDDEN", 0), 0);
break;
}
hv_store(hash, "x", strlen("x") , newSViv(in->x), 0);
hv_store(hash, "y", strlen("y") , newSViv(in->y), 0);
return newRV_noinc((SV *) hash);
}
SV *
perl_ARMacroParmList(ARControlStruct * ctrl, ARMacroParmList * in)
{
HV *hash = newHV();
unsigned int i;
for (i = 0; i < in->numItems; i++)
hv_store(hash, in->parms[i].name, strlen(in->parms[i].name) , newSVpv(in->parms[i].value, 0), 0);
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
case AR_DATA_TYPE_KEYWORD:
return &PL_sv_undef;
case AR_DATA_TYPE_INTEGER:
hv_store(hash, "min", strlen("min") , newSViv(in->u.intLimits.rangeLow), 0);
hv_store(hash, "max", strlen("max") , newSViv(in->u.intLimits.rangeHigh), 0);
return newRV_noinc((SV *) hash);
case AR_DATA_TYPE_REAL:
hv_store(hash, "min", strlen("min") , newSVnv(in->u.realLimits.rangeLow), 0);
hv_store(hash, "max", strlen("max") , newSVnv(in->u.realLimits.rangeHigh), 0);
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") );
#endif
return newRV_noinc((SV *) hash);
case AR_DATA_TYPE_BYTES:
return &PL_sv_undef;
case AR_DATA_TYPE_DECIMAL:
hv_store(hash, "rangeLow", strlen("rangeLow") , newSVpv(in->u.decimalLimits.rangeLow, 0), 0);
hv_store(hash, "rangeHigh", strlen("rangeHigh") , newSVpv(in->u.decimalLimits.rangeHigh, 0), 0);
hv_store(hash, "precision", strlen("precision") , newSViv(in->u.decimalLimits.precision), 0);
return newRV_noinc((SV *) hash);
case AR_DATA_TYPE_ATTACH:
hv_store(hash, "maxSize", strlen("maxSize") , newSViv(in->u.attachLimits.maxSize), 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);
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;
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
break;
#endif /* 7L */
#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,
( run in 2.233 seconds using v1.01-cache-2.11-cpan-f56aa216473 )