Ref-Watch-0.01/0000755000175000006270000000000011117676711012160 5ustar cubiccubicRef-Watch-0.01/t/0000755000175000006270000000000011117676711012423 5ustar cubiccubicRef-Watch-0.01/t/basics.t0000644000175000006270000000052711117670767014065 0ustar cubiccubicuse strict; use warnings; use Test::More tests => 1; # last test to print use Ref::Watch; my $a = bless {}, 'Foo'; watch_ref( $a, sub { Test::More::diag("inc $_[1] => $_[0]\n") }, sub { Test::More::diag("dec $_[1] => $_[0]\n") } ); sub test { my $obj = shift; return $obj; } test($a); my $b = $a; ok(1); Ref-Watch-0.01/MANIFEST0000644000175000006270000000023611117676711013312 0ustar cubiccubiclib/Ref/Watch.pm Makefile.PL MANIFEST This list of files t/basics.t Watch.xs META.yml Module meta-data (added by MakeMaker) Ref-Watch-0.01/lib/0000755000175000006270000000000011117676711012726 5ustar cubiccubicRef-Watch-0.01/lib/Ref/0000755000175000006270000000000011117676711013442 5ustar cubiccubicRef-Watch-0.01/lib/Ref/Watch.pm0000644000175000006270000000032711117663043015042 0ustar cubiccubic use 5.008008; use strict; use warnings; package Ref::Watch; our $VERSION = '0.01'; use XSLoader; XSLoader::load( __PACKAGE__, $VERSION ); use base qw(Exporter); our @EXPORT = qw(watch_ref); init_watcher(); 1; Ref-Watch-0.01/Watch.xs0000644000175000006270000000452611117671322013602 0ustar cubiccubic#ifndef WIN32 #define PERL_NO_GET_CONTEXT /* we want efficiency */ #endif #include "EXTERN.h" #include "perl.h" #include "XSUB.h" typedef OP * (CPERLscope(*orig_ppaddr_t))(pTHX); orig_ppaddr_t *PL_ppaddr_orig; #define run_original_op(type) CALL_FPTR(PL_ppaddr_orig[type])(aTHX) typedef struct entry { U32 old; SV* weak; SV* inc_cb; SV* dec_cb; } entry; entry watched[10]; static void callback( SV* cb, U32 new, U32 old ) { dSP; PUSHMARK(SP); XPUSHs(sv_2mortal(newSViv(new))); XPUSHs(sv_2mortal(newSViv(old))); PUTBACK; call_sv(cb, G_DISCARD); } static void do_our_job() { int i; U32 new, old; i = 0; if ( 1 ) { if (!watched[i].weak) return; if(!SvROK(watched[i].weak)) croak("first argument must be a reference"); old = watched[i].old; watched[i].old = new = SvREFCNT(SvRV(watched[i].weak)); if ( new > old && watched[i].inc_cb != NULL ) { printf("inc old %u => new %u\n", old, new); callback(watched[i].inc_cb, new, old); } else if ( new < old && watched[i].dec_cb != NULL ) { printf("dec old %u => new %u\n", old, new); callback(watched[i].dec_cb, new, old); } printf("done\n"); } } static OP * pp_stmt_checker(pTHX) /* handles OP_DBSTATE, OP_SETSTATE, etc */ { OP *op = run_original_op(PL_op->op_type); do_our_job(); return op; } static int init_watcher(pTHX) { memset(watched, 0, 10*sizeof(entry)); /* redirect opcodes for statement profiling */ Newxc(PL_ppaddr_orig, OP_max, void *, orig_ppaddr_t); Copy(PL_ppaddr, PL_ppaddr_orig, OP_max, void *); PL_ppaddr[OP_NEXTSTATE] = pp_stmt_checker; // PL_ppaddr[OP_DBSTATE] = pp_stmt_checker; // PL_ppaddr[OP_SETSTATE] = pp_stmt_checker; } MODULE = Ref::Watch PACKAGE = Ref::Watch PROTOTYPES: DISABLE int init_watcher() C_ARGS: aTHX void watch_ref(ref,inc_cb=NULL,dec_cb=NULL) SV* ref; SV* inc_cb; SV* dec_cb; PREINIT: entry tmp; CODE: if(!SvROK(ref)) croak("first argument must be a reference"); tmp.weak = sv_rvweaken(newSVsv(ref)); tmp.inc_cb = newSVsv(inc_cb); tmp.dec_cb = newSVsv(dec_cb); tmp.old = SvREFCNT(SvRV(tmp.weak)); watched[0] = tmp; Ref-Watch-0.01/Makefile.PL0000644000175000006270000000044411117663262014131 0ustar cubiccubicuse 5.008008; use ExtUtils::MakeMaker; WriteMakefile( NAME => 'Ref::Watch', AUTHOR => 'Ruslan U. Zakirov ', VERSION_FROM => 'lib/Ref/Watch.pm', ABSTRACT_FROM => 'lib/Ref/Watch.pm', LICENSE => 'perl', ); Ref-Watch-0.01/META.yml0000644000175000006270000000072311117676711013433 0ustar cubiccubic--- #YAML:1.0 name: Ref-Watch version: 0.01 abstract: ~ author: - Ruslan U. Zakirov license: perl distribution_type: module configure_requires: ExtUtils::MakeMaker: 0 requires: {} no_index: directory: - t - inc generated_by: ExtUtils::MakeMaker version 6.48 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4