ARSperl
view release on metacpan or search on metacpan
for (i = 0; i < in->numItems; i++)
av_push(array, (*fn) (ctrl, (char *) in->array + (i * size)));
return newRV_noinc((SV *) array);
}
SV *
perl_diary(ARControlStruct * ctrl, ARDiaryStruct * in)
{
HV *hash = newHV();
hv_store(hash, "user", strlen("user") , newSVpv(in->user, 0), 0);
hv_store(hash, "timestamp", strlen("timestamp") , newSViv(in->timeVal), 0);
hv_store(hash, "value", strlen("value") , newSVpv(in->value, 0), 0);
return newRV_noinc((SV *) hash);
}
SV *
perl_dataType_names(ARControlStruct * ctrl, unsigned int *in)
{
int i = 0;
while ((DataTypeMap[i].number != *in) && (DataTypeMap[i].number != TYPEMAP_LAST))
i++;
if (DataTypeMap[i].number != TYPEMAP_LAST)
return newSVpv( DataTypeMap[i].name, strlen(DataTypeMap[i].name) );
return newSVpv( "NULL", strlen("NULL") );
}
/* this one is for decoding assign (set) field actions in active links
* and/or filters.
*/
SV *
perl_ARValueStructType_Assign(ARControlStruct * ctrl, ARValueStruct * in)
{
return perl_dataType_names(ctrl, &(in->dataType));
}
SV *
perl_ARValueStructType(ARControlStruct * ctrl, ARValueStruct * in)
{
return perl_dataType_names(ctrl, &(in->dataType));
}
/* this one is for decoding assign (set) field actions in active links
* and/or filters.
*/
SV *
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);
newSVpv("false", 0), 0);
return newRV_noinc((SV *)hash);
}
SV *
perl_ARCloseWndStruct(ARControlStruct * ctrl, ARCloseWndStruct * in)
{
HV *hash = newHV();
#if AR_EXPORT_VERSION >= 6L
if(in->closeAll)
hv_store(hash, "closeAll", strlen("closeAll") ,
newSVpv("true", 0), 0);
else
hv_store(hash, "closeAll", strlen("closeAll") ,
newSVpv("false", 0), 0);
#else
hv_store(hash, "schemaName", strlen("schemaName") ,
newSVpv(in->schemaName, 0), 0);
#endif
return newRV_noinc((SV *)hash);
}
SV *
perl_ARGotoActionStruct(ARControlStruct * ctrl, ARGotoActionStruct * in)
{
HV *hash = newHV();
hv_store(hash, "tag", strlen("tag") , newSViv(in->tag), 0);
hv_store(hash, "fieldIdOrValue", strlen("fieldIdOrValue"),
newSViv(in->fieldIdOrValue), 0);
return newRV_noinc((SV *)hash);
}
SV *
perl_ARCommitChangesStruct(ARControlStruct * ctrl, ARCommitChangesStruct * in)
{
HV *hash = newHV();
hv_store(hash, "schemaName", strlen("schemaName"),
perl_ARNameType(ctrl, &(in->schemaName)), 0);
return newRV_noinc((SV *)hash);
}
SV *
perl_ARWaitStruct(ARControlStruct * ctrl, ARWaitStruct * in)
{
HV *hash = newHV();
hv_store(hash, "continueButtonTitle", strlen("continueButtonTitle"),
newSVpv(in->continueButtonTitle, 0), 0);
return newRV_noinc((SV *)hash);
}
SV *
perl_ARReferenceStruct(ARControlStruct * ctrl, ARReferenceStruct * in)
{
HV *hash = newHV();
hv_store(hash, "label", strlen("label") ,
newSVpv(in->label, 0), 0);
hv_store(hash, "description", strlen("description") ,
newSVpv(in->description, 0), 0);
hv_store(hash, "type", strlen("type") , newSViv(in->type), 0);
hv_store(hash, "dataType", strlen("dataType") , newSViv(in->reference.dataType), 0);
if (in->reference.dataType == ARREF_DATA_ARSREF)
hv_store(hash, "name", strlen("name") ,
perl_ARNameType(ctrl, &(in->reference.u.name)), 0);
else {
hv_store(hash, "permittedGroups", strlen("permittedGroups") ,
perl_ARList(ctrl,
(ARList *) &(in->reference.u.extRef.permittedGroups),
(ARS_fn) perl_ARInternalId,
sizeof(ARInternalId)), 0);
hv_store(hash, "value", strlen("value") ,
perl_ARValueStruct(ctrl, &(in->reference.u.extRef.value)), 0);
hv_store(hash, "value_dataType", strlen("value_dataType"),
newSVpv(lookUpTypeName((TypeMapStruct *)DataTypeMap,
in->reference.u.extRef.value.dataType), 0), 0);
/* newSViv(in->reference.u.extRef.value.dataType), 0); */
}
return newRV_noinc((SV *)hash);
}
SV *
perl_ARReferenceList(ARControlStruct * ctrl, ARReferenceList * in)
{
AV *array = newAV();
unsigned int i;
for(i = 0 ; i < in->numItems ; i++)
av_push(array,
perl_ARReferenceStruct(ctrl, &(in->referenceList[i]) ));
return newRV_noinc((SV *)array);
}
#endif
SV *
perl_ARAssignFieldStruct(ARControlStruct * ctrl, ARAssignFieldStruct * in)
{
HV *hash = newHV();
int i;
ARQualifierStruct *qual;
SV *ref;
hv_store(hash, "server", strlen("server") , newSVpv(in->server, 0), 0);
hv_store(hash, "schema", strlen("schema") , newSVpv(in->schema, 0), 0);
hv_store(hash, "tag", strlen("tag") , newSViv(in->tag), 0);
#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 "" */
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:
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") );
#if AR_EXPORT_VERSION >= 6L
hv_store(hash, "maskLimits", strlen("maskLimits") ,
perl_AREnumLimitsStruct(ctrl,
&(in->u.enumLimits))
,0
);
#else
hv_store(hash, "maskLimits", strlen("maskLimits") ,
perl_ARList(ctrl, (ARList *) & (in->u.enumLimits),
(ARS_fn) perl_ARNameType,
sizeof(ARNameType)),
0);
#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);
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);
return newRV_noinc((SV *) hash);
}
#endif
#if AR_CURRENT_API_VERSION >= 14
SV *
perl_ARImageDataStruct(ARControlStruct * ctrl, ARImageDataStruct * in)
{
SV *byte_list;
if( in->numItems == 0 ){
return newSVsv(&PL_sv_undef);
}
byte_list = newSVpv((char *) in->bytes, in->numItems);
return byte_list;
}
#endif
SV *
perl_ARByteList(ARControlStruct * ctrl, ARByteList * in)
{
HV *hash;
SV *byte_list;
int i;
if( in->numItems == 0 ){
return newSVsv(&PL_sv_undef);
}
hash = newHV();
byte_list = newSVpv((char *) in->bytes, in->numItems);
for (i = 0; ByteListTypeMap[i].number != TYPEMAP_LAST; i++) {
if (ByteListTypeMap[i].number == in->type)
break;
}
hv_store(hash, "type", strlen("type") , newSVpv( ByteListTypeMap[i].name, strlen(ByteListTypeMap[i].name) ), 0);
hv_store(hash, "value", strlen("value") , byte_list, 0);
return newRV_noinc((SV *) hash);
}
SV *
perl_ARCoordStruct(ARControlStruct * ctrl, ARCoordStruct * in)
{
HV *hash = newHV();
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);
}
#endif /* ARS 3 */
void
dup_Value(ARControlStruct * ctrl, ARValueStruct * n, ARValueStruct * in)
{
n->dataType = in->dataType;
switch (in->dataType) {
case AR_DATA_TYPE_NULL:
case AR_DATA_TYPE_KEYWORD:
case AR_DATA_TYPE_INTEGER:
case AR_DATA_TYPE_REAL:
case AR_DATA_TYPE_TIME:
case AR_DATA_TYPE_BITMASK:
case AR_DATA_TYPE_ENUM:
case AR_DATA_TYPE_ULONG:
n->u = in->u;
break;
#if AR_EXPORT_VERSION > 6L
case AR_DATA_TYPE_DATE:
n->u = in->u;
break;
case AR_DATA_TYPE_CURRENCY:
n->u.currencyVal = dup_ARCurrencyStruct(ctrl,
in->u.currencyVal);
break;
#endif
case AR_DATA_TYPE_CHAR:
n->u.charVal = strdup(in->u.charVal);
break;
case AR_DATA_TYPE_DECIMAL:
n->u.decimalVal = strdup(in->u.decimalVal);
break;
case AR_DATA_TYPE_DIARY:
n->u.diaryVal = strdup(in->u.diaryVal);
break;
case AR_DATA_TYPE_COORDS:
n->u.coordListVal = dup_ARCoordList(ctrl,
in->u.coordListVal);
break;
case AR_DATA_TYPE_BYTES:
n->u.byteListVal = dup_ARByteList(ctrl,
in->u.byteListVal);
break;
}
}
ARArithOpStruct *
dup_ArithOp(ARControlStruct * ctrl, ARArithOpStruct * in)
{
ARArithOpStruct *n;
if (!in)
return NULL;
n = MALLOCNN(sizeof(ARArithOpStruct));
n->operation = in->operation;
dup_FieldValueOrArith(ctrl, &n->operandLeft, &in->operandLeft);
dup_FieldValueOrArith(ctrl, &n->operandRight, &in->operandRight);
return n;
}
void
dup_ValueList(ARControlStruct * ctrl, ARValueList * n, ARValueList * in)
{
unsigned int i;
n->numItems = in->numItems;
n->valueList = MALLOCNN(sizeof(ARValueStruct) * in->numItems);
for (i = 0; i < in->numItems; i++)
dup_Value(ctrl, &n->valueList[0], &in->valueList[0]);
}
ARQueryValueStruct *
dup_QueryValue(ARControlStruct * ctrl, ARQueryValueStruct * in)
{
ARQueryValueStruct *n;
if (!in)
return NULL;
n = MALLOCNN(sizeof(ARQueryValueStruct));
strcpy(n->schema, in->schema);
strcpy(n->server, in->server);
n->qualifier = dup_qualifier(ctrl, in->qualifier);
n->valueField = in->valueField;
n->multiMatchCode = in->multiMatchCode;
return n;
}
void
dup_FieldValueOrArith(ARControlStruct * ctrl,
ARFieldValueOrArithStruct * n,
ARFieldValueOrArithStruct * in)
{
n->tag = in->tag;
switch (in->tag) {
case AR_FIELD_CURRENT:
case AR_FIELD_TRAN:
case AR_FIELD_DB:
case AR_FIELD:
n->u.fieldId = in->u.fieldId;
for(i = 0 ; i < in->numItems ; i++) {
av_push(array,
perl_AROwnerObj(ctrl, &(in->ownerObjList[i]) ));
}
return newRV_noinc((SV *)array);
}
#endif
SV *
perl_ARFieldValueOrArithStruct(ARControlStruct * ctrl, ARFieldValueOrArithStruct * in)
{
HV *hash = newHV();
switch (in->tag) {
case AR_FIELD:
hv_store(hash, "fieldId", strlen("fieldId") , newSViv(in->u.fieldId), 0);
break;
case AR_VALUE:
hv_store(hash, "value", strlen("value") ,
perl_ARValueStruct(ctrl, &in->u.value), 0);
hv_store(hash, "dataType", strlen("dataType") ,
perl_dataType_names(ctrl, &(in->u.value.dataType)), 0);
break;
case AR_ARITHMETIC:
hv_store(hash, "arith", strlen("arith") ,
perl_ARArithOpStruct(ctrl, in->u.arithOp), 0);
break;
case AR_STAT_HISTORY:
hv_store(hash, "statHistory", strlen("statHistory") ,
perl_ARStatHistoryValue(ctrl, &in->u.statHistory), 0);
break;
case AR_VALUE_SET:
hv_store(hash, "valueSet", strlen("valueSet") ,
perl_ARList(ctrl,
(ARList *) & in->u.valueSet,
(ARS_fn) perl_ARValueStruct,
sizeof(ARValueStruct)), 0);
break;
case AR_FIELD_TRAN:
hv_store(hash, "TR_fieldId", strlen("TR_fieldId") , newSViv(in->u.fieldId), 0);
break;
case AR_FIELD_DB:
hv_store(hash, "DB_fieldId", strlen("DB_fieldId") , newSViv(in->u.fieldId), 0);
break;
case AR_LOCAL_VARIABLE:
hv_store(hash, "variable", strlen("variable") , newSViv(in->u.variable), 0);
break;
case AR_QUERY:
hv_store(hash, "queryValue", strlen("queryValue") ,
perl_ARQueryValueStruct(ctrl, in->u.queryValue), 0);
break;
case AR_FIELD_CURRENT:
hv_store(hash, "queryCurrent", strlen("queryCurrent") ,
newSViv(in->u.fieldId), 0);
break;
}
#if AR_EXPORT_VERSION >= 7L
if( in->tag >= AR_FIELD_OFFSET && in->tag <= AR_FIELD_OFFSET + AR_MAX_STD_DATA_TYPE ){
#else
if( in->tag >= AR_FIELD_OFFSET && in->tag <= AR_FIELD_OFFSET + AR_DATA_TYPE_ATTACH ){
#endif
unsigned int dt = in->tag - AR_FIELD_OFFSET;
hv_store( hash, "fieldId", strlen("fieldId"), newSViv(in->u.fieldId), 0 );
hv_store( hash, "dataType", strlen("dataType"), perl_dataType_names(ctrl,&dt), 0 );
/* hv_store( hash, "dataType", strlen("dataType"), newSViv(in->u.dataType), 0); */
}
return newRV_noinc((SV *) hash);
}
SV *
perl_relOp(ARControlStruct * ctrl, ARRelOpStruct * in)
{
HV *hash = newHV();
char *s = "";
switch (in->operation) {
case AR_REL_OP_EQUAL:
s = "==";
break;
case AR_REL_OP_GREATER:
s = ">";
break;
case AR_REL_OP_GREATER_EQUAL:
s = ">=";
break;
case AR_REL_OP_LESS:
s = "<";
break;
case AR_REL_OP_LESS_EQUAL:
s = "<=";
break;
case AR_REL_OP_NOT_EQUAL:
s = "!=";
break;
case AR_REL_OP_LIKE:
s = "like";
break;
case AR_REL_OP_IN:
s = "in";
break;
}
hv_store(hash, "oper", strlen("oper") , newSVpv(s, 0), 0);
hv_store(hash, "left", strlen("left") ,
perl_ARFieldValueOrArithStruct(ctrl, &in->operandLeft), 0);
hv_store(hash, "right", strlen("right") ,
perl_ARFieldValueOrArithStruct(ctrl, &in->operandRight), 0);
return newRV_noinc((SV *) hash);
}
HV *
perl_qualifier(ARControlStruct * ctrl, ARQualifierStruct * in)
{
HV *hash = newHV();
char *s = "";
if (in && in->operation != AR_COND_OP_NONE) {
switch (in->operation) {
case AR_COND_OP_AND:
s = "and";
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);
if (!schema_fields) {
(void) ARError_add(ARSPERL_TRACEBACK, 1,
"GetFieldCached (part 2) failed to fetch/create schema key");
return NULL;
}
if (!SvROK(*schema_fields) || SvTYPE(SvRV(*schema_fields)) != SVt_PVHV) {
sv_setsv(*schema_fields, newRV_noinc((SV *) (fields = newHV())));
} else {
fields = (HV *) SvRV(*schema_fields);
}
if( load_if_incomplete && ! hv_exists(fields,"0",1) ){
fieldcache_load_schema( ctrl, schema_name, NULL, NULL );
}
return fields;
}
int
fieldcache_store_field_info( HV *fields, ARInternalId fieldId, ARNameType fieldName, unsigned int dataType, char **attrs )
{
int ret = 0;
SV **field;
HV *base;
char field_string[20];
sprintf(field_string, "%i", (int) fieldId);
field = hv_fetch(fields, field_string, strlen(field_string) , TRUE);
if (!field) {
(void) ARError_add(ARSPERL_TRACEBACK, 1,
"GetFieldCached (part 2) failed to fetch/create field key");
return ret;
}
if (!SvROK(*field) || SvTYPE(SvRV(*field)) != SVt_PVHV) {
sv_setsv(*field, newRV_noinc((SV *) (base = newHV())));
} else {
base = (HV *) SvRV(*field);
}
/* store field attributes */
hv_store(base, "name", strlen("name") , newSVpv(fieldName, 0), 0);
hv_store(base, "type", strlen("type") , newSViv(dataType), 0);
return 0;
}
unsigned int
fieldcache_get_data_type( HV *fields, ARInternalId fieldId )
{
int dataType = AR_DATA_TYPE_MAX_TYPE + 100;
SV **field;
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;
case AR_DATA_TYPE_INTEGER:
out->u.intVal = SvIV(in);
break;
case AR_DATA_TYPE_REAL:
out->u.realVal = SvNV(in);
break;
case AR_DATA_TYPE_CHAR:
out->u.charVal = strdup(SvPV(in, PL_na));
/* charData = SvPV( in, slen );
out->u.charVal = MALLOCNN( slen + 1 );
strncpy( out->u.charVal, charData, slen );
out->u.charVal[slen] = '\0'; */
break;
case AR_DATA_TYPE_DIARY:
out->u.diaryVal = strdup(SvPV(in, PL_na));
break;
case AR_DATA_TYPE_ENUM:
out->u.enumVal = SvIV(in);
break;
case AR_DATA_TYPE_TIME:
out->u.timeVal = SvIV(in);
break;
case AR_DATA_TYPE_BITMASK:
out->u.maskVal = SvIV(in);
break;
#if AR_EXPORT_VERSION >= 7L
case AR_DATA_TYPE_DATE:
out->u.dateVal = SvIV(in);
break;
case AR_DATA_TYPE_TIME_OF_DAY:
out->u.timeOfDayVal = SvIV(in);
break;
case AR_DATA_TYPE_CURRENCY:
out->u.currencyVal = MALLOCNN(sizeof(ARCurrencyStruct));
if( sv_to_ARCurrencyStruct(ctrl,in,out->u.currencyVal) == -1 )
return -1;
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)) {
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;
}
locp->locType = AR_LOC_FILENAME;
filename = SvPV(*fetch, filenamelen);
/* if we have an explicitly set name, use it, else use the filename */
if (name) {
STRLEN __len; /* because some perls have "na" and others "PL_na" */
attachp->name = strdup(SvPV(name, __len));
} else {
attachp->name = MALLOCNN(filenamelen + 1);
memcpy(attachp->name, filename, filenamelen);
}
locp->u.filename = MALLOCNN(filenamelen + 1);
memcpy(locp->u.filename, filename, filenamelen);
attachp->origSize = size;
}
/* else we've been given a buffer */
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)) {
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;
}
( run in 1.215 second using v1.01-cache-2.11-cpan-140bd7fdf52 )