void dump_me(int level, const char* file, int line, SV* arg) {
if (! (debug_level & level))
return;
sv_dump(arg);
warn("...at %s line %d\n", file, line);
}
void t ()
{
MAGIC *m;
/* Create a variable*/
char *var = "main::foo";
SV *sv = perl_get_sv(var,TRUE);
/* Upgrade the sv to a magical variable*/
sv_magic(sv, NULL, '~', var, strlen(var));
/* sv_magic adds a MAGIC structure (of type '~') to the SV.
Get it and set the virtual table pointer */
m = mg_find(sv, '~');
m->mg_virtual = &foo_accessors;
SvMAGICAL_on(sv);
sv_dump(sv);
}
void
perl_mongo_sv_to_bson (bson_t * bson, SV *sv, HV *opts) {
if (!SvROK (sv)) {
croak ("not a reference");
}
if ( ! sv_isobject(sv) ) {
switch ( SvTYPE(SvRV(sv)) ) {
case SVt_PVHV:
hvdoc_to_bson (bson, sv, opts, EMPTY_STACK);
break;
case SVt_PVAV:
avdoc_to_bson(bson, sv, opts, EMPTY_STACK);
break;
default:
sv_dump(sv);
croak ("type unhandled");
}
}
else {
SV *obj;
char *class;
obj = SvRV(sv);
class = HvNAME(SvSTASH(obj));
if ( strEQ(class, "Tie::IxHash") ) {
ixhashdoc_to_bson(bson, sv, opts, EMPTY_STACK);
}
else if ( strEQ(class, "MongoDB::BSON::_EncodedDoc") ) {
STRLEN str_len;
SV **svp;
SV *encoded;
const char *bson_str;
bson_t *child;
encoded = _hv_fetchs_sv((HV *)obj, "bson");
bson_str = SvPV(encoded, str_len);
child = bson_new_from_data((uint8_t*) bson_str, str_len);
bson_concat(bson, child);
bson_destroy(child);
}
else if (SvTYPE(obj) == SVt_PVHV) {
int perl_trapd_handler( netsnmp_pdu *pdu,
netsnmp_transport *transport,
netsnmp_trapd_handler *handler)
{
trapd_cb_data *cb_data;
SV *pcallback;
netsnmp_variable_list *vb;
netsnmp_oid *o;
SV *arg;
SV *rarg;
SV **tmparray;
int i, c = 0;
u_char *outbuf;
size_t ob_len = 0, oo_len = 0;
AV *varbinds;
HV *pduinfo;
dSP;
ENTER;
SAVETMPS;
if (!pdu || !handler)
return 0;
/* nuke v1 PDUs */
if (pdu->command == SNMP_MSG_TRAP)
pdu = convert_v1pdu_to_v2(pdu);
cb_data = handler->handler_data;
if (!cb_data || !cb_data->perl_cb)
return 0;
pcallback = cb_data->perl_cb;
/* get PDU related info */
pduinfo = newHV();
#define STOREPDU(n, v) hv_store(pduinfo, n, strlen(n), v, 0)
#define STOREPDUi(n, v) STOREPDU(n, newSViv(v))
#define STOREPDUs(n, v) STOREPDU(n, newSVpv(v, 0))
STOREPDUi("version", pdu->version);
STOREPDUs("notificationtype", ((pdu->command == SNMP_MSG_INFORM) ? "INFORM":"TRAP"));
STOREPDUi("requestid", pdu->reqid);
STOREPDUi("messageid", pdu->msgid);
STOREPDUi("transactionid", pdu->transid);
STOREPDUi("errorstatus", pdu->errstat);
STOREPDUi("errorindex", pdu->errindex);
if (pdu->version == 3) {
STOREPDUi("securitymodel", pdu->securityModel);
STOREPDUi("securitylevel", pdu->securityLevel);
STOREPDU("contextName",
newSVpv(pdu->contextName, pdu->contextNameLen));
STOREPDU("contextEngineID",
newSVpv(pdu->contextEngineID,
pdu->contextEngineIDLen));
STOREPDU("securityEngineID",
newSVpv(pdu->securityEngineID,
pdu->securityEngineIDLen));
STOREPDU("securityName",
newSVpv(pdu->securityName, pdu->securityNameLen));
} else {
STOREPDU("community",
newSVpv(pdu->community, pdu->community_len));
}
if (transport && transport->f_fmtaddr) {
char *tstr = transport->f_fmtaddr(transport, pdu->transport_data,
pdu->transport_data_length);
STOREPDUs("receivedfrom", tstr);
free(tstr);
}
/*
* collect OID objects in a temp array first
*/
/* get VARBIND related info */
i = count_varbinds(pdu->variables);
tmparray = malloc(sizeof(*tmparray) * i);
for(vb = pdu->variables; vb; vb = vb->next_variable) {
/* get the oid */
o = SNMP_MALLOC_TYPEDEF(netsnmp_oid);
o->name = o->namebuf;
o->len = vb->name_length;
memcpy(o->name, vb->name, vb->name_length * sizeof(oid));
#undef CALL_EXTERNAL_OID_NEW
#ifdef CALL_EXTERNAL_OID_NEW
PUSHMARK(sp);
rarg = sv_2mortal(newSViv((IV) 0));
arg = sv_2mortal(newSVrv(rarg, "netsnmp_oidPtr"));
sv_setiv(arg, (IV) o);
XPUSHs(rarg);
PUTBACK;
i = perl_call_pv("NetSNMP::OID::newwithptr", G_SCALAR);
SPAGAIN;
if (i != 1) {
snmp_log(LOG_ERR, "unhandled OID error.\n");
/* ack XXX */
}
/* get the value */
tmparray[c++] = POPs;
SvREFCNT_inc(tmparray[c-1]);
PUTBACK;
#else /* build it and bless ourselves */
{
HV *hv = newHV();
SV *rv = newRV_noinc((SV *) hv);
SV *rvsub = newRV_noinc((SV *) newSViv((UV) o));
SV *sv;
rvsub = sv_bless(rvsub, gv_stashpv("netsnmp_oidPtr", 1));
hv_store(hv, "oidptr", 6, rvsub, 0);
rv = sv_bless(rv, gv_stashpv("NetSNMP::OID", 1));
tmparray[c++] = rv;
}
#endif /* build oid ourselves */
}
/*
* build the varbind lists
*/
varbinds = newAV();
for(vb = pdu->variables, i = 0; vb; vb = vb->next_variable, i++) {
/* push the oid */
AV *vba;
vba = newAV();
/* get the value */
outbuf = NULL;
ob_len = 0;
oo_len = 0;
sprint_realloc_by_type(&outbuf, &ob_len, &oo_len, 1,
vb, 0, 0, 0);
av_push(vba,tmparray[i]);
av_push(vba,newSVpvn(outbuf, oo_len));
free(outbuf);
av_push(vba,newSViv(vb->type));
av_push(varbinds, (SV *) newRV_noinc((SV *) vba));
}
PUSHMARK(sp);
/* store the collected information on the stack */
XPUSHs(sv_2mortal(newRV_noinc((SV*) pduinfo)));
XPUSHs(sv_2mortal(newRV_noinc((SV*) varbinds)));
/* put the stack back in order */
PUTBACK;
/* actually call the callback function */
if (SvTYPE(pcallback) == SVt_PVCV) {
perl_call_sv(pcallback, G_DISCARD);
/* XXX: it discards the results, which isn't right */
} else if (SvROK(pcallback) && SvTYPE(SvRV(pcallback)) == SVt_PVCV) {
/* reference to code */
perl_call_sv(SvRV(pcallback), G_DISCARD);
} else {
snmp_log(LOG_ERR, " tried to call a perl function but failed to understand its type: (ref = %x, svrok: %lu, SVTYPE: %lu)\n", (uintptr_t)pcallback, SvROK(pcallback), SvTYPE(pcallback));
}
#ifdef DUMPIT
fprintf(stderr, "DUMPDUMPDUMPDUMPDUMPDUMP\n");
sv_dump(pduinfo);
fprintf(stderr, "--------------------\n");
sv_dump(varbinds);
#endif
/* svREFCNT_dec((SV *) pduinfo); */
#ifdef NOT_THIS
{
SV *vba;
while(vba = av_pop(varbinds)) {
av_undef((AV *) vba);
}
}
av_undef(varbinds);
#endif
free(tmparray);
/* Not needed because of the G_DISCARD flag (I think) */
/* SPAGAIN; */
/* PUTBACK; */
#ifndef __x86_64__
FREETMPS; /* FIXME: known to cause a segfault on x86-64 */
#endif
LEAVE;
return NETSNMPTRAPD_HANDLER_OK;
}
void t1 ()
{
sv_dump(perl_get_sv("main::foo",FALSE));
}
