Example #1
0
/*
 * returns a pointer to a temp stock item you can use until control returns
 * to perl.
 */
static GtkStockItem *
SvGtkStockItem (SV * sv)
{
	HV * hv;
	SV ** svp;
	GtkStockItem * item;

	if (!gperl_sv_is_hash_ref (sv))
		croak ("malformed stock item; use a reference to a hash as a stock item");

	hv = (HV*) SvRV (sv);

	item = gperl_alloc_temp (sizeof (GtkStockItem));

	svp = hv_fetch (hv, "stock_id", 8, FALSE);
	if (svp) item->stock_id = SvGChar (*svp);

	svp = hv_fetch (hv, "label", 5, FALSE);
	if (svp) item->label = SvGChar (*svp);

	svp = hv_fetch (hv, "modifier", 8, FALSE);
	if (svp) item->modifier = SvGdkModifierType (*svp);

	svp = hv_fetch (hv, "keyval", 6, FALSE);
	if (svp) item->keyval = SvUV (*svp);

	svp = hv_fetch (hv, "translation_domain", 18, FALSE);
	if (svp) item->translation_domain = SvGChar (*svp);

	return item;
}
Example #2
0
static RouteEntry *
route_sv2c(SV *h, RouteEntry *ref)
{
   if (ref && h && SvROK(h)) {
      HV *hv = (HV *)SvRV(h);
      memset(ref, 0, sizeof(RouteEntry));
      if (hv_exists(hv, "route_dst", 9)) {
         SV **r = hv_fetch(hv, "route_dst", 9, 0);
         if (SvOK(*r)) {
            struct addr a;
            if (addr_aton(SvPV(*r, PL_na), &a) == 0) {
               memcpy(&(ref->route_dst), &a, sizeof(struct addr));
            }
         }
      }
      if (hv_exists(hv, "route_gw", 8)) {
         SV **r = hv_fetch(hv, "route_gw", 8, 0);
         if (SvOK(*r)) {
            struct addr a;
            if (addr_aton(SvPV(*r, PL_na), &a) == 0) {
               memcpy(&(ref->route_gw), &a, sizeof(struct addr));
            }
         }
      }
   }
   else {
      ref = NULL;
   }
   return ref;
}
Example #3
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);
}
Example #4
0
/* Deletes name from all the isarev entries listed in isa */
STATIC void
S_mro_clean_isarev(pTHX_ HV * const isa, const char * const name,
                   const STRLEN len, HV * const exceptions, U32 hash,
                   U32 flags)
{
    HE* iter;

    PERL_ARGS_ASSERT_MRO_CLEAN_ISAREV;

    /* Delete our name from our former parents' isarevs. */
    if(HvARRAY(isa) && hv_iterinit(isa)) {
        SV **svp;
        while((iter = hv_iternext(isa))) {
            I32 klen;
            const char * const key = hv_iterkey(iter, &klen);
            if(exceptions && hv_exists(exceptions, key, HeKUTF8(iter) ? -klen : klen))
                continue;
            svp = hv_fetch(PL_isarev, key, HeKUTF8(iter) ? -klen : klen, 0);
            if(svp) {
                HV * const isarev = (HV *)*svp;
                (void)hv_common(isarev, NULL, name, len, flags,
                                G_DISCARD|HV_DELETE, NULL, hash);
                if(!HvARRAY(isarev) || !HvUSEDKEYS(isarev))
                    (void)hv_delete(PL_isarev, key,
                                    HeKUTF8(iter) ? -klen : klen, G_DISCARD);
            }
        }
    }
}
Example #5
0
/*
 * convert perl HV to reserve_info_t
 */
int
hv_to_reserve_info(HV *hv, reserve_info_t *resv_info)
{
	SV **svp;
	AV *av;
	int i, n;

	memset(resv_info, 0, sizeof(reserve_info_t));

	FETCH_FIELD(hv, resv_info, accounts, charp, FALSE);
	FETCH_FIELD(hv, resv_info, end_time, time_t, TRUE);
	FETCH_FIELD(hv, resv_info, features, charp, FALSE);
	FETCH_FIELD(hv, resv_info, flags, uint16_t, TRUE);
	FETCH_FIELD(hv, resv_info, licenses, charp, FALSE);
	FETCH_FIELD(hv, resv_info, name, charp, TRUE);
	FETCH_FIELD(hv, resv_info, node_cnt, uint32_t, TRUE);
	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 */
		resv_info->node_inx = xmalloc(n * sizeof(int));
		for (i = 0 ; i < n-1; i += 2) {
			resv_info->node_inx[i] = (int)SvIV(*(av_fetch(av, i ,FALSE)));
			resv_info->node_inx[i+1] = (int)SvIV(*(av_fetch(av, i+1 ,FALSE)));
		}
		resv_info->node_inx[n-1] = -1;
	} else {
		/* nothing to do */
	}
	FETCH_FIELD(hv, resv_info, node_list, charp, FALSE);
	FETCH_FIELD(hv, resv_info, partition, charp, FALSE);
	FETCH_FIELD(hv, resv_info, start_time, time_t, TRUE);
	FETCH_FIELD(hv, resv_info, users, charp, FALSE);
	return 0;
}
Example #6
0
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;
}
Example #7
0
File: NV.c Project: Macs/NeoStats
nv_item *perl_store_namedvars(nv_list *nv, HV *values) {
	int i, j;
    nv_item *item;
	SV **value;
	i = 0;
	j = 0;
	item = nv_new_item(nv);
	while (nv->format[i].fldname != NULL) {
		if (hv_exists(values, nv->format[i].fldname, strlen(nv->format[i].fldname))) {
			value = hv_fetch(values, nv->format[i].fldname, strlen(nv->format[i].fldname), FALSE);
		} else {
			i++;
			continue;
		}
		switch (nv->format[i].type) {
			case NV_PSTR:
			case NV_STR:
				nv_sf_string(item, nv->format[i].fldname, SvPV_nolen(*value));
				break;
			case NV_INT:
				nv_sf_int(item, nv->format[i].fldname, SvIV(*value));
				break;
			case NV_LONG:
				nv_sf_long(item, nv->format[i].fldname, SvIV(*value));
				break;
			case NV_VOID:
			default:
				printf("Value: Unhandled!\n");
				break;
		}
		i++;
	}
	return item;
}
Example #8
0
/*
 * convert perl HV to slurm_step_launch_params_t
 */
int
hv_to_slurm_step_launch_params(HV *hv, slurm_step_launch_params_t *params)
{
	int i, num_keys;
	STRLEN vlen;
	I32 klen;
	SV **svp;
	HV *environ_hv, *local_fds_hv, *fd_hv;
	AV *argv_av;
	SV *val;
	char *env_key, *env_val;

	slurm_step_launch_params_t_init(params);

	if((svp = hv_fetch(hv, "argv", 4, FALSE))) {
		if(SvROK(*svp) && SvTYPE(SvRV(*svp)) == SVt_PVAV) {
			argv_av = (AV*)SvRV(*svp);
			params->argc = av_len(argv_av) + 1;
			if (params->argc > 0) {
				/* memory of params MUST be free-ed by libslurm-perl */
				Newz(0, params->argv, (int32_t)(params->argc + 1), char*);
				for(i = 0; i < params->argc; i ++) {
					if((svp = av_fetch(argv_av, i, FALSE)))
						*(params->argv + i) = (char*) SvPV_nolen(*svp);
					else {
						Perl_warn(aTHX_ "error fetching `argv' of job descriptor");
						free_slurm_step_launch_params_memory(params);
						return -1;
					}
				}
			}
		} else {
Example #9
0
static CORBA_boolean
put_struct (GIOPSendBuffer *buf, CORBA_TypeCode tc, SV *sv)
{
    HV *hv;
    CORBA_unsigned_long i;
    
    if (!SvROK(sv) || (SvTYPE(SvRV(sv)) != SVt_PVHV)) {
	warn ("Structure must be hash reference");
	return CORBA_FALSE;
    }

    hv = (HV *)SvRV(sv);

    for (i = 0; i<tc->sub_parts; i++) {
	SV **valp = hv_fetch (hv, (char *)tc->subnames[i], strlen(tc->subnames[i]), 0);

	if (!valp && (PL_dowarn & G_WARN_ON))
	    warn ("Uninitialized structure member '%s'", tc->subnames[i]);

	if (!porbit_put_sv (buf, tc->subtypes[i], valp ? *valp : &PL_sv_undef))
	    return CORBA_FALSE;
    }

    return CORBA_TRUE;
}
Example #10
0
SV *modperl_pnotes(pTHX_ HV **pnotes, SV *key, SV *val,
                   request_rec *r, conn_rec *c) {
    SV *retval = (SV *)NULL;

    if (!*pnotes) {
        apr_pool_t *pool = r ? r->pool : c->pool;
        void *cleanup_data;
        *pnotes = newHV();

        cleanup_data = modperl_pnotes_cleanup_data(aTHX_ pnotes, pool);

        apr_pool_cleanup_register(pool, cleanup_data,
                                  modperl_cleanup_pnotes,
                                  apr_pool_cleanup_null);
    }

    if (key) {
        STRLEN len;
        char *k = SvPV(key, len);

        if (val) {
            retval = *hv_store(*pnotes, k, len, SvREFCNT_inc(val), 0);
        }
        else if (hv_exists(*pnotes, k, len)) {
            retval = *hv_fetch(*pnotes, k, len, FALSE);
        }

        return retval ? SvREFCNT_inc(retval) : &PL_sv_undef;
    }
    return newRV_inc((SV *)*pnotes);
}
Example #11
0
GV *
Perl_gv_fetchfile(pTHX_ const char *name)
{
    char smallbuf[256];
    char *tmpbuf;
    STRLEN tmplen;
    GV *gv;

    if (!PL_defstash)
	return Nullgv;

    tmplen = strlen(name) + 2;
    if (tmplen < sizeof smallbuf)
	tmpbuf = smallbuf;
    else
	New(603, tmpbuf, tmplen + 1, char);
    tmpbuf[0] = '_';
    tmpbuf[1] = '<';
    strcpy(tmpbuf + 2, name);
    gv = *(GV**)hv_fetch(PL_defstash, tmpbuf, tmplen, TRUE);
    if (!isGV(gv)) {
	gv_init(gv, PL_defstash, tmpbuf, tmplen, FALSE);
	sv_setpv(GvSV(gv), name);
	if (PERLDB_LINE)
	    hv_magic(GvHVn(gv_AVadd(gv)), Nullgv, 'L');
    }
    if (tmpbuf != smallbuf)
	Safefree(tmpbuf);
    return gv;
}
Example #12
0
static const message* save_modules(pTHX, HV* options) {
	SV** modules_ptr = hv_fetch(options, "modules", 7, FALSE);
	if (modules_ptr && SvROK(*modules_ptr) && SvTYPE(SvRV(*modules_ptr)) == SVt_PVAV)
		return message_store_value(SvRV(*modules_ptr));
	else
		return message_store_value(&PL_sv_undef);
}
Example #13
0
ithread* Perl_ithread_get (pTHX) {
  SV** thread_sv = hv_fetch(PL_modglobal, "threads::self",12,0);
  if(!thread_sv) {
    croak("%s\n","Internal error, couldn't get TLS");
  }
  return INT2PTR(ithread*,SvIV(*thread_sv));
}
Example #14
0
File: gv.c Project: gitpan/ponie
GV *
Perl_gv_fetchmeth_autoload(pTHX_ HV *stash, const char *name, STRLEN len, I32 level)
{
    GV *gv = gv_fetchmeth(stash, name, len, level);

    if (!gv) {
	char autoload[] = "AUTOLOAD";
	STRLEN autolen = sizeof(autoload)-1;
	CV *cv;
	GV **gvp;

	if (!stash)
	    return Nullgv;	/* UNIVERSAL::AUTOLOAD could cause trouble */
	if (len == autolen && strnEQ(name, autoload, autolen))
	    return Nullgv;
	if (!(gv = gv_fetchmeth(stash, autoload, autolen, FALSE)))
	    return Nullgv;
	cv = GvCV(gv);
	if (!(CvROOT(cv) || CvXSUB(cv)))
	    return Nullgv;
	/* Have an autoload */
	if (level < 0)	/* Cannot do without a stub */
	    gv_fetchmeth(stash, name, len, 0);
	gvp = (GV**)hv_fetch(stash, name, len, (level >= 0));
	if (!gvp)
	    return Nullgv;
	return *gvp;
    }
    return gv;
}
Example #15
0
File: job.c Project: IFCA/slurm
/* 
 * convert perl HV to job_info_msg_t
 */
int
hv_to_job_info_msg(HV *hv, job_info_msg_t *job_info_msg)
{
	SV **svp;
	AV *av;
	int i, n;

	memset(job_info_msg, 0, sizeof(job_info_msg_t));

	FETCH_FIELD(hv, job_info_msg, last_update, time_t, TRUE);
	svp = hv_fetch(hv, "job_array", 9, FALSE);
	if (! (svp && SvROK(*svp) && SvTYPE(SvRV(*svp)) == SVt_PVAV)) {
		Perl_warn (aTHX_ "job_array is not an arrary reference in HV for job_info_msg_t");
		return -1;
	}
	av = (AV*)SvRV(*svp);
	n = av_len(av) + 1;
	job_info_msg->record_count = n;

	job_info_msg->job_array = xmalloc(n * sizeof(job_info_t));
	for(i = 0; i < n; i ++) {
		svp = av_fetch(av, i, FALSE);
		if (! (svp && SvROK(*svp) && SvTYPE(SvRV(*svp)) == SVt_PVHV)) {
			Perl_warn (aTHX_ "element %d in job_array is not valid", i);
			return -1;
		}
		if (hv_to_job_info((HV*)SvRV(*svp), &job_info_msg->job_array[i]) < 0) {
			Perl_warn(aTHX_ "failed to convert element %d in job_array", i);
			return -1;
		}
	}
	return 0;
}
Example #16
0
static SV *modperl_hv_request_find(pTHX_ SV *in, char *classname, CV *cv)
{
    static char *r_keys[] = { "r", "_r", NULL };
    HV *hv = (HV *)SvRV(in);
    SV *sv = (SV *)NULL;
    int i;

    for (i=0; r_keys[i]; i++) {
        int klen = i + 1; /* assumes r_keys[] will never change */
        SV **svp;

        if ((svp = hv_fetch(hv, r_keys[i], klen, FALSE)) && (sv = *svp)) {
            if (SvROK(sv) && (SvTYPE(SvRV(sv)) == SVt_PVHV)) {
                /* dig deeper */
                return modperl_hv_request_find(aTHX_ sv, classname, cv);
            }
            break;
        }
    }

    if (!sv) {
        Perl_croak(aTHX_
                   "method `%s' invoked by a `%s' object with no `r' key!",
                   cv ? GvNAME(CvGV(cv)) : "unknown",
                   (SvRV(in) && SvSTASH(SvRV(in)))
                       ? HvNAME(SvSTASH(SvRV(in)))
                       : "unknown");
    }

    return SvROK(sv) ? SvRV(sv) : sv;
}
Example #17
0
int
hv_to_user_cond(HV* hv, slurmdb_user_cond_t* user_cond)
{
    AV*    element_av;
    SV**   svp;
    char*  str = NULL;
    int    i, elements = 0;

    user_cond->admin_level = 0;
    user_cond->with_assocs = 1;
    user_cond->with_coords = 0;
    user_cond->with_deleted = 1;
    user_cond->with_wckeys = 0;

    FETCH_FIELD(hv, user_cond, admin_level,  uint16_t, FALSE);
    FETCH_FIELD(hv, user_cond, with_assocs,  uint16_t, FALSE);
    FETCH_FIELD(hv, user_cond, with_coords,  uint16_t, FALSE);
    FETCH_FIELD(hv, user_cond, with_deleted, uint16_t, FALSE);
    FETCH_FIELD(hv, user_cond, with_wckeys,  uint16_t, FALSE);

    if ( (svp = hv_fetch (hv, "assoc_cond", strlen("assoc_cond"), FALSE)) ) {
	if(SvROK(*svp) && SvTYPE(SvRV(*svp)) == SVt_PVHV) {
	    HV* element_hv = (HV*)SvRV(*svp);
	    hv_to_assoc_cond(element_hv, user_cond->assoc_cond);
	} else {
	    Perl_warn(aTHX_ "assoc_cond val is not an hash value reference");
	    return -1;
	}
    }

    FETCH_LIST_FIELD(hv, user_cond, def_acct_list);
    FETCH_LIST_FIELD(hv, user_cond, def_wckey_list);

    return 0;
}
Example #18
0
/*
 * Return the string value of the id subfield of an ea_catalog_t.
 */
char *
catalog_id_str(ea_catalog_t catalog)
{
	static ea_catalog_t	cat_val = ~0U;
	static HV		*cat_hash = NULL;
	ea_catalog_t		cat;
	ea_catalog_t		id;
	char			key[12];    /* Room for dec(2^32) digits. */
	SV			**svp;

	cat = catalog & EXC_CATALOG_MASK;
	id = catalog & EXD_DATA_MASK;

	/* Fetch the correct id subhash if the catalog has changed. */
	if (cat_val != cat) {
		snprintf(key, sizeof (key), "%d", cat);
		PERL_ASSERT(IdValueHash != NULL);
		svp = hv_fetch(IdValueHash, key, strlen(key), FALSE);
		if (svp == NULL) {
			cat_val = ~0U;
			cat_hash = NULL;
		} else {
			HV *hv;

			cat_val = cat;
			hv = (HV *)SvRV(*svp);
			PERL_ASSERT(hv != NULL);
			svp = hv_fetch(hv, "value", 5, FALSE);
			PERL_ASSERT(svp != NULL);
			cat_hash = (HV *)SvRV(*svp);
			PERL_ASSERT(cat_hash != NULL);
		}
	}

	/* If we couldn't find the hash, it is a catalog we don't know about. */
	if (cat_hash == NULL) {
		return ("UNKNOWN_ID");
	}

	/* Fetch the value from the selected catalog and return it. */
	snprintf(key, sizeof (key), "%d", id);
	svp = hv_fetch(cat_hash, key, strlen(key), TRUE);
	if (svp == NULL) {
		return ("UNKNOWN_ID");
	}
	return (SvPVX(*svp));
}
Example #19
0
int
hv_to_assoc_cond(HV* hv, slurmdb_assoc_cond_t* assoc_cond)
{
    AV*    element_av;
    SV**   svp;
    char*  str = NULL;
    int    i, elements = 0;
    time_t start_time = 0;
    time_t end_time = 0;

    if ( (svp = hv_fetch (hv, "usage_start", strlen("usage_start"), FALSE)) ) {
	start_time = (time_t) (SV2time_t(*svp));
    }
    if ( (svp = hv_fetch (hv, "usage_end", strlen("usage_end"), FALSE)) ) {
	end_time = (time_t) (SV2time_t(*svp));
    }
    slurmdb_report_set_start_end_time(&start_time, &end_time);
    assoc_cond->usage_start = start_time;
    assoc_cond->usage_end = end_time;

    assoc_cond->with_usage = 1;
    assoc_cond->with_deleted = 0;
    assoc_cond->with_raw_qos = 0;
    assoc_cond->with_sub_accts = 0;
    assoc_cond->without_parent_info = 0;
    assoc_cond->without_parent_limits = 0;

    FETCH_FIELD(hv, assoc_cond, with_usage,            uint16_t, FALSE);
    FETCH_FIELD(hv, assoc_cond, with_deleted,          uint16_t, FALSE);
    FETCH_FIELD(hv, assoc_cond, with_raw_qos,          uint16_t, FALSE);
    FETCH_FIELD(hv, assoc_cond, with_sub_accts,        uint16_t, FALSE);
    FETCH_FIELD(hv, assoc_cond, without_parent_info,   uint16_t, FALSE);
    FETCH_FIELD(hv, assoc_cond, without_parent_limits, uint16_t, FALSE);

    FETCH_LIST_FIELD(hv, assoc_cond, acct_list);
    FETCH_LIST_FIELD(hv, assoc_cond, cluster_list);
    FETCH_LIST_FIELD(hv, assoc_cond, def_qos_id_list);
    FETCH_LIST_FIELD(hv, assoc_cond, id_list);
    FETCH_LIST_FIELD(hv, assoc_cond, parent_acct_list);
    FETCH_LIST_FIELD(hv, assoc_cond, partition_list);
    FETCH_LIST_FIELD(hv, assoc_cond, qos_list);
    FETCH_LIST_FIELD(hv, assoc_cond, user_list);

    return 0;
}
Example #20
0
SV *p5_hv_fetch(PerlInterpreter *my_perl, HV *hv, STRLEN len, const char *key) {
    PERL_SET_CONTEXT(my_perl);
    {
        SV ** const item = hv_fetch(hv, key, len, 0);
        if (item)
            return *item;
        return NULL;
    }
}
Example #21
0
SV* THX_MopMcV_get_authority(pTHX_ SV* metaclass) {
    HV* stash = (HV*) SvRV(metaclass);

    SV** authority = hv_fetch(stash, "AUTHORITY", 9, 0);
    if (authority != NULL) {
        return GvSV((GV*) *authority);
    } else {
        return NULL;
    }
}
Example #22
0
SV* THX_MopMcV_get_version(pTHX_ SV* metaclass) {
    HV* stash = (HV*) SvRV(metaclass);

    SV** version = hv_fetch(stash, "VERSION", 7, 0);
    if (version != NULL) {
        return GvSV((GV*) *version);
    } else {
        return NULL;
    }
}
Example #23
0
PERL_STATIC_INLINE void
xs_incset(pTHX_ const char *const unixname, const STRLEN unixlen, SV* xsfile)
{
    HV *inchv = GvHVn(PL_incgv);
#if 0
    SV** const svp = hv_fetch(inchv, unixname, unixlen, 0);
    if (!svp)
#endif
    (void)hv_store(inchv, unixname, unixlen, SvREFCNT_inc_simple_NN(xsfile), 0);
}
Example #24
0
MP_INLINE int modperl_perl_module_loaded(pTHX_ const char *name)
{
    SV **svp;
    int len;
    char *filename = package2filename(name, &len);
    svp = hv_fetch(GvHVn(PL_incgv), filename, len, 0);
    free(filename);

    return (svp && *svp != &PL_sv_undef) ? 1 : 0;
}
Example #25
0
GV*
Perl_gv_autoload4(pTHX_ HV *stash, const char *name, STRLEN len, I32 method)
{
    char autoload[] = "AUTOLOAD";
    STRLEN autolen = sizeof(autoload)-1;
    GV* gv;
    CV* cv;
    HV* varstash;
    GV* vargv;
    SV* varsv;

    if (len == autolen && strnEQ(name, autoload, autolen))
	return Nullgv;
    if (!(gv = gv_fetchmeth(stash, autoload, autolen, FALSE)))
	return Nullgv;
    cv = GvCV(gv);

    if (!CvROOT(cv))
	return Nullgv;

    /*
     * Inheriting AUTOLOAD for non-methods works ... for now.
     */
    if (ckWARN(WARN_DEPRECATED) && !method &&
	(GvCVGEN(gv) || GvSTASH(gv) != stash))
	Perl_warner(aTHX_ WARN_DEPRECATED,
	  "Use of inherited AUTOLOAD for non-method %s::%.*s() is deprecated",
	     HvNAME(stash), (int)len, name);

    /*
     * Given &FOO::AUTOLOAD, set $FOO::AUTOLOAD to desired function name.
     * The subroutine's original name may not be "AUTOLOAD", so we don't
     * use that, but for lack of anything better we will use the sub's
     * original package to look up $AUTOLOAD.
     */
    varstash = GvSTASH(CvGV(cv));
    vargv = *(GV**)hv_fetch(varstash, autoload, autolen, TRUE);
    ENTER;

#ifdef USE_THREADS
    sv_lock((SV *)varstash);
#endif
    if (!isGV(vargv))
	gv_init(vargv, varstash, autoload, autolen, FALSE);
    LEAVE;
    varsv = GvSV(vargv);
#ifdef USE_THREADS
    sv_lock(varsv);
#endif
    sv_setpv(varsv, HvNAME(stash));
    sv_catpvn(varsv, "::", 2);
    sv_catpvn(varsv, name, len);
    SvTAINTED_off(varsv);
    return gv;
}
int psgi_response(struct wsgi_request *wsgi_req, AV *response) {

	SV **status_code, **hitem ;
	AV *headers, *body =NULL;
	STRLEN hlen, hlen2;
	int i;
	char *chitem, *chitem2;
	SV **harakiri;

	if (wsgi_req->async_force_again) {

		wsgi_req->async_force_again = 0;

		wsgi_req->switches++;
                SV *chunk = uwsgi_perl_obj_call(wsgi_req->async_placeholder, "getline");
		if (!chunk) {
			uwsgi_500(wsgi_req);
			return UWSGI_OK;
		}

		if (wsgi_req->async_force_again) {
			SvREFCNT_dec(chunk);
			return UWSGI_AGAIN;
		}

                chitem = SvPV( chunk, hlen);

                if (hlen <= 0) {
			SvREFCNT_dec(chunk);
			SV *closed = uwsgi_perl_obj_call(wsgi_req->async_placeholder, "close");
                	if (closed) {
                        	SvREFCNT_dec(closed);
                	}

			// check for psgix.harakiri
        		harakiri = hv_fetch((HV*)SvRV( (SV*)wsgi_req->async_environ), "psgix.harakiri.commit", 21, 0);
        		if (harakiri) {
                		if (SvTRUE(*harakiri)) wsgi_req->async_plagued = 1;
        		}

        		SvREFCNT_dec(wsgi_req->async_result);

			return UWSGI_OK;
                }

		uwsgi_response_write_body_do(wsgi_req, chitem, hlen);
		uwsgi_pl_check_write_errors {
			SvREFCNT_dec(chunk);
			return UWSGI_OK;
		}
		SvREFCNT_dec(chunk);
		wsgi_req->async_force_again = 1;
		return UWSGI_AGAIN;
	}
Example #27
0
void VAstEnt::replaceInsert(VAstEnt* newentp, const string& name) {
    if (debug()) cout<<"VAstEnt::replaceInsert under="<<this<<" "<<newentp->ascii(name)<<"\"\n";
    HV* hvp = subhash(); assert(hvp);

    // $svpp = $table{$name}
    SV** svpp = hv_fetch(hvp, name.c_str(), name.length(), 1/*create*/);
    if (svpp) {} // unused

    // $avp = $newentp (premade avp)
    hv_store(hvp, name.c_str(), name.length(), newRV((SV*)newentp), 0);
}
Example #28
0
static void
print_var(char *var_name, char *var)
{
    HV *h_var;
    h_var = get_hv(var_name, 0);
    if(!h_var) error_tmpl("Vars hash not exist");
    SV **sr_var = hv_fetch(h_var, var, (int)strlen(var), 0);
    if(!sr_var){ error_tmpl("Var not exist");};
    if(SvTYPE(*sr_var) == SVt_IV || SvTYPE(*sr_var) == SVt_PVIV){ printf( "%li", SvIV(*sr_var)); }
    else if(SvTYPE(*sr_var) == SVt_NV || SvTYPE(*sr_var) == SVt_PVNV){ printf("%f", SvNV(*sr_var)); }
    else if(SvTYPE(*sr_var) == SVt_PV){ printf("%s", SvPV_nolen(*sr_var)); }
    else { error_tmpl("Incompatible type of var"); }
}
Example #29
0
VAstEnt* VAstEnt::findSym (const string& name) {
    HV* hvp = subhash();  assert(hvp);
    // $svpp = $table{$name}
    SV** svpp = hv_fetch(hvp, name.c_str(), name.length(), 0/*no-change*/);
    if (!svpp) return NULL;
    SV* svp = *svpp;
    if (!svp || !SvROK(svp) || SvTYPE(SvRV(svp)) != SVt_PVAV) return NULL;
    // $sub_avp = @{$table{$name}}
    AV* sub_avp = (AV*)(SvRV(svp));
    VAstEnt* entp = avToSymEnt(sub_avp);
    if (debug()) cout<<"VAstEnt::find found under="<<this<<" "<<entp->ascii(name)<<"\n";
    return entp;
}
Example #30
0
lucy_Obj*
lucy_Doc_extract(lucy_Doc *self, lucy_CharBuf *field,
                 lucy_ViewCharBuf *target) {
    lucy_Obj *retval = NULL;
    SV **sv_ptr = hv_fetch((HV*)self->fields, (char*)Lucy_CB_Get_Ptr8(field),
                           Lucy_CB_Get_Size(field), 0);

    if (sv_ptr && XSBind_sv_defined(*sv_ptr)) {
        SV *const sv = *sv_ptr;
        if (sv_isobject(sv) && sv_derived_from(sv, "Clownfish::Obj")) {
            IV tmp = SvIV(SvRV(sv));
            retval = INT2PTR(lucy_Obj*, tmp);
        }