static void xs_getnameinfo(pTHX_ CV *cv) { dVAR; dXSARGS; SV *addr; int flags; char host[1024]; char serv[256]; char *sa; /* we'll cast to struct sockaddr * when necessary */ STRLEN addr_len; int err; if(items < 1 || items > 2) croak_xs_usage(cv, "addr, flags=0"); SP -= items; addr = ST(0); if(items < 2) flags = 0; else flags = SvIV(ST(1)); if(!SvPOK(addr)) croak("addr is not a string"); addr_len = SvCUR(addr); /* We need to ensure the sockaddr is aligned, because a random SvPV might * not be due to SvOOK */ Newx(sa, addr_len, char); Copy(SvPV_nolen(addr), sa, addr_len, char); #ifdef HAS_SOCKADDR_SA_LEN ((struct sockaddr *)sa)->sa_len = addr_len; #endif err = getnameinfo((struct sockaddr *)sa, addr_len, host, sizeof(host), serv, sizeof(serv), flags); Safefree(sa); XPUSHs(err_to_SV(aTHX_ err)); if(err) XSRETURN(1); XPUSHs(sv_2mortal(newSVpv(host, 0))); XPUSHs(sv_2mortal(newSVpv(serv, 0))); XSRETURN(3); }
void jperl_destroy(pTHX_ CV *cv) { dXSARGS; SV *sv=get_sv("jperl::internal::jni", SVf_UTF8); SV *self; jobject o; JNIEnv *env; if(sv==NULL) { croak("jperl::internal::jni not initialized"); XSRETURN_UNDEF; } if(items!=1) { croak_xs_usage(cv, "self"); XSRETURN_UNDEF; } env=(JNIEnv*)SvUV(sv); self=SvRV(ST(0)); o=(jobject)SvUV(self); (*env)->DeleteGlobalRef(env, o); XSRETURN_UNDEF; }
static void xs_getaddrinfo(pTHX_ CV *cv) { dVAR; dXSARGS; SV *host; SV *service; SV *hints; char *hostname = NULL; char *servicename = NULL; STRLEN len; struct addrinfo hints_s; struct addrinfo *res; struct addrinfo *res_iter; int err; int n_res; if(items > 3) croak_xs_usage(cv, "host, service, hints"); SP -= items; if(items < 1) host = &PL_sv_undef; else host = ST(0); if(items < 2) service = &PL_sv_undef; else service = ST(1); if(items < 3) hints = NULL; else hints = ST(2); SvGETMAGIC(host); if(SvOK(host)) { hostname = SvPV_nomg(host, len); if (!len) hostname = NULL; } SvGETMAGIC(service); if(SvOK(service)) { servicename = SvPV_nomg(service, len); if (!len) servicename = NULL; } Zero(&hints_s, sizeof hints_s, char); hints_s.ai_family = PF_UNSPEC; if(hints && SvOK(hints)) { HV *hintshash; SV **valp; if(!SvROK(hints) || SvTYPE(SvRV(hints)) != SVt_PVHV) croak("hints is not a HASH reference"); hintshash = (HV*)SvRV(hints); if((valp = hv_fetch(hintshash, "flags", 5, 0)) != NULL) hints_s.ai_flags = SvIV(*valp); if((valp = hv_fetch(hintshash, "family", 6, 0)) != NULL) hints_s.ai_family = SvIV(*valp); if((valp = hv_fetch(hintshash, "socktype", 8, 0)) != NULL) hints_s.ai_socktype = SvIV(*valp); if((valp = hv_fetch(hintshash, "protocol", 8, 0)) != NULL) hints_s.ai_protocol = SvIV(*valp); } err = getaddrinfo(hostname, servicename, &hints_s, &res); XPUSHs(err_to_SV(aTHX_ err)); if(err) XSRETURN(1); n_res = 0; for(res_iter = res; res_iter; res_iter = res_iter->ai_next) { HV *res_hv = newHV(); (void)hv_stores(res_hv, "family", newSViv(res_iter->ai_family)); (void)hv_stores(res_hv, "socktype", newSViv(res_iter->ai_socktype)); (void)hv_stores(res_hv, "protocol", newSViv(res_iter->ai_protocol)); (void)hv_stores(res_hv, "addr", newSVpvn((char*)res_iter->ai_addr, res_iter->ai_addrlen)); if(res_iter->ai_canonname) (void)hv_stores(res_hv, "canonname", newSVpv(res_iter->ai_canonname, 0)); else (void)hv_stores(res_hv, "canonname", newSV(0)); XPUSHs(sv_2mortal(newRV_noinc((SV*)res_hv))); n_res++; } freeaddrinfo(res); XSRETURN(1 + n_res); }
void c_test (int max){ int i; for (f=1) } #line 23 "ko_6_1_0_perllint_01cc.c" #ifndef PERL_UNUSED_VAR # define PERL_UNUSED_VAR(var) if (0) var = var #endif #ifndef PERL_ARGS_ASSERT_CROAK_XS_USAGE #define PERL_ARGS_ASSERT_CROAK_XS_USAGE assert(cv); assert(params) /* prototype to pass -Wmissing-prototypes */ STATIC void S_croak_xs_usage(pTHX_ const CV *const cv, const char *const params); STATIC void S_croak_xs_usage(pTHX_ const CV *const cv, const char *const params) { const GV *const gv = CvGV(cv); PERL_ARGS_ASSERT_CROAK_XS_USAGE; if (gv) { const char *const gvname = GvNAME(gv); const HV *const stash = GvSTASH(gv); const char *const hvname = stash ? HvNAME(stash) : NULL; if (hvname) Perl_croak(aTHX_ "Usage: %s::%s(%s)", hvname, gvname, params); else Perl_croak(aTHX_ "Usage: %s(%s)", gvname, params); } else { /* Pants. I don't think that it should be possible to get here. */ Perl_croak(aTHX_ "Usage: CODE(0x%"UVxf")(%s)", PTR2UV(cv), params); } } #undef PERL_ARGS_ASSERT_CROAK_XS_USAGE #ifdef PERL_IMPLICIT_CONTEXT #define croak_xs_usage(a,b) S_croak_xs_usage(aTHX_ a,b) #else #define croak_xs_usage S_croak_xs_usage #endif #endif /* NOTE: the prototype of newXSproto() is different in versions of perls, * so we define a portable version of newXSproto() */ #ifdef newXS_flags #define newXSproto_portable(name, c_impl, file, proto) newXS_flags(name, c_impl, file, proto, 0) #else #define newXSproto_portable(name, c_impl, file, proto) (PL_Sv=(SV*)newXS(name, c_impl, file), sv_setpv(PL_Sv, proto), (CV*)PL_Sv) #endif /* !defined(newXS_flags) */ #line 75 "ko_6_1_0_perllint_01cc.c" XS(XS_main_c_test); /* prototype to pass -Wmissing-prototypes */ XS(XS_main_c_test) { #ifdef dVAR dVAR; dXSARGS; #else dXSARGS; #endif if (items != 1) croak_xs_usage(cv, "max"); PERL_UNUSED_VAR(ax); /* -Wall */ SP -= items; { int max = (int)SvIV(ST(0)); #line 22 "ko_6_1_0_perllint_01cc.xs" I32* temp; #line 93 "ko_6_1_0_perllint_01cc.c" #line 24 "ko_6_1_0_perllint_01cc.xs" temp = PL_markstack_ptr++; c_test(max); if (PL_markstack_ptr != temp) { /* truly void, because dXSARGS not invoked */ PL_markstack_ptr = temp; XSRETURN_EMPTY; /* return empty stack */ } /* must have used dXSARGS; list context implied */ return; /* assume stack size is correct */ #line 104 "ko_6_1_0_perllint_01cc.c" PUTBACK; return; } } #ifdef __cplusplus extern "C" #endif XS(boot_ko_6_1_0_perllint_01cc); /* prototype to pass -Wmissing-prototypes */ XS(boot_ko_6_1_0_perllint_01cc) { #ifdef dVAR dVAR; dXSARGS; #else dXSARGS; #endif #if (PERL_REVISION == 5 && PERL_VERSION < 9) char* file = __FILE__; #else const char* file = __FILE__; #endif PERL_UNUSED_VAR(cv); /* -W */ PERL_UNUSED_VAR(items); /* -W */ XS_VERSION_BOOTCHECK ; newXS("main::c_test", XS_main_c_test, file); #if (PERL_REVISION == 5 && PERL_VERSION >= 9) if (PL_unitcheckav) call_list(PL_scopestack_ix, PL_unitcheckav); #endif XSRETURN_YES; }