ARSperl
view release on metacpan or search on metacpan
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_store(hash, "inputValues", strlen("inputValues") , perl_ARAssignStruct(ctrl, in->inputValues), 0);
hv_store(hash, "valueIndex", strlen("valueIndex") , newSViv(in->valueIndex), 0);
return newRV_noinc((SV *) hash);
}
#endif
SV *
perl_ARFunctionAssignStruct(ARControlStruct * ctrl, ARFunctionAssignStruct * in)
{
AV *array = newAV();
unsigned int i;
for (i = 0; FunctionMap[i].number != TYPEMAP_LAST; i++)
if (FunctionMap[i].number == in->functionCode)
break;
av_push(array, newSVpv(FunctionMap[i].name, 0));
for (i = 0; i < in->numItems; i++)
av_push(array, perl_ARAssignStruct(ctrl, &in->parameterList[i]));
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
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,
"'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;
( run in 0.726 second using v1.01-cache-2.11-cpan-39bf76dae61 )