ARSperl
view release on metacpan or search on metacpan
return m;
}
void *
debug_mallocnn(int s, char *file, char *func, int line)
{
printf("mallocnn(%d) called from %s::%s(), line %d\n", s,
file ? file : "UNKNOWN",
func ? func : "UNKNOWN",
line);
return mallocnn(s);
}
void
debug_free(void *p, char *file, char *func, int line)
{
printf("free(0x%X) called from %s::%s(), line %d\n", (unsigned long) p,
file ? file : "UNKNOWN",
func ? func : "UNKNOWN",
line);
free(p);
}
FILE *tmp__log_file_ptr = NULL;
FILE*
get_logging_file_ptr()
{
SV *file_ptr;
file_ptr = get_sv( "ARS::logging_file_ptr", FALSE );
if( file_ptr != NULL ){
return (FILE*) SvIV(file_ptr);
}else{
return NULL;
}
}
void
set_logging_file_ptr( FILE* ptr )
{
SV *file_ptr;
file_ptr = get_sv( "ARS::logging_file_ptr", TRUE );
sv_setiv( file_ptr, (long)ptr );
}
/* ROUTINE
* ARError_add(type, num, text)
* ARError_reset()
*
* DESCRIPTION
* err_hash is a hash with the following keys:
* {numItems}
* {messageType} (array reference)
* {messageNum} (array reference)
* {messageText} (array reference)
* each of the array refs have exactly {numItems} elements in
* them. one for each error in the list.
*
* _add will add a new error onto the error hash/array and will
* incremement numItems appropriately.
*
* _reset will reset the error hash to 0 elements and clear out
* old entries.
*
* RETURN
* 0 on success
* negative int on failure
*/
int
ARError_reset()
{
SV *ni, *t2, **t1;
AV *t3;
HV *err_hash = (HV *) NULL;
/* lookup hash, create if necessary */
err_hash = perl_get_hv(ERRHASH, TRUE | 0x02);
if (!err_hash)
return -1;
/* if keys already exist, delete them */
if (hv_exists(err_hash, EH_COUNT, strlen(EH_COUNT) ))
t2 = hv_delete(err_hash, EH_COUNT, strlen(EH_COUNT) , 0);
/*
* the following are array refs. if the _delete call returns the ref,
* we should remove all entries from the array and delete it as well.
*/
if (hv_exists(err_hash, EH_TYPE, strlen(EH_TYPE) ))
t2 = hv_delete(err_hash, EH_TYPE, strlen(EH_TYPE) , 0);
if (hv_exists(err_hash, EH_NUM, strlen(EH_NUM) ))
t2 = hv_delete(err_hash, EH_NUM, strlen(EH_NUM) , 0);
if (hv_exists(err_hash, EH_TEXT, strlen(EH_TEXT) ))
t2 = hv_delete(err_hash, EH_TEXT, strlen(EH_TEXT) , 0);
/* create numItems key, set to zero */
ni = newSViv(0);
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;
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"),
&PL_sv_undef, 0);
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) {
case AR_WORKFLOW_CONN_SCHEMA_LIST:
hv_store(hash, "type", strlen("type") ,
newSVpv("WORKFLOW_CONN_SCHEMA_LIST", 0), 0);
hv_store(hash, "schemaList", strlen("schemaList") ,
perl_ARList(ctrl,
(ARList *) in->u.schemaList,
(ARS_fn) perl_ARNameList,
sizeof(ARNameList)), 0);
break;
}
return newRV_noinc((SV *) hash);
}
SV *
perl_ARNameList(ARControlStruct * ctrl, ARNameList * in) {
AV *array = newAV();
unsigned int i;
for(i = 0 ; i < in->numItems ; i++) {
av_push(array, newSVpv(in->nameList[i], 0));
}
return newRV_noinc((SV *)array);
}
SV *
perl_AROwnerObj(ARControlStruct * ctrl, ARContainerOwnerObj * in)
{
HV *hash = newHV();
hv_store(hash, "type", strlen("type") ,
newSVpv(lookUpTypeName((TypeMapStruct *)ContainerOwnerMap,
in->type), 0), 0);
hv_store(hash, "ownerName", strlen("ownerName") , perl_ARNameType(ctrl, &(in->ownerName)), 0);
return newRV_noinc((SV *) hash);
}
#endif
#if AR_EXPORT_VERSION >= 6
SV *
perl_AROwnerObjList(ARControlStruct * ctrl, ARContainerOwnerObjList * in) {
AV *array = newAV();
unsigned int i;
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) {
ARError_add(AR_RETURN_ERROR, 80029, "Bad currency struct: missing key 'funcList'");
return -1;
}
fl = *fetch;
if(!(SvOK(fl) && SvTYPE(fl) < SVt_PVAV)) {
ARError_add(AR_RETURN_ERROR, 80029, "Bad currency struct: funcList is not a reference");
return -1;
}
out->value = strdup(SvPV(val, PL_na));
strncpy( out->currencyCode, SvPV(type, PL_na), AR_MAX_CURRENCY_CODE_SIZE );
out->currencyCode[AR_MAX_CURRENCY_CODE_SIZE] = '\0';
out->conversionDate = SvIV(val2);
fl = SvRV( fl );
if(!(SvTYPE(fl) == SVt_PVAV)) {
ARError_add(AR_RETURN_ERROR, 80029, "Bad currency struct: funcList not arrayref");
return -1;
}
afl = (AV*) fl;
out->funcList.numItems = av_len(afl) + 1;
out->funcList.funcCurrencyList = MALLOCNN(out->funcList.numItems * sizeof(ARFuncCurrencyStruct));
for( i = 0; i < out->funcList.numItems; ++i ){
SV **fetch, *val, *type, *h;
HV *hash;
fetch = av_fetch( afl, i, 0 );
if (!fetch) {
ARError_add(AR_RETURN_ERROR, 80029, "Bad currency struct: error fetching funcList item");
return -1;
}
if(!(SvOK(*fetch) && SvTYPE(*fetch) < SVt_PVAV)) {
ARError_add(AR_RETURN_ERROR, 80029, "Bad currency struct: error fetching funcList item");
return -1;
}
h = SvRV(*fetch);
if(!(SvTYPE(h) == SVt_PVHV)) {
ARError_add(AR_RETURN_ERROR, 80029, "Bad currency struct: non-hashref item in funcList");
return -1;
}
hash = (HV*) h;
fetch = hv_fetch(hash, "value", strlen("value"), FALSE);
if (!fetch) {
ARError_add(AR_RETURN_ERROR, 80029, "Bad currency struct: missing key 'value' in funcList item");
return -1;
}
val = *fetch;
if(!(SvOK(val) && SvTYPE(val) < SVt_PVAV)) {
ARError_add(AR_RETURN_ERROR, 80029, "Bad currency struct: 'value' in funcList item has unexpected type");
return -1;
}
fetch = hv_fetch(hash, "currencyCode",
strlen("currencyCode"), FALSE);
if (!fetch) {
ARError_add(AR_RETURN_ERROR, 80029, "Bad currency struct: missing key 'currencyCode' in funcList item");
return -1;
}
type = *fetch;
if(!(SvOK(type) && SvTYPE(type) == SVt_PV)) {
ARError_add(AR_RETURN_ERROR, 80029, "Bad currency struct: 'currencyCode' in funcList item has unexpected type");
return -1;
}
out->funcList.funcCurrencyList[i].value = strdup(SvPV(val, PL_na));
strncpy( out->funcList.funcCurrencyList[i].currencyCode, SvPV(type, PL_na), AR_MAX_CURRENCY_CODE_SIZE );
out->funcList.funcCurrencyList[i].currencyCode[AR_MAX_CURRENCY_CODE_SIZE] = '\0';
}
return 0;
}
}
ARError_add(AR_RETURN_ERROR, AP_ERR_CURRENCY_STRUCT);
return -1;
}
SV*
perl_ARCurrencyDetailList(ARControlStruct * ctrl, ARCurrencyDetailList * in)
{
AV *array = newAV();
unsigned int i;
for (i = 0; i < in->numItems; i++) {
HV *currDetail = newHV();
hv_store(currDetail, "currencyCode", strlen("currencyCode"), newSVpv(in->currencyDetailList[i].currencyCode,0), 0);
hv_store(currDetail, "precision", strlen("precision"), newSViv(in->currencyDetailList[i].precision), 0);
av_push(array, newRV_noinc((SV *) currDetail));
}
return newRV_noinc((SV *) array);
}
( run in 0.434 second using v1.01-cache-2.11-cpan-140bd7fdf52 )