Scalar-Watcher

 view release on metacpan or  search on metacpan

Watcher.xs  view on Meta::CPAN

        call_sv(handler, G_VOID | G_DISCARD);
    }

    return 0;
}

static MGVTBL modified_vtbl = {
    0, watcher_handler, 0, 0, 0
};
static MGVTBL destroyed_vtbl = {
    0, 0, 0, 0, watcher_handler
};

static int canceller_handler(pTHX_ SV * canceller, MAGIC * mg){
    SV * target = SvRV(canceller);
    if( SvOK(target) ){
        MAGIC * target_mg = SvMAGIC(target);
        SV * handler_cv = (SV*) mg->mg_ptr;
        while( target_mg ){
            if( target_mg->mg_type==PERL_MAGIC_ext && target_mg->mg_obj == handler_cv ){
#ifdef SvREFCNT_dec_NN
                SvREFCNT_dec_NN(handler_cv);
#else
                SvREFCNT_dec(handler_cv);
#endif
                target_mg->mg_flags &= ~MGf_REFCOUNTED;
                target_mg->mg_obj = NULL;
            }
            target_mg = target_mg->mg_moremagic;
        }
    }
    return 0;
}

static MGVTBL canceller_vtbl = {
    0, 0, 0, 0, canceller_handler
};

void hook_watcher_magic(pTHX_ SV * target, SV * handler, MGVTBL * vtbl){
    dSP;
    SV * handler_cv = extract_cv(aTHX_ handler);
    SvUPGRADE(target, SVt_PVMG);
    sv_magicext(target, handler_cv, PERL_MAGIC_ext, vtbl, NULL, 0);

    if( GIMME_V!=G_VOID ){
        SV * canceller = newRV_inc(target);
        sv_rvweaken(canceller);
        sv_magicext(canceller, NULL, PERL_MAGIC_ext, &canceller_vtbl, (char *)handler_cv, 0);
        PUSHs(sv_2mortal(newRV_noinc(canceller)));
        PUTBACK;
    }
}

MODULE = Scalar::Watcher		PACKAGE = Scalar::Watcher		

INCLUDE: const-xs.inc

void
when_modified(SV * target, SV * handler)
    PROTOTYPE: $&
    PPCODE:
        hook_watcher_magic(aTHX_ target, handler, &modified_vtbl);
        SPAGAIN;

void
when_destroyed(SV * target, SV * handler)
    PROTOTYPE: $&
    PPCODE:
        hook_watcher_magic(aTHX_ target, handler, &destroyed_vtbl);
        SPAGAIN;



( run in 1.110 second using v1.01-cache-2.11-cpan-5511b514fd6 )