This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
929a237e658dfe60e2ed2808d0986578ee8e960b
[perl5.git] / ext / File-DosGlob / DosGlob.xs
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     dMY_CXT;
20     if (!MY_CXT.x_DG_ENTRIES)
21         MY_CXT.x_DG_ENTRIES = get_hv("File::DosGlob::entries", 0);
22     if (MY_CXT.x_DG_ENTRIES)
23         hv_delete(MY_CXT.x_DG_ENTRIES, (char *)&o, sizeof(OP *),G_DISCARD);
24     if (MY_CXT.x_DG_OLD_OPHOOK) MY_CXT.x_DG_OLD_OPHOOK(aTHX_ o);
25 }
26
27 MODULE = File::DosGlob          PACKAGE = File::DosGlob
28
29 PROTOTYPES: DISABLE
30
31 BOOT:
32 {
33     MY_CXT_INIT;
34     {
35         dMY_CXT;
36         MY_CXT.x_DG_ENTRIES = NULL;
37         MY_CXT.x_DG_OLD_OPHOOK = PL_opfreehook;
38         PL_opfreehook = glob_ophook;
39     }
40 }
41
42 SV *
43 _callsite(...)
44     CODE:
45         RETVAL = newSVpvn(
46                    (char *)&cxstack[cxstack_ix].blk_sub.retop, sizeof(OP *)
47                  );
48     OUTPUT:
49         RETVAL