fork::global_hook => Inline::С impl.

global_hook.pm

package fork::global_hook;

use strict;
use Inline C => <<EOF;
void find_and_call(){
    SV* sva;
    GV* method;
    HV* stash;
    char* name;
    uint cnt = 0;

    dSP;
    for (sva = PL_sv_arenaroot; sva; sva = (SV*)SvANY (sva)) {
        register const SV * const svend = &sva[SvREFCNT (sva)];
        SV* svi;
        for (svi = sva + 1; svi < svend; ++svi) {
            if (SvTYPE (svi) != SVTYPEMASK && SvREFCNT (svi))
            {
                cnt++;
                if(SvOBJECT (svi)){
                    stash = SvSTASH (svi);
                    if(method = gv_fetchmethod_autoload (stash, "AFTER_FORK_OBJ", 0)){
                        ENTER; SAVETMPS; PUSHMARK (SP);
                        XPUSHs (sv_2mortal (newRV_inc (svi)));
                        PUTBACK;
                        call_sv ((SV*)GvCV (method), G_DISCARD|G_VOID);
                        FREETMPS; LEAVE;
                    }
                }
                else if( SvTYPE (svi) == SVt_PVHV){
                    if(name = HvNAME ((HV*)svi)){
                        if(method = gv_fetchmethod_autoload ((HV*)svi, "AFTER_FORK", 0)){
                            PUSHMARK (SP);
                            call_sv ((SV*)GvCV (method), G_DISCARD|G_NOARGS|G_VOID);
                        }
                    }
                }
            }
        }
    }
    printf("SV count: %i\\n", cnt);
}
EOF

BEGIN {
    *CORE::GLOBAL::fork = sub() {
        my $ret = CORE::fork;
        if ( defined($ret) && $ret == 0 ) {
            find_and_call;
        }
        return $ret;
    };
}