SV *
PLCBA_construct(const char *pkg, AV *options)
{
PLCBA_t *async;
char *host, *username, *password, *bucket;
libcouchbase_t instance;
SV *blessed_obj;
Newxz(async, 1, PLCBA_t);
extract_async_options(async, options);
plcb_ctor_conversion_opts(&async->base, options);
plcb_ctor_cbc_opts(options, &host, &username, &password, &bucket);
instance = libcouchbase_create(host, username, password, bucket,
plcba_make_io_opts(async));
if(!instance) {
die("Couldn't create instance!");
}
plcb_ctor_init_common(&async->base, instance, options);
plcba_setup_callbacks(async);
async->base_rv = newRV_inc(newSViv(PTR2IV(&(async->base))));
blessed_obj = newSV(0);
sv_setiv(newSVrv(blessed_obj, pkg), PTR2IV(async));
return blessed_obj;
}
void
ffi_pl_closure_add_data(SV *closure, ffi_pl_closure *closure_data)
{
dSP;
ENTER;
SAVETMPS;
PUSHMARK(SP);
XPUSHs(closure);
XPUSHs(sv_2mortal(newSViv(PTR2IV(closure_data))));
XPUSHs(sv_2mortal(newSViv(PTR2IV(closure_data->type))));
PUTBACK;
call_pv("FFI::Platypus::Closure::add_data", G_DISCARD);
FREETMPS;
LEAVE;
}
ffi_pl_closure *
ffi_pl_closure_get_data(SV *closure, ffi_pl_type *type)
{
dSP;
int count;
ffi_pl_closure *ret;
ENTER;
SAVETMPS;
PUSHMARK(SP);
XPUSHs(closure);
XPUSHs(sv_2mortal(newSViv(PTR2IV(type))));
PUTBACK;
count = call_pv("FFI::Platypus::Closure::get_data", G_SCALAR);
SPAGAIN;
if (count != 1)
ret = NULL;
else
ret = INT2PTR(void*, POPi);
PUTBACK;
FREETMPS;
LEAVE;
return ret;
}
static
XS (XS_Xchat_get_info)
{
SV *temp = NULL;
dXSARGS;
if (items != 1) {
xchat_print (ph, "Usage: Xchat::get_info(id)");
} else {
SV *id = ST (0);
const char *RETVAL;
RETVAL = xchat_get_info (ph, SvPV_nolen (id));
if (RETVAL == NULL) {
XSRETURN_UNDEF;
}
if (!strncmp ("win_ptr", SvPV_nolen (id), 7)) {
XSRETURN_IV (PTR2IV (RETVAL));
} else {
if (
!strncmp ("libdirfs", SvPV_nolen (id), 8) ||
!strncmp ("xchatdirfs", SvPV_nolen (id), 10)
) {
XSRETURN_PV (RETVAL);
} else {
temp = newSVpv (RETVAL, 0);
SvUTF8_on (temp);
PUSHMARK (SP);
XPUSHs (sv_2mortal (temp));
PUTBACK;
}
}
}
}
static void *create_event(plcba_cbcio *cbcio)
{
PLCBA_c_event *cevent;
PLCBA_t *async;
async = (PLCBA_t*)cbcio->v.v0.cookie;
Newxz(cevent, 1, PLCBA_c_event);
cevent->pl_event = newAV();
cevent->evtype = PLCBA_EVTYPE_IO;
av_store(cevent->pl_event,
PLCBA_EVIDX_OPAQUE,
newSViv(PTR2IV(cevent)));
if (async->cevents) {
cevent->prev = NULL;
cevent->next = async->cevents;
async->cevents->prev = cevent;
async->cevents = cevent;
} else {
async->cevents = cevent;
cevent->next = NULL;
cevent->prev = NULL;
}
return cevent;
}
void Perl_ithread_set (pTHX_ ithread* thread)
{
SV* thread_sv = newSViv(PTR2IV(thread));
if(!hv_store(PL_modglobal, "threads::self", 12, thread_sv,0)) {
croak("%s\n","Internal error, couldn't set TLS");
}
}
static void
S_lazy_init_host_obj(kino_Obj *self)
{
SV *inner_obj = newSV(0);
SvOBJECT_on(inner_obj);
PL_sv_objcount++;
SvUPGRADE(inner_obj, SVt_PVMG);
sv_setiv(inner_obj, PTR2IV(self));
// Connect class association.
kino_CharBuf *class_name = Kino_VTable_Get_Name(self->vtable);
HV *stash = gv_stashpvn((char*)Kino_CB_Get_Ptr8(class_name),
Kino_CB_Get_Size(class_name), TRUE);
SvSTASH_set(inner_obj, (HV*)SvREFCNT_inc(stash));
/* Up till now we've been keeping track of the refcount in
* self->ref.count. We're replacing ref.count with ref.host_obj, which
* will assume responsibility for maintaining the refcount. ref.host_obj
* starts off with a refcount of 1, so we need to transfer any refcounts
* in excess of that. */
size_t old_refcount = self->ref.count;
self->ref.host_obj = inner_obj;
while (old_refcount > 1) {
SvREFCNT_inc_simple_void_NN(inner_obj);
old_refcount--;
}
}
int
ithread_mg_get(pTHX_ SV *sv, MAGIC *mg)
{
ithread *thread = (ithread *) mg->mg_ptr;
SvIVX(sv) = PTR2IV(thread);
SvIOK_on(sv);
return 0;
}
static int
fd_cb (int fd, int flags, void *userdata)
{
HookData *data = (HookData *) userdata;
int retVal = 0;
int count = 0;
dSP;
ENTER;
SAVETMPS;
PUSHMARK (SP);
XPUSHs (data->userdata);
PUTBACK;
set_current_package (data->package);
count = call_sv (data->callback, G_EVAL);
set_current_package (&PL_sv_undef);
SPAGAIN;
if (SvTRUE (ERRSV)) {
hexchat_printf (ph, "Error in fd callback %s", SvPV_nolen (ERRSV));
if (!SvOK (POPs)) {} /* remove undef from the top of the stack */
retVal = HEXCHAT_EAT_ALL;
} else {
if (count != 1) {
hexchat_print (ph, "Fd handler should only return 1 value.");
retVal = HEXCHAT_EAT_NONE;
} else {
retVal = POPi;
if (retVal == 0) {
/* if 0 is returned, the fd is going to get unhooked */
PUSHMARK (SP);
XPUSHs (sv_2mortal (newSViv (PTR2IV (data->hook))));
PUTBACK;
call_pv ("Xchat::unhook", G_EVAL);
SPAGAIN;
SvREFCNT_dec (data->callback);
if (data->userdata) {
SvREFCNT_dec (data->userdata);
}
free (data);
}
}
}
PUTBACK;
FREETMPS;
LEAVE;
return retVal;
}
static
XS (XS_Xchat_get_context)
{
dXSARGS;
if (items != 0) {
xchat_print (ph, "Usage: Xchat::get_context()");
} else {
XSRETURN_IV (PTR2IV (xchat_get_context (ph)));
}
}
static
XS (XS_Xchat_find_context)
{
char *server = NULL;
char *chan = NULL;
xchat_context *RETVAL;
dXSARGS;
if (items > 2)
xchat_print (ph, "Usage: Xchat::find_context ([channel, [server]])");
{
switch (items) {
case 0: /* no server name and no channel name */
/* nothing to do, server and chan are already NULL */
break;
case 1: /* channel name only */
/* change channel value only if it is true or 0 */
/* otherwise leave it as null */
if (SvTRUE (ST (0)) || SvNIOK (ST (0))) {
chan = SvPV_nolen (ST (0));
/* xchat_printf( ph, "XSUB - find_context( %s, NULL )", chan ); */
}
/* else { xchat_print( ph, "XSUB - find_context( NULL, NULL )" ); } */
/* chan is already NULL */
break;
case 2: /* server and channel */
/* change channel value only if it is true or 0 */
/* otherwise leave it as NULL */
if (SvTRUE (ST (0)) || SvNIOK (ST (0))) {
chan = SvPV_nolen (ST (0));
/* xchat_printf( ph, "XSUB - find_context( %s, NULL )", SvPV_nolen(ST(0) )); */
}
/* else { xchat_print( ph, "XSUB - 2 arg NULL chan" ); } */
/* change server value only if it is true or 0 */
/* otherwise leave it as NULL */
if (SvTRUE (ST (1)) || SvNIOK (ST (1))) {
server = SvPV_nolen (ST (1));
/* xchat_printf( ph, "XSUB - find_context( NULL, %s )", SvPV_nolen(ST(1) )); */
}
/* else { xchat_print( ph, "XSUB - 2 arg NULL server" ); } */
break;
}
RETVAL = xchat_find_context (ph, server, chan);
if (RETVAL != NULL) {
/* xchat_print (ph, "XSUB - context found"); */
XSRETURN_IV (PTR2IV (RETVAL));
} else {
/* xchat_print (ph, "XSUB - context not found"); */
XSRETURN_UNDEF;
}
}
}
static int
timer_cb (void *userdata)
{
HookData *data = (HookData *) userdata;
int retVal = 0;
int count = 0;
dSP;
ENTER;
SAVETMPS;
PUSHMARK (SP);
XPUSHs (data->userdata);
PUTBACK;
if (data->ctx) {
xchat_set_context (ph, data->ctx);
}
set_current_package (data->package);
count = call_sv (data->callback, G_EVAL);
set_current_package (&PL_sv_undef);
SPAGAIN;
if (SvTRUE (ERRSV)) {
xchat_printf (ph, "Error in timer callback %s", SvPV_nolen (ERRSV));
if (!SvOK (POPs)) {} /* remove undef from the top of the stack */
retVal = XCHAT_EAT_ALL;
} else {
if (count != 1) {
xchat_print (ph, "Timer handler should only return 1 value.");
retVal = XCHAT_EAT_NONE;
} else {
retVal = POPi;
if (retVal == 0) {
/* if 0 is return the timer is going to get unhooked */
PUSHMARK (SP);
XPUSHs (sv_2mortal (newSViv (PTR2IV (data->hook))));
XPUSHs (sv_mortalcopy (data->package));
PUTBACK;
call_pv ("Xchat::unhook", G_EVAL);
SPAGAIN;
}
}
}
PUTBACK;
FREETMPS;
LEAVE;
return retVal;
}
int preprocessAndRun(struct collectionFormat *collection, struct cargsF *cargs, char execute[], char *error, int errorlength) {
//antar at rutiner som ikke returnerer noe mislykkes. Dette kan for eks skje hvis vi kaller die, eller ikke trenger retur koden
char perlfile[PATH_MAX];
snprintf(perlfile,sizeof(perlfile),"%s/main.pm",collection->crawlLibInfo->resourcepath);
bblog(DEBUGINFO, "cargs %p\n",cargs);
#ifdef DEBUG
//printer ut pekere til colection info, og alle rutinene
bblog(DEBUGINFO, "collection %p, documentExist %p, documentAdd %p, documentError %p, documentContinue %p",cargs->collection,cargs->documentExist,cargs->documentAdd,cargs->documentError,cargs->documentContinue);
#endif
HV *obj_attr = newHV();
hv_store(obj_attr, "ptr", strlen("ptr"), sv_2mortal(newSViv(PTR2IV(cargs))), 0);
HV *hv = newHV();
//sendes altid med
hv_store(hv, "last_crawl", strlen("last_crawl"), sv_2mortal(newSVuv(collection->lastCrawl)), 0);
//sendes bare med hvis vi har verdi
if (collection->resource != NULL)
hv_store(hv, "resource", strlen("resource"), sv_2mortal(newSVpv(collection->resource, 0)), 0);
if (collection->connector != NULL)
hv_store(hv, "connector", strlen("connector"), sv_2mortal(newSVpv(collection->connector, 0)), 0);
if (collection->password != NULL)
hv_store(hv, "password", strlen("password"), sv_2mortal(newSVpv(collection->password, 0)), 0);
if (collection->query1 != NULL)
hv_store(hv, "query1", strlen("query1"), sv_2mortal(newSVpv(collection->query1, 0)), 0);
if (collection->query2 != NULL)
hv_store(hv, "query2", strlen("query2"), sv_2mortal(newSVpv(collection->query2, 0)), 0);
if (collection->collection_name != NULL)
hv_store(hv, "collection_name", strlen("collection_name"), sv_2mortal(newSVpv(collection->collection_name, 0)), 0);
if (collection->user != NULL)
hv_store(hv, "user", strlen("user"), sv_2mortal(newSVpv(collection->user, 0)), 0);
if (collection->userprefix != NULL)
hv_store(hv, "userprefix", strlen("userprefix"), sv_2mortal(newSVpv(collection->userprefix, 0)), 0);
if (collection->extra != NULL)
hv_store(hv, "extra", strlen("extra"), sv_2mortal(newSVpv(collection->extra, 0)), 0);
if (collection->test_file_prefix != NULL)
hv_store(hv, "test_file_prefix", strlen("test_file_prefix"), sv_2mortal(newSVpv(collection->test_file_prefix, 0)), 0);
// Add custom params to hash.
ht_to_perl_ht(hv, collection->params);
return perl_embed_run(perlfile, execute, hv, "Perlcrawl", obj_attr, error, errorlength);
}
/* Xchat::Internal::hook_fd(fd, callback, flags, userdata) */
static
XS (XS_Xchat_hook_fd)
{
int fd;
SV *callback;
int flags;
SV *userdata;
SV *package;
hexchat_hook *hook;
HookData *data;
dXSARGS;
if (items != 5) {
hexchat_print (ph,
"Usage: Xchat::Internal::hook_fd(fd, callback, flags, userdata)");
} else {
fd = (int) SvIV (ST (0));
callback = ST (1);
flags = (int) SvIV (ST (2));
userdata = ST (3);
package = ST (4);
data = NULL;
#ifdef WIN32
if ((flags & HEXCHAT_FD_NOTSOCKET) == 0) {
/* this _get_osfhandle if from win32iop.h in the perl distribution,
* not the one provided by Windows
*/
fd = _get_osfhandle(fd);
if (fd < 0) {
hexchat_print(ph, "Invalid file descriptor");
XSRETURN_UNDEF;
}
}
#endif
data = malloc (sizeof (HookData));
if (data == NULL) {
XSRETURN_UNDEF;
}
data->callback = newSVsv (callback);
data->userdata = newSVsv (userdata);
data->depth = 0;
data->package = newSVsv (package);
hook = hexchat_hook_fd (ph, fd, flags, fd_cb, data);
data->hook = hook;
XSRETURN_IV (PTR2IV (hook));
}
}
void modperl_handler_make_args(pTHX_ AV **avp, ...)
{
va_list args;
if (!*avp) {
*avp = newAV(); /* XXX: cache an intialized AV* per-request */
}
va_start(args, avp);
for (;;) {
char *classname = va_arg(args, char *);
void *ptr;
SV *sv;
if (classname == NULL) {
break;
}
ptr = va_arg(args, void *);
switch (*classname) {
case 'A':
if (strEQ(classname, "APR::Table")) {
sv = modperl_hash_tie(aTHX_ classname, (SV *)NULL, ptr);
break;
}
case 'I':
if (strEQ(classname, "IV")) {
sv = ptr ? newSViv(PTR2IV(ptr)) : &PL_sv_undef;
break;
}
case 'P':
if (strEQ(classname, "PV")) {
sv = ptr ? newSVpv((char *)ptr, 0) : &PL_sv_undef;
break;
}
case 'H':
if (strEQ(classname, "HV")) {
sv = newRV_noinc((SV*)ptr);
break;
}
default:
sv = modperl_ptr2obj(aTHX_ classname, ptr);
break;
}
av_push(*avp, sv);
}
va_end(args);
}
/*
* Create a new ::Object by wrapping an ea_object_t in a perl SV. This is used
* to wrap exacct records that have been read from a file, or packed records
* that have been inflated.
*/
SV *
new_xs_ea_object(ea_object_t *ea_obj)
{
xs_ea_object_t *xs_obj;
SV *sv_obj;
/* Allocate space - use perl allocator. */
New(0, xs_obj, 1, xs_ea_object_t);
PERL_ASSERT(xs_obj != NULL);
xs_obj->ea_obj = ea_obj;
xs_obj->perl_obj = NULL;
sv_obj = NEWSV(0, 0);
PERL_ASSERT(sv_obj != NULL);
/*
* Initialise according to the type of the passed exacct object,
* and bless the perl object into the appropriate class.
*/
if (ea_obj->eo_type == EO_ITEM) {
if ((ea_obj->eo_catalog & EXT_TYPE_MASK) == EXT_EXACCT_OBJECT) {
INIT_EMBED_ITEM_FLAGS(xs_obj);
} else {
INIT_PLAIN_ITEM_FLAGS(xs_obj);
}
sv_setiv(newSVrv(sv_obj, NULL), PTR2IV(xs_obj));
sv_bless(sv_obj, Sun_Solaris_Exacct_Object_Item_stash);
} else {
INIT_GROUP_FLAGS(xs_obj);
sv_setiv(newSVrv(sv_obj, NULL), PTR2IV(xs_obj));
sv_bless(sv_obj, Sun_Solaris_Exacct_Object_Group_stash);
}
/*
* We are passing back a pointer masquerading as a perl IV,
* so make sure it can't be modified.
*/
SvREADONLY_on(SvRV(sv_obj));
return (sv_obj);
}
lucy_Err*
lucy_Err_trap(Cfish_Err_Attempt_t routine, void *context) {
lucy_Err *error = NULL;
SV *routine_sv = newSViv(PTR2IV(routine));
SV *context_sv = newSViv(PTR2IV(context));
dSP;
ENTER;
SAVETMPS;
PUSHMARK(SP);
EXTEND(SP, 2);
PUSHs(sv_2mortal(routine_sv));
PUSHs(sv_2mortal(context_sv));
PUTBACK;
int count = call_sv(attempt_xsub, G_EVAL | G_DISCARD);
if (count != 0) {
lucy_CharBuf *mess
= lucy_CB_newf("'attempt' returned too many values: %i32",
(int32_t)count);
error = lucy_Err_new(mess);
}
else {
SV *dollar_at = get_sv("@", FALSE);
if (SvTRUE(dollar_at)) {
if (sv_isobject(dollar_at)
&& sv_derived_from(dollar_at,"Clownfish::Err")
) {
IV error_iv = SvIV(SvRV(dollar_at));
error = INT2PTR(lucy_Err*, error_iv);
CFISH_INCREF(error);
}
else {
STRLEN len;
char *ptr = SvPVutf8(dollar_at, len);
lucy_CharBuf *mess = lucy_CB_new_from_trusted_utf8(ptr, len);
error = lucy_Err_new(mess);
}
}
/* Xchat::Internal::hook_command(name, priority, callback, help_text, userdata) */
static
XS (XS_Xchat_hook_command)
{
char *name;
int pri;
SV *callback;
char *help_text = NULL;
SV *userdata;
xchat_hook *hook;
HookData *data;
dXSARGS;
if (items != 5) {
xchat_print (ph,
"Usage: Xchat::Internal::hook_command(name, priority, callback, help_text, userdata)");
} else {
name = SvPV_nolen (ST (0));
pri = (int) SvIV (ST (1));
callback = ST (2);
/* leave the help text has NULL if the help text is undefined to avoid
* overriding the default help message for builtin commands */
if (SvOK(ST (3))) {
help_text = SvPV_nolen (ST (3));
}
userdata = ST (4);
data = NULL;
data = malloc (sizeof (HookData));
if (data == NULL) {
XSRETURN_UNDEF;
}
data->callback = sv_mortalcopy (callback);
SvREFCNT_inc (data->callback);
data->userdata = sv_mortalcopy (userdata);
SvREFCNT_inc (data->userdata);
data->depth = 0;
data->package = NULL;
hook = xchat_hook_command (ph, name, pri, command_cb, help_text, data);
XSRETURN_IV (PTR2IV (hook));
}
}
static void
Encode_XSEncoding(pTHX_ encode_t *enc)
{
dSP;
HV *stash = gv_stashpv("Encode::XS", TRUE);
SV *sv = sv_bless(newRV_noinc(newSViv(PTR2IV(enc))),stash);
int i = 0;
PUSHMARK(sp);
XPUSHs(sv);
while (enc->name[i])
{
const char *name = enc->name[i++];
XPUSHs(sv_2mortal(newSVpvn(name,strlen(name))));
}
PUTBACK;
call_pv("Encode::define_encoding",G_DISCARD);
SvREFCNT_dec(sv);
}
SV *
ithread_to_SV(pTHX_ SV *obj, ithread *thread, char *classname, bool inc)
{
SV *sv;
MAGIC *mg;
if (inc) {
MUTEX_LOCK(&thread->mutex);
thread->count++;
MUTEX_UNLOCK(&thread->mutex);
}
if (!obj)
obj = newSV(0);
sv = newSVrv(obj,classname);
sv_setiv(sv,PTR2IV(thread));
mg = sv_magicext(sv,Nullsv,PERL_MAGIC_shared_scalar,&ithread_vtbl,(char *)thread,0);
mg->mg_flags |= MGf_DUP;
SvREADONLY_on(sv);
return obj;
}
static char *pe_var_start(pe_watcher *_ev, int repeat) {
STRLEN n_a;
struct ufuncs *ufp;
MAGIC **mgp;
MAGIC *mg;
pe_var *ev = (pe_var*) _ev;
SV *sv = ev->variable;
if (!_ev->callback)
return "without callback";
if (!sv || !SvOK(sv))
return "watching what?";
if (!ev->events)
return "without poll events specified";
sv = SvRV(sv);
if (SvREADONLY(sv))
return "cannot trace read-only variable";
(void)SvUPGRADE(sv, SVt_PVMG);
mgp = &SvMAGIC(sv);
while ((mg = *mgp)) {
mgp = &mg->mg_moremagic;
}
EvNew(11, mg, 1, MAGIC);
Zero(mg, 1, MAGIC);
mg->mg_type = 'U';
mg->mg_virtual = &PL_vtbl_uvar;
*mgp = mg;
EvNew(8, ufp, 1, struct ufuncs);
ufp->uf_val = ev->events & PE_R? tracevar_r : 0;
ufp->uf_set = ev->events & PE_W? tracevar_w : 0;
ufp->uf_index = PTR2IV(ev);
mg->mg_ptr = (char *) ufp;
mg->mg_obj = (SV*) ev;
mg_magical(sv);
if (!SvMAGICAL(sv))
return "mg_magical didn't";
return 0;
}
static SV *
list_item_to_sv ( xchat_list *list, const char *const *fields )
{
HV *hash = newHV();
SV *field_value;
const char *field;
int field_index = 0;
const char *field_name;
int name_len;
while (fields[field_index] != NULL) {
field_name = fields[field_index] + 1;
name_len = strlen (field_name);
switch (fields[field_index][0]) {
case 's':
field = xchat_list_str (ph, list, field_name);
if (field != NULL) {
field_value = newSVpvn (field, strlen (field));
} else {
field_value = &PL_sv_undef;
}
break;
case 'p':
field_value = newSViv (PTR2IV (xchat_list_str (ph, list,
field_name)));
break;
case 'i':
field_value = newSVuv (xchat_list_int (ph, list, field_name));
break;
case 't':
field_value = newSVnv (xchat_list_time (ph, list, field_name));
break;
default:
field_value = &PL_sv_undef;
}
hv_store (hash, field_name, name_len, field_value, 0);
field_index++;
}
return sv_2mortal (newRV_noinc ((SV *) hash));
}
/* Xchat::Internal::hook_timer(timeout, callback, userdata) */
static
XS (XS_Xchat_hook_timer)
{
int timeout;
SV *callback;
SV *userdata;
xchat_hook *hook;
SV *package;
HookData *data;
dXSARGS;
if (items != 4) {
xchat_print (ph,
"Usage: Xchat::Internal::hook_timer(timeout, callback, userdata, package)");
} else {
timeout = (int) SvIV (ST (0));
callback = ST (1);
data = NULL;
userdata = ST (2);
package = ST (3);
data = malloc (sizeof (HookData));
if (data == NULL) {
XSRETURN_UNDEF;
}
data->callback = sv_mortalcopy (callback);
SvREFCNT_inc (data->callback);
data->userdata = sv_mortalcopy (userdata);
SvREFCNT_inc (data->userdata);
data->ctx = xchat_get_context (ph);
data->package = sv_mortalcopy (package);
SvREFCNT_inc (data->package);
hook = xchat_hook_timer (ph, timeout, timer_cb, data);
data->hook = hook;
XSRETURN_IV (PTR2IV (hook));
}
}
/* Xchat::Internal::hook_server(name, priority, callback, userdata) */
static
XS (XS_Xchat_hook_server)
{
char *name;
int pri;
SV *callback;
SV *userdata;
SV *package;
hexchat_hook *hook;
HookData *data;
dXSARGS;
if (items != 5) {
hexchat_print (ph,
"Usage: Xchat::Internal::hook_server(name, priority, callback, userdata, package)");
} else {
name = SvPV_nolen (ST (0));
pri = (int) SvIV (ST (1));
callback = ST (2);
userdata = ST (3);
package = ST (4);
data = NULL;
data = malloc (sizeof (HookData));
if (data == NULL) {
XSRETURN_UNDEF;
}
data->callback = newSVsv (callback);
data->userdata = newSVsv (userdata);
data->depth = 0;
data->package = newSVsv (package);
hook = hexchat_hook_server (ph, name, pri, server_cb, data);
XSRETURN_IV (PTR2IV (hook));
}
}
static
XS (XS_Xchat_register)
{
char *name, *version, *desc, *filename;
void *gui_entry;
dXSARGS;
if (items != 4) {
xchat_printf (ph,
"Usage: Xchat::Internal::register(scriptname, version, desc, filename)");
} else {
name = SvPV_nolen (ST (0));
version = SvPV_nolen (ST (1));
desc = SvPV_nolen (ST (2));
filename = SvPV_nolen (ST (3));
gui_entry = xchat_plugingui_add (ph, filename, name,
desc, version, NULL);
XSRETURN_IV (PTR2IV (gui_entry));
}
}
/* Xchat::Internal::hook_server(name, priority, callback, userdata) */
static
XS (XS_Xchat_hook_server)
{
char *name;
int pri;
SV *callback;
SV *userdata;
xchat_hook *hook;
HookData *data;
dXSARGS;
if (items != 4) {
xchat_print (ph,
"Usage: Xchat::Internal::hook_server(name, priority, callback, userdata)");
} else {
name = SvPV_nolen (ST (0));
pri = (int) SvIV (ST (1));
callback = ST (2);
userdata = ST (3);
data = NULL;
data = malloc (sizeof (HookData));
if (data == NULL) {
XSRETURN_UNDEF;
}
data->callback = sv_mortalcopy (callback);
SvREFCNT_inc (data->callback);
data->userdata = sv_mortalcopy (userdata);
SvREFCNT_inc (data->userdata);
data->depth = 0;
data->package = NULL;
hook = xchat_hook_server (ph, name, pri, server_cb, data);
XSRETURN_IV (PTR2IV (hook));
}
}
static void
create_callback (GtkCellLayoutDataFunc func,
gpointer data,
GtkDestroyNotify destroy,
SV **code_return,
SV **data_return)
{
HV *stash;
SV *code_sv, *data_sv;
Gtk2PerlCellLayoutDataFunc *wrapper;
wrapper = g_new0 (Gtk2PerlCellLayoutDataFunc, 1);
wrapper->func = func;
wrapper->data = data;
wrapper->destroy = destroy;
data_sv = newSViv (PTR2IV (wrapper));
stash = gv_stashpv ("Gtk2::CellLayout::DataFunc", TRUE);
code_sv = sv_bless (newRV (data_sv), stash);
*code_return = code_sv;
*data_return = data_sv;
}
PJS_EXTERN SV *
PJS_CallPerlMethod(
pTHX_
JSContext *cx,
const char *method,
...
) {
dSP;
va_list ap;
SV *arg, *ret;
PJS_Context *pcx = PJS_GET_CONTEXT(cx);
ENTER;
SAVETMPS;
PUSHMARK(SP);
sv_setiv(save_scalar(PJS_Context_SV), PTR2IV(pcx));
va_start(ap, method);
while( (arg = va_arg(ap, SV*)) ) XPUSHs(arg);
va_end(ap);
PUTBACK;
call_method(method, G_SCALAR | G_EVAL);
ret = newSVsv(*PL_stack_sp--);
FREETMPS;
LEAVE;
if (SvTRUE(ERRSV)) {
sv_free(ret); // Don't want leaks
propagate2JS(aTHX_ pcx, NULL);
return NULL;
}
return sv_2mortal(ret);
}
static void *
create_event_common(lcb_io_opt_t cbcio, int type)
{
plcb_EVENT *cevent;
plcb_IOPROCS *async;
SV *initproc = NULL, *tmprv = NULL;
async = (plcb_IOPROCS*) cbcio->v.v0.cookie;
Newxz(cevent, 1, plcb_EVENT);
cevent->pl_event = newAV();
cevent->rv_event = newRV_noinc((SV*)cevent->pl_event);
cevent->evtype = type;
cevent->fd = -1;
sv_bless(cevent->rv_event, gv_stashpv(PLCB_EVENT_CLASS, GV_ADD));
av_store(cevent->pl_event, PLCB_EVIDX_OPAQUE, newSViv(PTR2IV(cevent)));
av_store(cevent->pl_event, PLCB_EVIDX_FD, newSViv(-1));
av_store(cevent->pl_event, PLCB_EVIDX_TYPE, newSViv(type));
av_store(cevent->pl_event, PLCB_EVIDX_WATCHFLAGS, newSViv(0));
tmprv = newRV_inc(*av_fetch(cevent->pl_event, PLCB_EVIDX_OPAQUE, 0));
sv_bless(tmprv, gv_stashpv("Couchbase::IO::_CEvent", GV_ADD));
SvREFCNT_dec(tmprv);
if (type == PLCB_EVTYPE_IO) {
initproc = async->cv_evinit;
} else {
initproc = async->cv_tminit;
}
if (initproc) {
cb_args_noret(initproc, 0, 2, async->userdata, cevent->rv_event);
}
return cevent;
}
static void perl_process_event(int cpu, void *data,
int size __unused,
unsigned long long nsecs, char *comm)
{
struct format_field *field;
static char handler[256];
unsigned long long val;
unsigned long s, ns;
struct event *event;
int type;
int pid;
dSP;
type = trace_parse_common_type(data);
event = find_cache_event(type);
if (!event)
die("ug! no event found for type %d", type);
pid = trace_parse_common_pid(data);
sprintf(handler, "%s::%s", event->system, event->name);
s = nsecs / NSECS_PER_SEC;
ns = nsecs - s * NSECS_PER_SEC;
scripting_context->event_data = data;
ENTER;
SAVETMPS;
PUSHMARK(SP);
XPUSHs(sv_2mortal(newSVpv(handler, 0)));
XPUSHs(sv_2mortal(newSViv(PTR2IV(scripting_context))));
XPUSHs(sv_2mortal(newSVuv(cpu)));
XPUSHs(sv_2mortal(newSVuv(s)));
XPUSHs(sv_2mortal(newSVuv(ns)));
XPUSHs(sv_2mortal(newSViv(pid)));
XPUSHs(sv_2mortal(newSVpv(comm, 0)));
/* common fields other than pid can be accessed via xsub fns */
for (field = event->format.fields; field; field = field->next) {
if (field->flags & FIELD_IS_STRING) {
int offset;
if (field->flags & FIELD_IS_DYNAMIC) {
offset = *(int *)(data + field->offset);
offset &= 0xffff;
} else
offset = field->offset;
XPUSHs(sv_2mortal(newSVpv((char *)data + offset, 0)));
} else { /* FIELD_IS_NUMERIC */
val = read_size(data + field->offset, field->size);
if (field->flags & FIELD_IS_SIGNED) {
XPUSHs(sv_2mortal(newSViv(val)));
} else {
XPUSHs(sv_2mortal(newSVuv(val)));
}
}
}
PUTBACK;
if (get_cv(handler, 0))
call_pv(handler, G_SCALAR);
else if (get_cv("main::trace_unhandled", 0)) {
XPUSHs(sv_2mortal(newSVpv(handler, 0)));
XPUSHs(sv_2mortal(newSViv(PTR2IV(scripting_context))));
XPUSHs(sv_2mortal(newSVuv(cpu)));
XPUSHs(sv_2mortal(newSVuv(nsecs)));
XPUSHs(sv_2mortal(newSViv(pid)));
XPUSHs(sv_2mortal(newSVpv(comm, 0)));
call_pv("main::trace_unhandled", G_SCALAR);
}
SPAGAIN;
PUTBACK;
FREETMPS;
LEAVE;
}
