int
report_acct_grouping_to_hv(slurmdb_report_acct_grouping_t* rec, HV* hv)
{
AV* my_av;
HV* rh;
slurmdb_report_job_grouping_t* jgr = NULL;
slurmdb_tres_rec_t *tres_rec = NULL;
ListIterator itr = NULL;
STORE_FIELD(hv, rec, acct, charp);
STORE_FIELD(hv, rec, count, uint32_t);
STORE_FIELD(hv, rec, lft, uint32_t);
STORE_FIELD(hv, rec, rgt, uint32_t);
my_av = (AV*)sv_2mortal((SV*)newAV());
if (rec->groups) {
itr = slurm_list_iterator_create(rec->groups);
while ((jgr = slurm_list_next(itr))) {
rh = (HV*)sv_2mortal((SV*)newHV());
if (report_job_grouping_to_hv(jgr, rh) < 0) {
Perl_warn(aTHX_ "Failed to convert a report_job_grouping to a hv");
slurm_list_iterator_destroy(itr);
return -1;
} else {
av_push(my_av, newRV((SV*)rh));
}
}
slurm_list_iterator_destroy(itr);
}
hv_store_sv(hv, "groups", newRV((SV*)my_av));
my_av = (AV*)sv_2mortal((SV*)newAV());
if (rec->tres_list) {
itr = slurm_list_iterator_create(rec->tres_list);
while ((tres_rec = slurm_list_next(itr))) {
rh = (HV*)sv_2mortal((SV*)newHV());
if (tres_rec_to_hv(tres_rec, rh) < 0) {
Perl_warn(aTHX_ "Failed to convert a tres_rec to a hv");
slurm_list_iterator_destroy(itr);
return -1;
} else {
av_push(my_av, newRV((SV*)rh));
}
}
slurm_list_iterator_destroy(itr);
}
hv_store_sv(hv, "tres_list", newRV((SV*)my_av));
return 0;
}
SV*
Application_fonts( Handle self, char * name, char * encoding)
{
int count, i;
AV * glo = newAV();
PFont fmtx = apc_fonts( self, name[0] ? name : nil,
encoding[0] ? encoding : nil, &count);
for ( i = 0; i < count; i++) {
SV * sv = sv_Font2HV( &fmtx[ i]);
HV * profile = ( HV*) SvRV( sv);
if ( fmtx[i]. utf8_flags & FONT_UTF8_NAME) {
SV ** entry = hv_fetch(( HV*) SvRV( sv), "name", 4, 0);
if ( entry && SvOK( *entry))
SvUTF8_on( *entry);
}
if ( fmtx[i]. utf8_flags & FONT_UTF8_FAMILY) {
SV ** entry = hv_fetch(( HV*) SvRV( sv), "family", 6, 0);
if ( name && SvOK( *entry))
SvUTF8_on( *entry);
}
if ( fmtx[i]. utf8_flags & FONT_UTF8_ENCODING) {
SV ** entry = hv_fetch(( HV*) SvRV( sv), "encoding", 8, 0);
if ( name && SvOK( *entry))
SvUTF8_on( *entry);
}
if ( name[0] == 0 && encoding[0] == 0) {
/* Read specially-coded (const char*) encodings[] vector,
stored in fmtx[i].encoding. First pointer is filled with 0s,
except the last byte which is a counter. Such scheme
allows max 31 encodings per entry to be coded with sizeof(char*)==8.
The interface must be re-implemented, but this requires
either change in gencls syntax so arrays can be members of hashes,
or passing of a dynamic-allocated pointer vector here.
*/
char ** enc = (char**) fmtx[i].encoding;
unsigned char * shift = (unsigned char*) enc + sizeof(char *) - 1, j = *shift;
AV * loc = newAV();
pset_sv_noinc( encoding, newSVpv(( j > 0) ? *(++enc) : "", 0));
while ( j--) av_push( loc, newSVpv(*(enc++),0));
pset_sv_noinc( encodings, newRV_noinc(( SV*) loc));
}
pdelete( resolution);
pdelete( codepage);
av_push( glo, sv);
}
free( fmtx);
return newRV_noinc(( SV *) glo);
}
void decode_tuple(pTHX_ unsigned char *input, STRLEN len, struct cc_type *type, SV *output)
{
SV *the_rv;
AV *the_tuple;
struct cc_tuple *tuple;
int i;
STRLEN pos;
the_tuple = newAV();
the_rv = newRV_noinc((SV*)the_tuple);
sv_setsv(output, the_rv);
SvREFCNT_dec(the_rv);
tuple = type->tuple;
assert(tuple);
pos = 0;
for (i = 0; i < tuple->field_count; i++) {
struct cc_type *type = &tuple->fields[i];
SV *decoded = newSV(0);
av_push(the_tuple, decoded);
decode_cell(aTHX_ input, len, &pos, type, decoded);
}
}
void decode_list(pTHX_ unsigned char *input, STRLEN len, struct cc_type *type, SV *output)
{
struct cc_type *inner_type;
int i;
AV *the_list;
SV *the_rv;
STRLEN pos;
inner_type = type->inner_type;
assert(inner_type);
if (UNLIKELY(len < 4))
croak("decode_list: len < 4");
int32_t num_elements = (int32_t)ntohl(*(uint32_t*)(input));
if (UNLIKELY(num_elements < 0))
croak("decode_list: num_elements < 0");
the_list = newAV();
the_rv = newRV_noinc((SV*)the_list);
sv_setsv(output, the_rv);
SvREFCNT_dec(the_rv);
pos = 4;
for (i = 0; i < num_elements; i++) {
SV *decoded = newSV(0);
av_push(the_list, decoded);
decode_cell(aTHX_ input, len, &pos, inner_type, decoded);
}
}
html_valid_status_t
html_valid_tag_attr (AV * av, unsigned int tag_id, unsigned int version)
{
const char * yes_no[n_attributes];
int i;
int j;
int n_attr;
TagAttributes (tag_id, version, yes_no, & n_attr);
if (av_len (av) != -1) {
fprintf (stderr, "%s:%d: unexpected non-empty array with %d elements",
__FILE__, __LINE__, (int) (av_len (av) + 1));
return html_valid_ok;
}
if (n_attr == 0) {
return html_valid_ok;
}
j = 0;
for (i = 0; i < n_attributes; i++) {
if (yes_no[i]) {
SV * attribute;
attribute = newSVpv (yes_no[i], strlen (yes_no[i]));
av_push (av, attribute);
// fprintf (stderr, "Adding %d, %s\n", j, yes_no[i]);
j++;
}
}
if (j != n_attr) {
fprintf (stderr, "%s:%d: inconsistency between expected number of attributes %d and stored number %d\n",
__FILE__, __LINE__, n_attr, j);
}
return html_valid_ok;
}
static void
_parse_wav_peak(ScanData s, Buffer *buf, uint32_t chunk_size, uint8_t big_endian)
{
uint16_t channels = 0;
AV *peaklist = newAV();
SV **entry = my_hv_fetch( info, "channels" );
if ( entry != NULL ) {
channels = SvIV(*entry);
}
// Skip version/timestamp
buffer_consume(buf, 8);
while ( channels-- ) {
HV *peak = newHV();
my_hv_store( peak, "value", newSVnv( big_endian ? buffer_get_float32(buf) : buffer_get_float32_le(buf) ) );
my_hv_store( peak, "position", newSVuv( big_endian ? buffer_get_int(buf) : buffer_get_int_le(buf) ) );
av_push( peaklist, newRV_noinc( (SV *)peak) );
}
my_hv_store( info, "peak", newRV_noinc( (SV *)peaklist ) );
}
static HV *
plperl_spi_execute_fetch_result(SPITupleTable *tuptable, int processed,
int status)
{
HV *result;
result = newHV();
hv_store(result, "status", strlen("status"),
newSVpv((char *) SPI_result_code_string(status), 0), 0);
hv_store(result, "processed", strlen("processed"),
newSViv(processed), 0);
if (status == SPI_OK_SELECT)
{
AV *rows;
SV *row;
int i;
rows = newAV();
for (i = 0; i < processed; i++)
{
row = plperl_hash_from_tuple(tuptable->vals[i], tuptable->tupdesc);
av_push(rows, row);
}
hv_store(result, "rows", strlen("rows"),
newRV_noinc((SV *) rows), 0);
}
SPI_freetuptable(tuptable);
return result;
}
static void perl_vp_to_svpvn_element(REQUEST *request, AV *av, VALUE_PAIR const *vp,
int *i, const char *hash_name, const char *list_name)
{
size_t len;
SV *sv;
char buffer[1024];
switch (vp->da->type) {
case PW_TYPE_STRING:
RDEBUG("$%s{'%s'}[%i] = &%s:%s -> '%s'", hash_name, vp->da->name, *i,
list_name, vp->da->name, vp->vp_strvalue);
sv = newSVpvn(vp->vp_strvalue, vp->vp_length);
break;
default:
len = vp_prints_value(buffer, sizeof(buffer), vp, 0);
RDEBUG("$%s{'%s'}[%i] = &%s:%s -> '%s'", hash_name, vp->da->name, *i,
list_name, vp->da->name, buffer);
sv = newSVpvn(buffer, truncate_len(len, sizeof(buffer)));
break;
}
if (!sv) return;
SvTAINTED_on(sv);
av_push(av, sv);
(*i)++;
}
static SV *
tn_decode_array(char *const encoded, STRLEN length)
{
char *cursor = encoded;
char *end = encoded + length;
char *rest = NULL;
SV *decoded = newRV_noinc((SV *)newAV());
AV *array = (AV *)SvRV(decoded);
SV *elem = NULL;
while(cursor <= end) {
elem = tn_decode(cursor, length, &rest);
if(elem != NULL) {
av_push(array, elem);
} else {
croak("expected array element but got \"%s\"", cursor);
}
if(rest != NULL) {
length = length - (rest - cursor);
cursor = rest;
} else {
break;
}
elem = NULL;
}
return decoded;
}
static void
perl_pref_cb(const char *name, PurplePrefType type, gconstpointer value,
gpointer data)
{
PurplePerlPrefsHandler *handler = data;
dSP;
ENTER;
SAVETMPS;
PUSHMARK(sp);
XPUSHs(sv_2mortal(newSVpv(name, 0)));
XPUSHs(sv_2mortal(newSViv(type)));
switch(type) {
case PURPLE_PREF_INT:
XPUSHs(sv_2mortal(newSViv(GPOINTER_TO_INT(value))));
break;
case PURPLE_PREF_BOOLEAN:
XPUSHs((GPOINTER_TO_INT(value) == FALSE) ? &PL_sv_no : &PL_sv_yes);
break;
case PURPLE_PREF_STRING:
case PURPLE_PREF_PATH:
XPUSHs(sv_2mortal(newSVGChar(value)));
break;
case PURPLE_PREF_STRING_LIST:
case PURPLE_PREF_PATH_LIST:
{
AV* av = newAV();
const GList *l = value;
/* Append stuff backward to preserve order */
while (l && l->next) l = l->next;
while (l) {
av_push(av, sv_2mortal(newSVGChar(l->data)));
l = l->prev;
}
XPUSHs(sv_2mortal(newRV_noinc((SV *) av)));
} break;
default:
case PURPLE_PREF_NONE:
XPUSHs(&PL_sv_undef);
break;
}
XPUSHs((SV *)handler->data);
PUTBACK;
call_sv(handler->callback, G_EVAL | G_VOID | G_DISCARD);
SPAGAIN;
if (SvTRUE(ERRSV)) {
purple_debug_error("perl",
"Perl prefs callback function exited abnormally: %s\n",
SvPVutf8_nolen(ERRSV));
}
PUTBACK;
FREETMPS;
LEAVE;
}
SV *radio_get_fft() {
HV *hash;
uint32_t i;
uint32_t sr, fr;
have_fft = dp_conc_q_peaks_try_pop_all(&_dsp_chain_peaks_queue,&pts);
hash = newHV();
hv_stores(hash,"have_fft",newSViv(have_fft));
if (have_fft) {
___PERL_INSERT_HASH_COPYING_pts
AV *av;
av = newAV();
sr = _main_sample_rate;
fr = _main_freq;
/*
dp_radio2832_dev_cmd(radio,GT_SR,&sr);
dp_radio2832_dev_cmd(radio,GT_FREQ,&fr);
*/
for (i=0;i<pts.actpts;i++) {
HV *h2;
float f;
h2 = newHV();
hv_stores(h2,"index",newSViv(pts.points[i]->bin));
hv_stores(h2,"dB",newSVnv(pts.points[i]->db));
hv_stores(h2,"abs",newSVnv(pts.points[i]->abs));
f = (float)pts.points[i]->bin / (float)pts.length;
f *= (float)sr;
f -= 0.5 * (float)sr;
f += (float)fr;
hv_stores(h2,"f",newSVnv(f));
av_push(av,newRV_noinc((SV *)h2));
}
hv_stores(hash,"points",newRV_noinc((SV *)av));
}
return newRV_noinc((SV *)hash);
}
SV * newSVGdkDeviceInfo(GdkDeviceInfo * v)
{
HV * h;
SV * r;
if (!v)
return newSVsv(&PL_sv_undef);
h = newHV();
r = newRV((SV*)h);
SvREFCNT_dec(h);
hv_store(h, "deviceid", 8, newSViv(v->deviceid), 0);
hv_store(h, "name", 4, newSVpv(v->name, 0), 0);
hv_store(h, "source", 6, newSVGdkInputSource(v->source), 0);
hv_store(h, "mode", 4, newSVGdkInputMode(v->mode), 0);
hv_store(h, "has_cursor", 10, newSViv(v->has_cursor), 0);
hv_store(h, "num_axes", 8, newSViv(v->num_axes), 0);
if (v->axes) {
int i;
AV * a = newAV();
for(i=0;i<v->num_axes;i++) {
av_push(a, newSVGdkAxisUse(v->axes[i]));
}
hv_store(h, "axes", 4, newRV((SV*)a), 0);
SvREFCNT_dec(a);
}
return r;
}
AV *
plu_table_obj_to_values_array(pTHX_ plu_table_t *THIS)
{
PLU_dSTACKASSERT;
int table_stack_offset;
lua_State *L;
SV *sv;
AV *RETVAL;
int dopop;
L = THIS->L;
PLU_ENTER_STACKASSERT(L);
PLU_TABLE_PUSH_TO_STACK(*THIS);
RETVAL = newAV();
sv_2mortal((SV *)RETVAL);
table_stack_offset = lua_gettop(L);
lua_pushnil(L); /* first key */
while (lua_next(L, table_stack_offset) != 0) {
/* uses 'key' (at index -2) and 'value' (at index -1) */
sv = plu_luaval_to_perl(aTHX_ L, -1, &dopop);
av_push(RETVAL, sv);
if (LIKELY( dopop ))
lua_pop(L, 1);
}
lua_pop(L, 1);
PLU_LEAVE_STACKASSERT(L);
return RETVAL;
}
SRL_STATIC_INLINE void
srl_parse_next(pTHX_ srl_path_t *path, int expr_idx, SV *route)
{
srl_iterator_t *iter = path->iter;
assert(route != NULL);
SRL_PATH_TRACE("expr_idx=%d", expr_idx);
if (srl_iterator_eof(aTHX_ iter)) return;
if (expr_idx > av_len(path->expr)) { // scaned entiry expr
SV *res;
print_route(route, "to decode");
res = srl_iterator_decode(aTHX_ iter);
SvREFCNT_inc(res);
av_push(path->results, res); // TODO store route if needed
return;
}
switch (srl_iterator_object_info(aTHX_ iter, NULL)) {
case SRL_ITERATOR_OBJ_IS_HASH:
srl_iterator_step_in(aTHX_ iter, 1);
srl_parse_hash(aTHX_ path, expr_idx, route);
break;
case SRL_ITERATOR_OBJ_IS_ARRAY:
srl_iterator_step_in(aTHX_ iter, 1);
srl_parse_array(aTHX_ path, expr_idx, route);
break;
}
}
void
scan_search_entry_response(const char** src, const char* max, HV *out) {
SV *dn, *key;
STRLEN len;
dn = newSV(0);
hv_stores(out, "dn", dn);
scan_string_utf8(src, max, dn);
scan_sequence(src, max, &len);
if (len != max - *src)
croak("scan_search_entry_response: packet too short");
key = sv_newmortal();
while (*src < max) {
const char *attribute_max;
AV *values;
scan_sequence(src, max, &len);
attribute_max = *src + len;
scan_string_utf8(src, max, key);
values = newAV();
hv_store_ent(out, key, newRV_noinc((SV*)values), 0);
scan_set(src, max, &len);
if (attribute_max != *src + len)
croak("bad packet");
while (*src < attribute_max) {
SV *v = newSV(0);
av_push(values, v);
scan_string_utf8(src, attribute_max, v);
}
}
}
SV * newSVFlagsHash(long value, char * optname, HV * o)
{
SV * target, *result;
int i;
HE * he;
SV * s;
I32 len;
char * key;
if (!pgtk_use_array)
target = (SV*)newHV();
else
target = (SV*)newAV();
hv_iterinit(o);
while((s = hv_iternextsv(o, &key, &len))) {
int val = SvIV(s);
if ((value & val) == val) {
if (!pgtk_use_array)
hv_store((HV*)target, key, len, newSViv(1), 0);
else
av_push((AV*)target, newSVpv(key, len));
value &= ~val;
}
}
result = newRV(target);
SvREFCNT_dec(target);
return result;
}
void VAstEnt::initAVEnt(AV* avp, VAstType type, AV* parentp) {
// $avp = [type, parent, {}]
av_push(avp, newSViv(type));
if (parentp) {
SV* parentsv = newRV((SV*)parentp);
#ifdef SvWEAKREF // Newer perls
// We're making a circular reference, so to garbage collect properly we need to break it
// On older Perl's we'll just leak.
sv_rvweaken(parentsv);
#endif
av_push(avp, parentsv );
} else { // netlist top
av_push(avp, &PL_sv_undef);
}
av_push(avp, newRV_noinc((SV*)newHV()) );
}
int
report_job_grouping_to_hv(slurmdb_report_job_grouping_t* rec, HV* hv)
{
AV* my_av;
HV* rh;
slurmdb_tres_rec_t *tres_rec = NULL;
ListIterator itr = NULL;
/* FIX ME: include the job list here (is is not NULL, as
* previously thought) */
STORE_FIELD(hv, rec, min_size, uint32_t);
STORE_FIELD(hv, rec, max_size, uint32_t);
STORE_FIELD(hv, rec, count, uint32_t);
my_av = (AV*)sv_2mortal((SV*)newAV());
if (rec->tres_list) {
itr = slurm_list_iterator_create(rec->tres_list);
while ((tres_rec = slurm_list_next(itr))) {
rh = (HV*)sv_2mortal((SV*)newHV());
if (tres_rec_to_hv(tres_rec, rh) < 0) {
Perl_warn(aTHX_ "Failed to convert a tres_rec to a hv");
slurm_list_iterator_destroy(itr);
return -1;
} else {
av_push(my_av, newRV((SV*)rh));
}
}
slurm_list_iterator_destroy(itr);
}
hv_store_sv(hv, "tres_list", newRV((SV*)my_av));
return 0;
}
static JSBool
perlarray_push(
JSContext *cx,
JSObject *obj,
uintN argc,
jsval *argv,
jsval *rval
) {
dTHX;
SV *ref = (SV *)JS_GetPrivate(cx, obj);
AV *av = (AV *)SvRV(ref);
IV tmp;
PJS_ARRAY_CHECK
for(tmp = 0; tmp < argc; tmp++) {
SV *sv;
if(!PJS_ReflectJS2Perl(aTHX_ cx, argv[tmp], &sv, 1)) {
JS_ReportError(cx, "Failed to convert argument %d to Perl", tmp);
return JS_FALSE;
}
av_push(av, sv);
}
return JS_TRUE;
}
KHARON_DECL void
list_element(ssp_val *ret, ssp_val *elem)
{
av_push(*ret, *elem);
D(fprintf(stderr, "list_element(%p, %p)\n", *ret, *elem));
}
/* Load a YAML sequence into a Perl array */
SV *
load_sequence(perl_yaml_loader_t *loader)
{
SV *node;
AV *array = newAV();
SV *array_ref = (SV *)newRV_noinc((SV *)array);
char *anchor = (char *)loader->event.data.sequence_start.anchor;
char *tag = (char *)loader->event.data.mapping_start.tag;
if (anchor)
hv_store(loader->anchors, anchor, strlen(anchor), SvREFCNT_inc(array_ref), 0);
while ((node = load_node(loader))) {
av_push(array, node);
}
if (tag && strEQ(tag, TAG_PERL_PREFIX "array"))
tag = NULL;
if (tag) {
char *class;
char *prefix = TAG_PERL_PREFIX "array:";
if (*tag == '!')
prefix = "!";
else if (strlen(tag) <= strlen(prefix) ||
! strnEQ(tag, prefix, strlen(prefix))
) croak(
loader_error_msg(loader, form("bad tag found for array: '%s'", tag))
);
class = tag + strlen(prefix);
sv_bless(array_ref, gv_stashpv(class, TRUE));
}
return array_ref;
}
SV * newSVOptFlags(long value, char * optname, struct opts * o)
{
SV * result;
if (!pgtk_use_array) {
HV * h = newHV();
int i;
result = newRV((SV*)h);
SvREFCNT_dec(h);
for(i=0;o[i].name;i++)
if ((value & o[i].value) == o[i].value) {
hv_store(h, o[i].name, strlen(o[i].name), newSViv(1), 0);
value &= ~o[i].value;
}
} else {
AV * a = newAV();
int i;
result = newRV((SV*)a);
SvREFCNT_dec(a);
for(i=0;o[i].name;i++)
if ((value & o[i].value) == o[i].value) {
av_push(a, newSVpv(o[i].name, 0));
value &= ~o[i].value;
}
}
return result;
}
/* Converts a set of cond's to perl SVs.
* For delete, update (first half), query
*/
AV *conds2perlarray(db_key_t* keys, db_op_t* ops, db_val_t* vals, int n) {
AV *array = newAV();
SV *element = NULL;
int i = 0;
for (i = 0; i < n; i++) {
if (ops) {
if (ops + i)
if (*(ops + i))
element = cond2perlcond(*(keys + i),
*(ops + i), vals + i);
} else {
/* OP_EQ is defined in Kamailio _and_ perl. Includes collide :( */
#ifdef OP_EQ
element = cond2perlcond(*(keys + i), OP_EQ, vals + i);
#else
element = cond2perlcond(*(keys + i), "=", vals + i);
#endif
}
av_push(array, element);
}
return array;
}
AV *
plu_table_obj_to_keys_array(pTHX_ plu_table_t *THIS)
{
PLU_dSTACKASSERT;
int table_stack_offset;
lua_State *L;
SV *sv;
AV *RETVAL;
L = THIS->L;
PLU_ENTER_STACKASSERT(L);
PLU_TABLE_PUSH_TO_STACK(*THIS);
RETVAL = newAV();
sv_2mortal((SV *)RETVAL);
table_stack_offset = lua_gettop(L);
lua_pushnil(L); /* first key */
while (lua_next(L, table_stack_offset) != 0) {
/* uses 'key' (at index -2) and 'value' (at index -1) */
lua_pop(L, 1);
sv = plu_luaval_to_perl_safe(aTHX_ L, -1); /* need safe version to keep key for next iter */
av_push(RETVAL, sv);
}
lua_pop(L, 1);
PLU_LEAVE_STACKASSERT(L);
return RETVAL;
}
static SV* _amf0_sv(amf0_data_t* data) {
SV* sv = NULL;
SV* svh;
SV* sva;
HV* hv;
AV* av;
int i;
amf0_object_t* obj;
const char* key;
amf0_data_t* value;
switch (data->type) {
case AMF0_NUMBER:
sv = newSVnv(((amf0_number_t*)data)->value);
break;
case AMF0_BOOLEAN:
sv = newSViv(((amf0_boolean_t*)data)->value);
break;
case AMF0_STRING:
sv = newSV(0);
sv_setpv(sv, ((amf0_string_t*)data)->value);
break;
case AMF0_OBJECT:
hv = newHV();
obj = (amf0_object_t*)data;
for (i = 0; i < obj->used; ++i) {
key = obj->data[i]->key;
value = obj->data[i]->value;
svh = _amf0_sv(value);
hv_store(hv, key, strlen(key), svh, 0);
}
sv = newRV(sv_2mortal((SV*)hv));
break;
case AMF0_NULL:
case AMF0_UNDEFINED:
sv = newSV(0);
break;
case AMF0_STRICTARRAY:
av = newAV();
for (i = 0; i < ((amf0_strictarray_t*)data)->used; ++i) {
sva = _amf0_sv(((amf0_strictarray_t*)data)->data[i]);
av_push(av, sva);
}
sv = newRV(sv_2mortal((SV *)av));
break;
default:
Perl_croak(aTHX_ "Unsupported datatype: %d\n", data->type);
break;
}
return sv;
}
static SV *
make_palette_sv( ColorMapObject * pal)
{
AV * av = newAV();
SV * sv = newRV_noinc(( SV *) av);
if ( pal) {
int i;
GifColorType * c = pal-> Colors;
for ( i = 0; i < pal-> ColorCount; i++) {
av_push( av, newSViv(( int) c-> Blue));
av_push( av, newSViv(( int) c-> Green));
av_push( av, newSViv(( int) c-> Red));
c++;
}
}
return sv;
}
static void
store_objects_with_vfuncs (AV *objects_with_vfuncs, GIObjectInfo *info)
{
if (g_object_info_get_n_vfuncs (info) <= 0)
return;
av_push (objects_with_vfuncs,
newSVpv (g_base_info_get_name (info), 0));
}
SV *json_to_perl_variable( json_t *json )
{
json_t *tmp_json;
apr_array_header_t *arr;
apr_hash_index_t *idx;
AV *p_array;
HV *hash;
int i;
switch ( json->type ) {
case JSON_STRING:
return newSVpv( json->value.string, 0 );
break;
case JSON_INTEGER:
return newSViv( json->value.integer );
break;
case JSON_NUMBER:
return newSVnv( json->value.number );
break;
case JSON_OBJECT:
hash = newHV();
for ( idx = apr_hash_first( NULL, json->value.object ); idx;
idx = apr_hash_next( idx ) ) {
apr_hash_this( idx, NULL, NULL, (void **) &tmp_json );
(void) hv_store( hash, JSON_NAME( tmp_json ),
strlen( JSON_NAME( tmp_json ) ),
json_to_perl_variable( tmp_json ), 0 );
}
return newRV_noinc( (SV*) hash);
break;
case JSON_ARRAY:
arr = json->value.array;
p_array = newAV();
for ( i = 0; arr && i < arr->nelts; i++ ) {
tmp_json = APR_ARRAY_IDX( arr, i, json_t * );
av_push( p_array, json_to_perl_variable( tmp_json ) );
}
return newRV_noinc( (SV*) p_array);
break;
case JSON_BOOLEAN:
return ( json->value.boolean ) ? &PL_sv_yes : &PL_sv_no;
break;
case JSON_NULL:
return newSV( 0 );
break;
default:
return NULL;
break;
}
}
int IntToArray(PERL_CALL AV *array, int val)
{
if(!array)
return 0;
av_push(array, newSViv(val));
return 1;
}
SV * newSVGdkRectangle(GdkRectangle * rect)
{
AV * a;
SV * r;
if (!rect)
return newSVsv(&PL_sv_undef);
a = newAV();
r = newRV((SV*)a);
SvREFCNT_dec(a);
av_push(a, newSViv(rect->x));
av_push(a, newSViv(rect->y));
av_push(a, newSViv(rect->width));
av_push(a, newSViv(rect->height));
return r;
}
