package Callback; use 5.010000; use threads; use threads::shared; use strict; use warnings; require Exporter; use AutoLoader qw(AUTOLOAD); our @ISA = qw(Exporter); our $VERSION = '0.01'; require XSLoader; XSLoader::load('Callback', $VERSION); my $callback_ref; sub new($$) { my $invocant = shift; $callback_ref = shift; $invocant = ref $invocant if ref $invocant; my $self = &share({}); return bless $self, $invocant; } sub run($) { my $self = shift; my $param = shift; runCallback($callback_ref, $param); } 1; #### #include "EXTERN.h" #include "perl.h" #include "XSUB.h" #include "ppport.h" # define PERL_NO_GET_CONTEXT int runCallback(CV* callback_ref, const char* param) { int count; int answer; dSP; ENTER; SAVETMPS; PUSHMARK(SP); XPUSHs(sv_2mortal(newSVpv(param, 0))); PUTBACK; count = call_sv((SV*)callback_ref, G_SCALAR); SPAGAIN; if (count != 1) croak("Uncknown return value format. Returned %d params instid 1", count); answer = POPi; FREETMPS; LEAVE; return answer; } MODULE = Callback PACKAGE = Callback void runCallback(callback_ref, param) CV* callback_ref; const char* param; PROTOTYPE: $$ PPCODE: XPUSHs(sv_2mortal( newSViv(runCallback(callback_ref, param)) ));