1 #define PERL_NO_GET_CONTEXT
2 
3 #include "EXTERN.h"
4 #include "perl.h"
5 #include "XSUB.h"
6 
7 #define MY_CXT_KEY "File::Glob::_guts" XS_VERSION
8 
9 typedef struct {
10     HV *		x_DG_ENTRIES;
11     Perl_ophook_t	x_DG_OLD_OPHOOK;
12 } my_cxt_t;
13 
14 START_MY_CXT
15 
16 static void
17 glob_ophook(pTHX_ OP *o)
18 {
19   if (PL_dirty) return;
20   {
21     dMY_CXT;
22     if (!MY_CXT.x_DG_ENTRIES)
23 	MY_CXT.x_DG_ENTRIES = get_hv("File::DosGlob::entries", 0);
24     if (MY_CXT.x_DG_ENTRIES)
25 	(void)hv_delete(MY_CXT.x_DG_ENTRIES, (char *)&o, sizeof(OP *),G_DISCARD);
26     if (MY_CXT.x_DG_OLD_OPHOOK) MY_CXT.x_DG_OLD_OPHOOK(aTHX_ o);
27   }
28 }
29 
30 MODULE = File::DosGlob		PACKAGE = File::DosGlob
31 
32 PROTOTYPES: DISABLE
33 
34 BOOT:
35 {
36     MY_CXT_INIT;
37     {
38 	dMY_CXT;
39 	MY_CXT.x_DG_ENTRIES = NULL;
40 	MY_CXT.x_DG_OLD_OPHOOK = PL_opfreehook;
41 	PL_opfreehook = glob_ophook;
42     }
43 }
44 
45 SV *
46 _callsite(...)
47     CODE:
48         PERL_UNUSED_VAR(items);
49 	RETVAL = newSVpvn(
50 		   (char *)&cxstack[cxstack_ix].blk_sub.retop, sizeof(OP *)
51 		 );
52     OUTPUT:
53 	RETVAL
54