/* * convert partition_info_t to perl HV */ int partition_info_to_hv(partition_info_t *part_info, HV *hv) { if (part_info->allow_alloc_nodes) STORE_FIELD(hv, part_info, allow_alloc_nodes, charp); if (part_info->allow_groups) STORE_FIELD(hv, part_info, allow_groups, charp); if (part_info->alternate) STORE_FIELD(hv, part_info, alternate, charp); if (part_info->cr_type) STORE_FIELD(hv, part_info, cr_type, uint16_t); if (part_info->def_mem_per_cpu) STORE_FIELD(hv, part_info, def_mem_per_cpu, uint32_t); STORE_FIELD(hv, part_info, default_time, uint32_t); if (part_info->deny_accounts) STORE_FIELD(hv, part_info, deny_accounts, charp); if (part_info->deny_qos) STORE_FIELD(hv, part_info, deny_qos, charp); STORE_FIELD(hv, part_info, flags, uint16_t); if (part_info->grace_time) STORE_FIELD(hv, part_info, grace_time, uint32_t); if (part_info->max_cpus_per_node) STORE_FIELD(hv, part_info, max_cpus_per_node, uint32_t); if (part_info->max_mem_per_cpu) STORE_FIELD(hv, part_info, max_mem_per_cpu, uint32_t); STORE_FIELD(hv, part_info, max_nodes, uint32_t); STORE_FIELD(hv, part_info, max_share, uint16_t); STORE_FIELD(hv, part_info, max_time, uint32_t); STORE_FIELD(hv, part_info, min_nodes, uint32_t); if (part_info->name) STORE_FIELD(hv, part_info, name, charp); else { Perl_warn(aTHX_ "partition name missing in partition_info_t"); return -1; } /* no store for int pointers yet */ if (part_info->node_inx) { int j; AV* av = newAV(); for(j = 0; ; j += 2) { if(part_info->node_inx[j] == -1) break; av_store(av, j, newSVuv(part_info->node_inx[j])); av_store(av, j+1, newSVuv(part_info->node_inx[j+1])); } hv_store_sv(hv, "node_inx", newRV_noinc((SV*)av)); } if (part_info->nodes) STORE_FIELD(hv, part_info, nodes, charp); STORE_FIELD(hv, part_info, preempt_mode, uint16_t); STORE_FIELD(hv, part_info, priority, uint16_t); if (part_info->qos_char) STORE_FIELD(hv, part_info, qos_char, charp); STORE_FIELD(hv, part_info, state_up, uint16_t); STORE_FIELD(hv, part_info, total_cpus, uint32_t); STORE_FIELD(hv, part_info, total_nodes, uint32_t); return 0; }
void ffi_pl_complex_float_to_perl(SV *sv, float *ptr) { if(SvOK(sv) && sv_isobject(sv) && sv_derived_from(sv, "Math::Complex")) { /* the complex variable is a Math::Complex object */ set(sv, sv_2mortal(newSVnv(ptr[0])), 0); set(sv, sv_2mortal(newSVnv(ptr[1])), 1); } else if(SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVAV) { /* the compex variable is already an array */ AV *av = (AV*) SvRV(sv); av_store(av, 0, newSVnv(ptr[0])); av_store(av, 1, newSVnv(ptr[1])); } else { /* the complex variable is something else and an array needs to be created */ SV *values[2]; AV *av; values[0] = newSVnv(ptr[0]); values[1] = newSVnv(ptr[1]); av = av_make(2, values); sv_setsv(sv, newRV_noinc((SV*)av)); } }
MAGIC *find_shadow_magic(SV *p6cb, SV *static_class, SV *obj) { SV * const obj_deref = SvRV(obj); MAGIC * mg = mg_find(obj_deref, '~'); if (mg == NULL || ((_perl6_magic*)(mg->mg_ptr))->key != PERL6_EXTENSION_MAGIC_KEY) { /* need to create the shadow object here */ AV * method_args = newAV(); SV * method_args_rv = newRV_noinc((SV *) method_args); av_extend(method_args, 1); SvREFCNT_inc(obj); av_store(method_args, 0, obj); AV * args = newAV(); av_extend(args, 3); SvREFCNT_inc(static_class); av_store(args, 0, static_class); av_store(args, 1, newSVpvs("new_shadow_of_p5_object")); av_store(args, 2, method_args_rv); MAGIC * const p6cb_mg = mg_find(SvRV(p6cb), '~'); _perl6_magic* const p6cb_p6mg = (_perl6_magic*)(p6cb_mg->mg_ptr); SV *err = NULL; SV * const args_rv = newRV_noinc((SV *) args); declare_cbs; cbs->call_p6_method(p6cb_p6mg->index, "invoke", 1, args_rv, &err); SvREFCNT_dec(args_rv); handle_p6_error(err); mg = mg_find(obj_deref, '~'); } return mg; }
static SV* make_views_row(PLCB_t *parent, const lcb_RESPVIEWQUERY *resp) { HV *rowdata = newHV(); SV *docid = sv_from_rowdata(resp->docid, resp->ndocid); /* Key, Value, Doc ID, Geo, Doc */ hv_stores(rowdata, "key", sv_from_rowdata(resp->key, resp->nkey)); hv_stores(rowdata, "value", sv_from_rowdata(resp->value, resp->nvalue)); hv_stores(rowdata, "geometry", sv_from_rowdata(resp->geometry, resp->ngeometry)); hv_stores(rowdata, "id", docid); if (resp->docresp) { const lcb_RESPGET *docresp = resp->docresp; AV *docav = newAV(); hv_stores(rowdata, "__doc__", newRV_noinc((SV*)docav)); av_store(docav, PLCB_RETIDX_KEY, SvREFCNT_inc(docid)); plcb_doc_set_err(parent, docav, resp->rc); if (docresp->rc == LCB_SUCCESS) { SV *docval = plcb_convert_getresp(parent, docav, docresp); av_store(docav, PLCB_RETIDX_VALUE, docval); plcb_doc_set_cas(parent, docav, &docresp->cas); } } return newRV_noinc((SV *)rowdata); }
SV* Line::to_SV_pureperl() const { AV* av = newAV(); av_extend(av, 1); av_store(av, 0, this->a.to_SV_pureperl()); av_store(av, 1, this->b.to_SV_pureperl()); return newRV_noinc((SV*)av); }
SV* Pointf::to_SV_pureperl() const { AV* av = newAV(); av_fill(av, 1); av_store(av, 0, newSVnv(this->x)); av_store(av, 1, newSVnv(this->y)); return newRV_noinc((SV*)av); }
SV* Line::to_AV() { AV* av = newAV(); av_extend(av, 1); av_store(av, 0, perl_to_SV_ref(this->a)); av_store(av, 1, perl_to_SV_ref(this->b)); return newRV_noinc((SV*)av); }
void unpack1D ( SV* arg, void * var, char packtype, int n ) { /* n is the size of array var[] (n=1 for 1 element, etc.) If n=0 take var[] as having the same dimension as array referenced by arg */ int* ivar = NULL; float* fvar = NULL; double* dvar = NULL; short* svar = NULL; unsigned char* uvar = NULL; AV* array; I32 i,m; /* Note in ref to scalar case data is already changed */ if (is_scalar_ref(arg)) /* Do nothing */ return; if (packtype!='f' && packtype!='i' && packtype!= 'd' && packtype!='u' && packtype!='s') Perl_croak(aTHX_ "Programming error: invalid type conversion specified to unpack1D"); m=n; array = coerce1D( arg, m ); /* Get array ref and coerce */ if (m==0) m = av_len( array )+1; if (packtype=='i') /* Cast void array var[] to appropriate type */ ivar = (int *) var; if (packtype=='f') fvar = (float *) var; if (packtype=='d') dvar = (double *) var; if (packtype=='u') uvar = (unsigned char *) var; if (packtype=='s') svar = (short *) var; /* Unpack into the array */ for(i=0; i<m; i++) { if (packtype=='i') av_store( array, i, newSViv( (IV)ivar[i] ) ); if (packtype=='f') av_store( array, i, newSVnv( (double)fvar[i] ) ); if (packtype=='d') av_store( array, i, newSVnv( (double)dvar[i] ) ); if (packtype=='u') av_store( array, i, newSViv( (IV)uvar[i] ) ); if (packtype=='s') av_store( array, i, newSViv( (IV)svar[i] ) ); } return; }
SV* ExPolygon::to_SV_pureperl() const { const unsigned int num_holes = this->holes.size(); AV* av = newAV(); av_extend(av, num_holes); // -1 +1 av_store(av, 0, this->contour.to_SV_pureperl()); for (unsigned int i = 0; i < num_holes; i++) { av_store(av, i+1, this->holes[i].to_SV_pureperl()); } return newRV_noinc((SV*)av); }
static void rowreq_init_common(PLCB_t *parent, AV *req) { SV *selfref; av_fill(req, PLCB_VHIDX_MAX); av_store(req, PLCB_VHIDX_ROWBUF, newRV_noinc((SV *)newAV())); av_store(req, PLCB_VHIDX_RAWROWS, newRV_noinc((SV *)newAV())); av_store(req, PLCB_VHIDX_PARENT, newRV_inc(parent->selfobj)); selfref = newRV_inc((SV*)req); sv_rvweaken(selfref); av_store(req, PLCB_VHIDX_SELFREF, selfref); }
SV* CommandArg_to_sv(const mesos::perl::CommandArg arg) { AV* return_av = newAV(); if (arg.context_ == mesos::perl::context::SCALAR) { av_store(return_av, 0, string_to_sv(arg.scalar_data_)); } else if(arg.context_ == mesos::perl::context::ARRAY) { AV* arg_av = newAV(); std::vector<std::string> data_vec = arg.array_data_; for (int i = 0; i < data_vec.size(); i++) { av_store(arg_av, i, string_to_sv(data_vec.at(i))); } av_store(return_av, 0, newRV_noinc((SV*) arg_av)); } av_store(return_av, 1, string_to_sv(arg.type_)); return newRV_noinc((SV*) return_av); }
SV* Line::to_AV() { AV* av = newAV(); av_extend(av, 1); SV* sv = newSV(0); sv_setref_pv( sv, "Slic3r::Point::Ref", &(this->a) ); av_store(av, 0, sv); sv = newSV(0); sv_setref_pv( sv, "Slic3r::Point::Ref", &(this->b) ); av_store(av, 1, sv); return newRV_noinc((SV*)av); }
SV* Line::to_AV() { AV* av = newAV(); av_extend(av, 1); SV* sv = newSV(0); sv_setref_pv( sv, perl_class_name_ref(&this->a), &(this->a) ); av_store(av, 0, sv); sv = newSV(0); sv_setref_pv( sv, perl_class_name_ref(&this->b), &(this->b) ); av_store(av, 1, sv); return newRV_noinc((SV*)av); }
/* * convert slurm_step_layout_t to perl HV */ int slurm_step_layout_to_hv(slurm_step_layout_t *step_layout, HV *hv) { AV* av, *av2; int i, j; if (step_layout->front_end) STORE_FIELD(hv, step_layout, front_end, charp); STORE_FIELD(hv, step_layout, node_cnt, uint16_t); if (step_layout->node_list) STORE_FIELD(hv, step_layout, node_list, charp); else { Perl_warn(aTHX_ "node_list missing in slurm_step_layout_t"); return -1; } STORE_FIELD(hv, step_layout, plane_size, uint16_t); av = newAV(); for (i = 0; i < step_layout->node_cnt; i ++) av_store_uint16_t(av, i, step_layout->tasks[i]); hv_store_sv(hv, "tasks", newRV_noinc((SV*)av)); STORE_FIELD(hv, step_layout, task_cnt, uint32_t); STORE_FIELD(hv, step_layout, task_dist, uint16_t); av = newAV(); for (i = 0; i < step_layout->node_cnt; i ++) { av2 = newAV(); for (j = 0; j < step_layout->tasks[i]; j ++) av_store_uint32_t(av2, i, step_layout->tids[i][j]); av_store(av, i, newRV_noinc((SV*)av2)); } hv_store_sv(hv, "tids", newRV_noinc((SV*)av)); return 0; }
/* * convert node_info_msg_t to perl HV */ int node_info_msg_to_hv(node_info_msg_t *node_info_msg, HV *hv) { int i; HV *hv_info; AV *av; STORE_FIELD(hv, node_info_msg, last_update, time_t); STORE_FIELD(hv, node_info_msg, node_scaling, uint16_t); /* * node_info_msg->node_array will have node_records with NULL names for * nodes that are hidden. They are put in the array to preserve the * node_index which will match up with a partiton's node_inx[]. Add * empty hashes for nodes that have NULL names -- hidden nodes. */ av = newAV(); for(i = 0; i < node_info_msg->record_count; i ++) { hv_info =newHV(); if (node_info_msg->node_array[i].name && node_info_to_hv(node_info_msg->node_array + i, node_info_msg->node_scaling, hv_info) < 0) { SvREFCNT_dec((SV*)hv_info); SvREFCNT_dec((SV*)av); return -1; } av_store(av, i, newRV_noinc((SV*)hv_info)); } hv_store_sv(hv, "node_array", newRV_noinc((SV*)av)); return 0; }
static JSBool perlarray_set( JSContext *cx, JSObject *obj, jsval id, jsval *vp ) { dTHX; SV *ref = (SV *)JS_GetPrivate(cx, obj); AV *av = (AV *)SvRV(ref); PJS_ARRAY_CHECK if(JSVAL_IS_INT(id)) { IV ix = JSVAL_TO_INT(id); SV *sv; if(!PJS_ReflectJS2Perl(aTHX_ cx, *vp, &sv, 1)) { JS_ReportError(cx, "Failed to convert argument to Perl"); return JS_FALSE; } if(!av_store(av, ix, sv)) { if(SvRMAGICAL(av)) mg_set(sv); sv_free(sv); } } return JS_TRUE; }
static void *create_event(plcba_cbcio *cbcio) { PLCBA_c_event *cevent; PLCBA_t *async; async = (PLCBA_t*)cbcio->v.v0.cookie; Newxz(cevent, 1, PLCBA_c_event); cevent->pl_event = newAV(); cevent->evtype = PLCBA_EVTYPE_IO; av_store(cevent->pl_event, PLCBA_EVIDX_OPAQUE, newSViv(PTR2IV(cevent))); if (async->cevents) { cevent->prev = NULL; cevent->next = async->cevents; async->cevents->prev = cevent; async->cevents = cevent; } else { async->cevents = cevent; cevent->next = NULL; cevent->prev = NULL; } return cevent; }
/* * convert job_step_stat_response_msg_t to perl HV */ int job_step_stat_response_msg_to_hv(job_step_stat_response_msg_t *stat_msg, HV *hv) { int i = 0; ListIterator itr; job_step_stat_t *stat; AV *av; HV *hv_stat; STORE_FIELD(hv, stat_msg, job_id, uint32_t); STORE_FIELD(hv, stat_msg, step_id, uint32_t); av = newAV(); itr = slurm_list_iterator_create(stat_msg->stats_list); while((stat = (job_step_stat_t *)slurm_list_next(itr))) { hv_stat = newHV(); if(job_step_stat_to_hv(stat, hv_stat) < 0) { Perl_warn(aTHX_ "failed to convert job_step_stat_t to hv for job_step_stat_response_msg_t"); SvREFCNT_dec(hv_stat); SvREFCNT_dec(av); return -1; } av_store(av, i++, newRV_noinc((SV*)hv_stat)); } slurm_list_iterator_destroy(itr); hv_store_sv(hv, "stats_list", newRV_noinc((SV*)av)); return 0; }
SV *pop_return_values(PerlInterpreter *my_perl, SV **sp, I32 count, I32 *type) { SV * retval = NULL; I32 i; if (count == 1) { retval = POPs; SvREFCNT_inc(retval); *type = p5_get_type(my_perl, retval); } else { if (count > 1) { retval = (SV *)newAV(); av_extend((AV *)retval, count - 1); } for (i = count - 1; i >= 0; i--) { SV * const next = POPs; SvREFCNT_inc(next); if (av_store((AV *)retval, i, next) == NULL) SvREFCNT_dec(next); /* see perlguts Working with AVs */ } } PUTBACK; return retval; }
AV* coerce1D ( SV* arg, int n ) { /* n is the size of array var[] (n=1 for 1 element, etc.) */ AV* array; I32 i,m; /* In ref to scalar case we can do nothing - we can only hope the caller made the scalar the right size in the first place */ if (is_scalar_ref(arg)) /* Do nothing */ return (AV*)NULL; /* Check what has been passed and create array reference whether it exists or not */ if (SvTYPE(arg)==SVt_PVGV) { array = GvAVn((GV*)arg); /* glob */ }else if (SvROK(arg) && SvTYPE(SvRV(arg))==SVt_PVAV) { array = (AV *) SvRV(arg); /* reference */ }else{ array = newAV(); /* Create */ sv_setsv(arg, newRV((SV*) array)); } m = av_len(array); for (i=m+1; i<n; i++) { av_store( array, i, newSViv( (IV) 0 ) ); } return array; }
void p5_av_store(PerlInterpreter *my_perl, AV *av, I32 key, SV *val) { PERL_SET_CONTEXT(my_perl); SvREFCNT_inc(val); if (av_store(av, key, val) == NULL) SvREFCNT_dec(val); return; }
static JSBool perlarray_unshift( 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 if(argc) { av_unshift(av, argc); 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; } if(!av_store(av, tmp, sv)) { if(SvRMAGICAL(av)) mg_set(sv); sv_free(sv); } } } return JS_TRUE; }
/* * convert job_info_msg_t to perl HV */ int job_info_msg_to_hv(job_info_msg_t *job_info_msg, HV *hv) { int i; HV *hv_info; AV *av; _load_node_info(); STORE_FIELD(hv, job_info_msg, last_update, time_t); /* record_count implied in job_array */ av = newAV(); for(i = 0; i < job_info_msg->record_count; i ++) { hv_info = newHV(); if (job_info_to_hv(job_info_msg->job_array + i, hv_info) < 0) { SvREFCNT_dec(hv_info); SvREFCNT_dec(av); return -1; } av_store(av, i, newRV_noinc((SV*)hv_info)); } hv_store_sv(hv, "job_array", newRV_noinc((SV*)av)); _free_node_info(); return 0; }
/* * convert node_info_msg_t to perl HV */ int node_info_msg_to_hv(node_info_msg_t *node_info_msg, HV *hv) { int i; HV *hv_info; AV *av; STORE_FIELD(hv, node_info_msg, last_update, time_t); STORE_FIELD(hv, node_info_msg, node_scaling, uint16_t); /* record_count implied in node_array */ av = newAV(); for(i = 0; i < node_info_msg->record_count; i ++) { if (!node_info_msg->node_array[i].name) continue; hv_info =newHV(); if (node_info_to_hv(node_info_msg->node_array + i, node_info_msg->node_scaling, hv_info) < 0) { SvREFCNT_dec((SV*)hv_info); SvREFCNT_dec((SV*)av); return -1; } av_store(av, i, newRV_noinc((SV*)hv_info)); } hv_store_sv(hv, "node_array", newRV_noinc((SV*)av)); return 0; }
void p5_av_unshift(PerlInterpreter *my_perl, AV *av, SV *sv) { PERL_SET_CONTEXT(my_perl); av_unshift(av, 1); SvREFCNT_inc(sv); if (av_store(av, 0, sv) == NULL) SvREFCNT_dec(sv); }
static JSBool PerlArray( JSContext *cx, JSObject *obj, uintN argc, jsval *argv, jsval *rval ) { dTHX; AV *av = newAV(); SV *ref = newRV_noinc((SV *)av); uintN arg; JSBool ok = JS_FALSE; SV *sv; /* If the path fails, the object will be finalized */ JS_SetPrivate(cx, obj, (void *)newRV(&PL_sv_undef)); av_extend(av, argc); for(arg = 0; arg < argc; arg++) { if(!PJS_ReflectJS2Perl(aTHX_ cx, argv[arg], &sv, 1) || !av_store(av, arg, sv)) goto fail; } if(SvTRUE(get_sv(NAMESPACE"PerlArray::construct_blessed", 0))) sv_bless(ref, gv_stashpv(PerlArrayPkg,0)); ok = PJS_CreateJSVis(aTHX_ cx, obj, ref) != NULL; fail: sv_free(ref); return ok; }
SV * PLCB__viewhandle_new(PLCB_t *parent, const char *ddoc, const char *view, const char *options, int flags) { AV *req = NULL; SV *blessed; lcb_CMDVIEWQUERY cmd = { 0 }; lcb_VIEWHANDLE vh = NULL; lcb_error_t rc; req = newAV(); rowreq_init_common(parent, req); blessed = newRV_noinc((SV*)req); sv_bless(blessed, parent->view_stash); lcb_view_query_initcmd(&cmd, ddoc, view, options, viewrow_callback); cmd.cmdflags = flags; /* Trust lcb on this */ cmd.handle = &vh; rc = lcb_view_query(parent->instance, req, &cmd); if (rc != LCB_SUCCESS) { SvREFCNT_dec(blessed); die("Couldn't issue view query: (0x%x): %s", rc, lcb_strerror(NULL, rc)); } else { SvREFCNT_inc(req); /* For the callback */ av_store(req, PLCB_VHIDX_VHANDLE, newSVuv(PTR2UV(vh))); } return blessed; }
static void common_callback(lcb_t obj, const lcb_RESPBASE *resp, const char *meta, size_t nmeta, const lcb_RESPHTTP *htresp, int is_n1ql) { AV *req = resp->cookie; SV *req_weakrv = *av_fetch(req, PLCB_VHIDX_SELFREF, 0); SV *rawrows_rv = *av_fetch(req, PLCB_VHIDX_RAWROWS, 0); AV *rawrows = (AV *)SvRV(rawrows_rv); PLCB_t *plobj = parent_from_req(req); plcb_views_waitdone(plobj); if (resp->rflags & LCB_RESP_F_FINAL) { av_store(req, PLCB_VHIDX_VHANDLE, SvREFCNT_inc(&PL_sv_undef)); /* Flush any remaining rows.. */ invoke_row(req, req_weakrv, rawrows_rv); av_store(req, PLCB_VHIDX_ISDONE, SvREFCNT_inc(&PL_sv_yes)); av_store(req, PLCB_VHIDX_RC, newSViv(resp->rc)); av_store(req, PLCB_VHIDX_META, sv_from_rowdata(meta, nmeta)); if (htresp) { av_store(req, PLCB_VHIDX_HTCODE, newSViv(htresp->htstatus)); } invoke_row(req, req_weakrv, NULL); SvREFCNT_dec(req); } else { SV *row; if (is_n1ql) { row = make_n1ql_row((const lcb_RESPN1QL *)resp); } else { row = make_views_row(plobj, (const lcb_RESPVIEWQUERY *)resp); } av_push(rawrows, row); if (av_len(rawrows) >= 1) { invoke_row(req, req_weakrv, rawrows_rv); } } }
SV* MultiPoint::to_SV_pureperl() const { const unsigned int num_points = this->points.size(); AV* av = newAV(); av_extend(av, num_points-1); for (unsigned int i = 0; i < num_points; i++) { av_store(av, i, this->points[i].to_SV_pureperl()); } return newRV_noinc((SV*)av); }
SV* polynode_children_2_perl(const ClipperLib::PolyNode& node) { AV* av = newAV(); const unsigned int len = node.ChildCount(); av_extend(av, len-1); for (int i = 0; i < len; ++i) { av_store(av, i, polynode2perl(*node.Childs[i])); } return (SV*)newRV_noinc((SV*)av); }