static long sv_to_dimension(pTHX_ SV *sv, const char *member)
{
SV *warning;
const char *value = NULL;
assert(sv != NULL);
SvGETMAGIC(sv);
if (SvOK(sv) && !SvROK(sv))
{
if (looks_like_number(sv))
{
return SvIV(sv);
}
value = SvPV_nolen(sv);
}
warning = newSVpvn("", 0);
if (value) sv_catpvf(warning, " ('%s')", value);
if (member) sv_catpvf(warning, " in '%s'", member);
WARN((aTHX_ "Cannot use %s%s as dimension", identify_sv(sv), SvPV_nolen(warning)));
SvREFCNT_dec(warning);
return 0;
}
static amf0_data_t* _amf0_data(SV* sv) {
amf0_data_t* d;
if (NULL == sv || !SvOK(sv)) {
d = (amf0_data_t*)amf0_null_init();
}
else if (SvPOKp(sv)) {
STRLEN len;
char* c = SvPV(sv, len);
d = (amf0_data_t*)amf0_string_init_len(c, len);
}
else if (SvNOKp(sv)) {
d = (amf0_data_t*)amf0_number_init((double)SvNVX(sv));
}
else if (SvIOK_UV(sv)) {
d = (amf0_data_t*)amf0_number_init((double)SvUV(sv));
}
else if (SvIOKp(sv)) {
d = (amf0_data_t*)amf0_number_init((double)SvIV(sv));
}
else if (SvROK(sv)) {
d = _amf0_data_rv(SvRV(sv));
}
else {
Perl_croak(aTHX_ "Data::AMF::XS doesn't support SvTYPE: %d\n", SvTYPE(sv));
}
return d;
}
static int output_headers(request_rec *r, AV *headers)
{
dTHX;
SV *key_sv, *val_sv;
char *key;
r->content_type = NULL;
while (av_len(headers) > -1) {
key_sv = av_shift(headers);
val_sv = av_shift(headers);
if (key_sv == NULL || val_sv == NULL) break;
key = SvPV_nolen(key_sv);
if (strcmp(key, "Content-Type") == 0) {
r->content_type = apr_pstrdup(r->pool, SvPV_nolen(val_sv));
} else if (strcmp(key, "Content-Length") == 0) {
ap_set_content_length(r, SvIV(val_sv));
} else if (strcmp(key, "Status") == 0) {
server_error(r, "headers must not contain a Status");
return HTTP_INTERNAL_SERVER_ERROR;
} else {
apr_table_add(r->headers_out, key, SvPV_nolen(val_sv));
}
SvREFCNT_dec(key_sv);
SvREFCNT_dec(val_sv);
}
return OK;
}
SV* integer__stringify(SV* input_integer)
{
// integer__CHECK(input_integer);
integer__CHECKTRACE(input_integer, "input_integer", "integer__stringify()");
//fprintf(stderr, "in CPPOPS_PERLTYPES integer__stringify(), bottom of subroutine, received input_integer = %d\n", (integer)SvIV(input_integer));
return(newSVpvf("%d", (integer)SvIV(input_integer)));
}
main (int argc, char **argv, char **env)
{
STRLEN n_a;
char *embedding[] = { "", "-e", "0" };
my_perl = perl_alloc();
perl_construct( my_perl );
perl_parse(my_perl, NULL, 3, embedding, NULL);
perl_run(my_perl);
/** Treat $a as an integer **/
perl_eval_pv("$a = 3; $a **= 2", TRUE);
printf("a = %d\n", SvIV(perl_get_sv("a", FALSE)));
/** Treat $a as a float **/
perl_eval_pv("$a = 3.14; $a **= 2", TRUE);
printf("a = %f\n", SvNV(perl_get_sv("a", FALSE)));
/** Treat $a as a string **/
perl_eval_pv("$a = 'rekcaH lreP rehtonA tsuJ'; $a = reverse($a);", TRUE);
printf("a = %s\n", SvPV(perl_get_sv("a", FALSE), n_a));
perl_destruct(my_perl);
perl_free(my_perl);
}
static CORBA_boolean
put_any (GIOPSendBuffer *buf, CORBA_TypeCode tc, SV *sv)
{
AV *av;
SV **tc_sv;
CORBA_TypeCode output_tc;
if (sv == &PL_sv_undef) {
if (PL_dowarn & G_WARN_ON)
warn ("Uninitialized CORBA::Any");
output_tc = porbit_find_typecode ("IDL:omg.org/CORBA/Null:1.0");
ORBit_encode_CORBA_TypeCode (output_tc, buf);
return CORBA_TRUE;
}
if (!SvROK(sv) ||
(SvTYPE(SvRV(sv)) != SVt_PVAV) ||
(av_len((AV *)SvRV(sv)) != 1)) {
warn ("CORBA::Any must be array reference of length 2");
return CORBA_FALSE;
}
av = (AV *)SvRV(sv);
tc_sv = av_fetch(av, 0, 0);
if (!tc_sv || !sv_isa(*tc_sv, "CORBA::TypeCode")) {
warn ("First member of any isn't a CORBA::TypeCode");
return CORBA_FALSE;
}
output_tc = (CORBA_TypeCode)SvIV(SvRV(*tc_sv));
ORBit_encode_CORBA_TypeCode (output_tc, buf);
return porbit_put_sv (buf, output_tc, *av_fetch (av, 1, 0));
}
long SvDefFlagsHash (GtkType type, SV *name) {
long val = 0;
GtkFlagValue * vals;
int i;
vals = gtk_type_flags_get_values(type);
if (!vals) {
warn("Invalid type for flags: %s", gtk_type_name(type));
return SvIV(name);
}
if (SvROK(name) && (SvTYPE(SvRV(name)) == SVt_PVAV)) {
AV * r = (AV*)SvRV(name);
for(i=0;i<=av_len(r);i++)
val |= SvEFValueLookup(vals, SvPV(*av_fetch(r, i, 0), PL_na), type);
} else if (SvROK(name) && (SvTYPE(SvRV(name)) == SVt_PVHV)) {
HV * r = (HV*)SvRV(name);
HE * he;
I32 len;
hv_iterinit(r);
while ((he=hv_iternext(r))) {
val |= SvEFValueLookup(vals, hv_iterkey(he, &len), type);
}
} else
val |= SvEFValueLookup(vals, SvPV(name, PL_na), type);
return val;
}
void perl_mongo_connect(SV *client, mongo_link* link) {
#ifdef MONGO_SSL
if(link->ssl){
ssl_connect(link, client);
link->sender = ssl_send;
link->receiver = ssl_recv;
return;
}
#endif
non_ssl_connect(link);
link->sender = non_ssl_send;
link->receiver = non_ssl_recv;
SV* sasl_flag = perl_mongo_call_method( client, "sasl", 0, 0 );
if ( SvIV(sasl_flag) == 1 ) {
#ifdef MONGO_SASL
sasl_authenticate( client, link );
#else
croak( "MongoDB: sasl => 1 specified, but this driver was not compiled with SASL support\n" );
#endif
}
SvREFCNT_dec(sasl_flag);
}
void dump_value(pTHX_ SV* val, Buffer* buf)
{
if (!val) {
return;
}
if (SvIOK(val)) {
char str[50];
int len = sprintf(str, "%ld", (long) SvIV(val));
buffer_append(buf, str, len);
} else if (SvNOK(val)) {
char str[50];
int len = sprintf(str, "%lf", (double) SvNV(val));
buffer_append(buf, str, len);
} else if (SvPOK(val)) {
STRLEN len;
char* str = SvPV(val, len);
buffer_append(buf, "\"", 1);
buffer_append(buf, str, len);
buffer_append(buf, "\"", 1);
} else if (SvROK(val)) {
SV* rv = SvRV(val);
if (SvTYPE(rv) == SVt_PVAV) {
dump_array(aTHX_ (AV*) rv, buf);
} else if (SvTYPE(rv) == SVt_PVHV) {
dump_hash(aTHX_ (HV*) rv, buf);
}
}
}
void TriangleMesh::ReadFromPerl(SV* vertices, SV* facets)
{
stl.stats.type = inmemory;
// count facets and allocate memory
AV* facets_av = (AV*)SvRV(facets);
stl.stats.number_of_facets = av_len(facets_av)+1;
stl.stats.original_num_facets = stl.stats.number_of_facets;
stl_allocate(&stl);
// read geometry
AV* vertices_av = (AV*)SvRV(vertices);
for (unsigned int i = 0; i < stl.stats.number_of_facets; i++) {
AV* facet_av = (AV*)SvRV(*av_fetch(facets_av, i, 0));
stl_facet facet;
facet.normal.x = 0;
facet.normal.y = 0;
facet.normal.z = 0;
for (unsigned int v = 0; v <= 2; v++) {
AV* vertex_av = (AV*)SvRV(*av_fetch(vertices_av, SvIV(*av_fetch(facet_av, v, 0)), 0));
facet.vertex[v].x = SvNV(*av_fetch(vertex_av, 0, 0));
facet.vertex[v].y = SvNV(*av_fetch(vertex_av, 1, 0));
facet.vertex[v].z = SvNV(*av_fetch(vertex_av, 2, 0));
}
facet.extra[0] = 0;
facet.extra[1] = 0;
stl.facet_start[i] = facet;
}
stl_get_size(&(this->stl));
}
alpm_pkgreason_t
p2c_pkgreason(SV *sv)
{
STRLEN len;
char *rstr;
if(SvIOK(sv)){
switch(SvIV(sv)){
case 0: return ALPM_PKG_REASON_EXPLICIT;
case 1: return ALPM_PKG_REASON_DEPEND;
}
croak("integer reasons must be 0 or 1");
}else if(SvPOK(sv)){
rstr = SvPV(sv, len);
if(strncmp(rstr, "explicit", len) == 0){
return ALPM_PKG_REASON_EXPLICIT;
}else if(strncmp(rstr, "implicit", len) == 0
|| strncmp(rstr, "depend", len) == 0){
return ALPM_PKG_REASON_DEPEND;
}else{
croak("string reasons can only be explicit or implicit/depend");
}
}else{
croak("reasons can only be integers or strings");
}
}
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 ) );
}
SEXP
GetRScalar(SV *val)
{
dTHX;
SEXP ans = NULL_USER_OBJECT;
if(SvIOKp(val)) {
PROTECT(ans = NEW_INTEGER(1));
INTEGER_DATA(ans)[0] = SvIV(val);
UNPROTECT(1);
} else if(SvNOKp(val)) {
PROTECT(ans = NEW_NUMERIC(1));
NUMERIC_DATA(ans)[0] = SvNV(val);
UNPROTECT(1);
} else if(SvPOK(val)) {
PROTECT(ans = NEW_CHARACTER(1));
SET_STRING_ELT(ans, 0, COPY_TO_USER_STRING(SvPV(val, PL_na)));
UNPROTECT(1);
} else if(SvROK(val)) {
fprintf(stderr, "Not handling nested references in conversion from Perl to R at present. Suggestions for semantics welcome!\n");fflush(stderr);
} else if(SvTYPE(val) == SVt_PVMG) {
/*XXX get more info about the type of the magic object.
struct magic *mg = SvMAGIC(val);
*/
PROTECT(ans = createPerlReference(val));
UNPROTECT(1);
} else {
fprintf(stderr, "Cannot deal currently with Perl types %d\n", SvTYPE(val));fflush(stderr);
}
return(ans);
}
inline int sv2int_str(SV *val, int_str *is,
unsigned short *flags, unsigned short strflag) {
char *s;
STRLEN len;
if (!SvOK(val)) {
LM_ERR("AVP:sv2int_str: Invalid value "
"(not a scalar).\n");
return 0;
}
if (SvIOK(val)) { /* numerical name */
is->n = SvIV(val);
*flags = 0;
return 1;
} else if (SvPOK(val)) {
s = SvPV(val, len);
is->s.len = len;
is->s.s = s;
(*flags) |= strflag;
return 1;
} else {
LM_ERR("AVP:sv2int_str: Invalid value "
"(neither string nor integer).\n");
return 0;
}
}
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;
}
static void
dl_generic_private_init(pTHX) /* called by dl_*.xs dl_private_init() */
{
char *perl_dl_nonlazy;
MY_CXT_INIT;
MY_CXT.x_dl_last_error = newSVpvn("", 0);
dl_nonlazy = 0;
#ifdef DL_LOADONCEONLY
dl_loaded_files = NULL;
#endif
#ifdef DEBUGGING
{
SV *sv = get_sv("DynaLoader::dl_debug", 0);
dl_debug = sv ? SvIV(sv) : 0;
}
#endif
if ( (perl_dl_nonlazy = getenv("PERL_DL_NONLAZY")) != NULL )
dl_nonlazy = atoi(perl_dl_nonlazy);
if (dl_nonlazy)
DLDEBUG(1,PerlIO_printf(Perl_debug_log, "DynaLoader bind mode is 'non-lazy'\n"));
#ifdef DL_LOADONCEONLY
if (!dl_loaded_files)
dl_loaded_files = newHV(); /* provide cache for dl_*.xs if needed */
#endif
#ifdef DL_UNLOAD_ALL_AT_EXIT
call_atexit(&dl_unload_all_files, (void*)0);
#endif
}
long SvFlagsHash(SV * name, char * optname, HV * o)
{
int i;
int val=0;
if (!name || !SvOK(name))
return 0;
if (SvRV(name) && (SvTYPE(SvRV(name)) == SVt_PVAV)) {
AV * r = (AV*)SvRV(name);
for(i=0;i<=av_len(r);i++)
val |= SvOptsHash(*av_fetch(r, i, 0), optname, o);
} else if (SvRV(name) && (SvTYPE(SvRV(name)) == SVt_PVHV)) {
HV * r = (HV*)SvRV(name);
HE * h;
hv_iterinit(r);
while((h = hv_iternext(r))) {
I32 len;
char * key = hv_iterkey(h, &len);
SV ** f;
if (*key == '-') {
key++;
len--;
}
f = hv_fetch(o, key, len, 0);
if (f)
val |= SvIV(hv_iterval(o, h));
else
CroakOptsHash(optname, key, o);
}
} else
val |= SvOptsHash(name, optname, o);
return val;
}
gint64 amglue_SvI64(SV *sv)
{
if (SvIOK(sv)) {
if (SvIsUV(sv)) {
return SvUV(sv);
} else {
return SvIV(sv);
}
} else if (SvNOK(sv)) {
double dv = SvNV(sv);
/* preprocessor constants seem to have trouble here, so we convert to gint64 and
* back, and if the result differs, then we have lost something. Note that this will
* also error out on integer truncation .. which is probably OK */
gint64 iv = (gint64)dv;
if (dv != (double)iv) {
croak("Expected a signed 64-bit value or smaller; value '%.0f' out of range", (float)dv);
return 0;
} else {
return iv;
}
} else {
return bigint2int64(sv);
}
}
static void modify_event_perl(PLCBA_t *async,
PLCBA_c_event *cevent,
PLCBA_evaction_t action,
short flags)
{
SV **tmpsv;
tmpsv = av_fetch(cevent->pl_event, PLCBA_EVIDX_FD, 1);
if (SvIOK(*tmpsv)) {
if (SvIV(*tmpsv) != cevent->fd) {
/*file descriptor mismatch!*/
av_delete(cevent->pl_event, PLCBA_EVIDX_DUPFH, G_DISCARD);
}
} else {
sv_setiv(*tmpsv, cevent->fd);
}
plcb_call_sv_with_args_noret(async->cv_evmod,
1,
3,
newRV_inc( (SV*)(cevent->pl_event)),
newSViv(action),
newSViv(flags));
/*set the current flags*/
if (action != PLCBA_EVACTION_SUSPEND && action != PLCBA_EVACTION_RESUME) {
sv_setiv( *(av_fetch(cevent->pl_event, PLCBA_EVIDX_WATCHFLAGS, 1)),
flags);
}
/*set the current state*/
sv_setiv( *(av_fetch(cevent->pl_event, PLCBA_EVIDX_STATEFLAGS, 1)),
cevent->state);
}
static int check_integer_option(pTHX_ const IV *options, int count, SV *sv,
IV *value, const char *name)
{
const IV *opt = options;
int n = count;
if (SvROK(sv))
{
Perl_croak(aTHX_ "%s must be an integer value, not a reference", name);
return 0;
}
*value = SvIV(sv);
while (n--)
if (*value == *opt++)
return 1;
if (name)
{
SV *str = sv_2mortal(newSVpvn("", 0));
for (n = 0; n < count; n++)
sv_catpvf(str, "%" IVdf "%s", *options++,
n < count-2 ? ", " : n == count-2 ? " or " : "");
Perl_croak(aTHX_ "%s must be %s, not %" IVdf, name, SvPV_nolen(str), *value);
}
return 0;
}
void _newiterator(rpmts ts, SV * sv_tagname, SV * sv_tagvalue, int keylen) {
rpmmi mi;
int tag = RPMDBI_PACKAGES;
void * value = NULL;
int i = 0;
dSP;
if (sv_tagname == NULL || !SvOK(sv_tagname)) {
tag = RPMDBI_PACKAGES; /* Assume search into installed packages */
} else {
tag = sv2dbquerytag(sv_tagname);
}
if (sv_tagvalue != NULL && SvOK(sv_tagvalue)) {
switch (tag) {
case RPMDBI_PACKAGES:
i = SvIV(sv_tagvalue);
value = &i;
keylen = sizeof(i);
break;
default:
value = (void *) SvPV_nolen(sv_tagvalue);
break;
}
}
mi = rpmtsInitIterator(ts, tag, value, keylen);
XPUSHs(sv_2mortal(sv_setref_pv(newSVpv("", 0), "RPM::PackageIterator", mi)));
PUTBACK;
return;
}
static GnmFuncHelp *
make_gnm_help (const char *name, int count, SV **SP)
{
GnmFuncHelp *help = NULL;
/* We assume that the description is a Perl array of the form
(key, text, key, text, ...). */
int n = count / 2, m = 0, k, type = GNM_FUNC_HELP_END;
GnmFuncHelp *helptmp = g_new0 (GnmFuncHelp, n + 1);
if (count % 2) POPs, count--;
for (k = n; k-- > 0; ) {
SV *sv = POPs;
if (SvPOK(sv)) {
STRLEN size;
gchar *tmp;
tmp = SvPV(sv, size);
helptmp[k].text = g_strndup (tmp, size);
} else {
helptmp[k].text = NULL;
}
sv = POPs;
if (SvIOK(sv)) type = SvIV(sv);
if (helptmp[k].text &&
type >= GNM_FUNC_HELP_NAME && GNM_FUNC_HELP_ODF) {
helptmp[k].type = type; m++;
} else {
helptmp[k].type = GNM_FUNC_HELP_END;
if (helptmp[k].text)
g_free ((char*)helptmp[k].text);
helptmp[k].text = NULL;
}
}
if (m == 0) {
/* No valid entries. */
g_free (helptmp);
} else {
/* Collect all valid entries in a new array. */
if (n == m) {
help = helptmp;
} else {
int i;
help = g_new (GnmFuncHelp, m+1);
for (i = 0, k = 0; k < n; k++)
if (helptmp[k].type != GNM_FUNC_HELP_END &&
helptmp[k].text)
help[i++] = helptmp[k];
g_free(helptmp);
}
help[m].type = GNM_FUNC_HELP_END;
help[m].text = NULL;
}
if (!help) /* Provide a reasonable default. */
help = default_gnm_help (name);
gnm_perl_loader_free_later (help);
for (n = 0; help[n].type != GNM_FUNC_HELP_END; n++)
gnm_perl_loader_free_later (help[n].text);
return help;
}
void
Surface::from_SV_check(SV* surface_sv)
{
if (!sv_isa(surface_sv, perl_class_name(this)) && !sv_isa(surface_sv, perl_class_name_ref(this)))
CONFESS("Not a valid %s object", perl_class_name(this));
// a XS Surface was supplied
*this = *(Surface *)SvIV((SV*)SvRV( surface_sv ));
}
static int
set_record(struct _std_event *ev_ptr, char *response,struct _firewall_info *fw_info){
if(fw_info){
/* equals to NULL means its a key value firewall
* else a regular expression firewall
*/
if(fw_info->fw_regex == NULL) {
//printf(" key value type log \n");
if(parse_keyvalue(ev_ptr,response,fw_info->un.kv)<0){
//printf("Not able to parse kv_pair\n");
return -1;
}
}else{
#ifdef REGEX
if( regex_event_count++ < MAX_REGEX_EVENTS ){
char logid[50];
//int i_log_id;
struct _log_info *found_log_info=NULL;
//printf(" regex type log $log=%s\n",response);
sv_setpvf(sv , "$log='%s'" , response);
eval_sv(sv , G_SCALAR);
/* Apply fw_info->regex and get log id
* use that log id to get log_info struct from log_info_hash
*/
if(SvIV(eval_pv(fw_info->fw_regex,TRUE))){
strncpy(logid,SvPV(get_sv("logtype" , FALSE) , n_a), sizeof(logid)-1);
//printf(" logtype = -%s-\n" , logid);
//i_log_id=atoi(logid);
HASH_FIND_STR(fw_info->un.log_hash, logid , found_log_info);
if(found_log_info==NULL){
printf(" no log info found for logid %s\n",logid);
return -1;
}
if( parse_regex( ev_ptr, response, found_log_info )<0 ){
printf(" parsing regex error %s\n",logid);
return -1;
}
}else{
printf("fw_regex did not work \n");
}
}else{
regex_event_count=0;
perl_reset();
}
#endif
}
}else{
printf("fw_info for given ip address is blank.%s\n",response);
return -1;
}
return 1;
}
/*
* convert perl HV to job_step_info_t
*/
int
hv_to_job_step_info(HV *hv, job_step_info_t *step_info)
{
SV **svp;
AV *av;
int i, n;
FETCH_FIELD(hv, step_info, array_job_id, uint32_t, TRUE);
FETCH_FIELD(hv, step_info, array_task_id, uint32_t, TRUE);
FETCH_FIELD(hv, step_info, ckpt_dir, charp, FALSE);
FETCH_FIELD(hv, step_info, ckpt_interval, uint16_t, TRUE);
FETCH_FIELD(hv, step_info, gres, charp, FALSE);
FETCH_FIELD(hv, step_info, job_id, uint16_t, TRUE);
FETCH_FIELD(hv, step_info, name, charp, FALSE);
FETCH_FIELD(hv, step_info, network, charp, FALSE);
FETCH_FIELD(hv, step_info, nodes, charp, FALSE);
svp = hv_fetch(hv, "node_inx", 8, FALSE);
if (svp && SvROK(*svp) && SvTYPE(SvRV(*svp)) == SVt_PVAV) {
av = (AV*)SvRV(*svp);
n = av_len(av) + 2; /* for trailing -1 */
step_info->node_inx = xmalloc(n * sizeof(int));
for (i = 0 ; i < n-1; i += 2) {
step_info->node_inx[i] = (int)SvIV(*(av_fetch(av, i ,FALSE)));
step_info->node_inx[i+1] = (int)SvIV(*(av_fetch(av, i+1 ,FALSE)));
}
step_info->node_inx[n-1] = -1;
} else {
/* nothing to do */
}
FETCH_FIELD(hv, step_info, num_cpus, uint32_t, TRUE);
FETCH_FIELD(hv, step_info, num_tasks, uint32_t, TRUE);
FETCH_FIELD(hv, step_info, partition, charp, FALSE);
FETCH_FIELD(hv, step_info, profile, uint32_t, TRUE);
FETCH_FIELD(hv, step_info, resv_ports, charp, FALSE);
FETCH_FIELD(hv, step_info, run_time, time_t, TRUE);
FETCH_FIELD(hv, step_info, start_time, time_t, TRUE);
FETCH_FIELD(hv, step_info, step_id, uint32_t, TRUE);
FETCH_FIELD(hv, step_info, time_limit, uint32_t, TRUE);
FETCH_FIELD(hv, step_info, user_id, uint32_t, TRUE);
FETCH_FIELD(hv, step_info, state, uint16_t, TRUE);
return 0;
}
/* Get a new specfile */
void _newspec(rpmts ts, char * filename, SV * svpassphrase, SV * svrootdir, SV * svcookies, SV * svanyarch, SV * svforce, SV * svverify) {
Spec spec = NULL;
char * passphrase = NULL;
char * rootdir = NULL;
char * cookies = NULL;
int anyarch = 0;
int force = 0;
int verify = 0;
dSP;
if (svpassphrase && SvOK(svpassphrase))
passphrase = SvPV_nolen(svpassphrase);
if (svrootdir && SvOK(svrootdir))
rootdir = SvPV_nolen(svrootdir);
else
rootdir = "/";
if (svcookies && SvOK(svcookies))
cookies = SvPV_nolen(svcookies);
if (svanyarch && SvOK(svanyarch))
anyarch = SvIV(svanyarch);
if (svforce && SvOK(svforce))
force = SvIV(svforce);
if (svverify && SvOK(svverify))
verify = SvIV(svverify);
if (filename) {
if (!parseSpec(ts, filename, rootdir, 0, passphrase, cookies, anyarch, force, verify))
spec = rpmtsSetSpec(ts, NULL);
#ifdef HHACK
} else {
spec = newSpec();
#endif
}
if (spec) {
XPUSHs(sv_2mortal(sv_setref_pv(newSVpv("", 0), "RPM::Spec", (void *)spec)));
} else
XPUSHs(sv_2mortal(&PL_sv_undef));
PUTBACK;
return;
}
/* T_PTRREF */
void *
tm_input_ptrref(pTHX_ SV * const arg)
{
if (SvROK(arg)) {
IV tmp = SvIV((SV*)SvRV(arg));
return INT2PTR(void *, tmp);
}
else
return NULL;
void
Point::from_SV_check(SV* point_sv)
{
if (sv_isobject(point_sv) && (SvTYPE(SvRV(point_sv)) == SVt_PVMG)) {
*this = *(Point*)SvIV((SV*)SvRV( point_sv ));
} else {
this->from_SV(point_sv);
}
}
/* Returns perl value as a scheme one */
VCSI_OBJECT perl_return(VCSI_CONTEXT vc,
SV* val) {
if(SvIOK(val))
return make_long(vc,SvIV(val));
else if(SvNOK(val))
return make_float(vc,SvNV(val));
else
return make_string(vc,SvPV_nolen(val));
}
int
perlExec(void)
{
FUNCTION_LOG_VOID(logLevelDebug);
// Initialize Perl
perlInit();
// Run perl main function
perlEval(perlMain());
// Return result code
int code = (int)SvIV(get_sv("iResult", 0)); // {uncoverable_branch - Perl macro}
bool errorC = (int)SvIV(get_sv("bErrorC", 0)); // {uncoverable_branch - Perl macro}
char *message = SvPV_nolen(get_sv("strMessage", 0)); // {uncoverable_branch - Perl macro}
FUNCTION_LOG_RETURN(INT, perlExecResult(code, errorC, message));
}