C++ SvIV函数代码示例

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;
}