Commit | Line | Data |
8fa582b1 |
1 | #include "EXTERN.h" |
2 | #include "perl.h" |
3 | #include "XSUB.h" |
4 | #include "ppport.h" |
5 | |
6 | STATIC int unset_export_flag (pTHX_ SV *sv, MAGIC *mg); |
7 | |
8 | STATIC MGVTBL export_flag_vtbl = { |
9 | NULL, /* get */ |
10 | unset_export_flag, /* set */ |
11 | NULL, /* len */ |
12 | NULL, /* clear */ |
13 | NULL, /* free */ |
14 | NULL, /* copy */ |
15 | NULL, /* dup */ |
16 | NULL, /* local */ |
17 | }; |
18 | |
19 | STATIC bool |
20 | export_flag_is_set (pTHX_ SV *sv) |
21 | { |
22 | MAGIC *mg, *moremagic; |
23 | |
24 | if (SvTYPE(SvRV(sv)) != SVt_PVGV) { |
25 | return 0; |
26 | } |
27 | |
28 | for (mg = SvMAGIC(SvRV(sv)); mg; mg = moremagic) { |
29 | moremagic = mg->mg_moremagic; |
30 | |
31 | if (mg->mg_type == PERL_MAGIC_ext && mg->mg_virtual == &export_flag_vtbl) { |
32 | break; |
33 | } |
34 | } |
35 | |
36 | return !!mg; |
37 | } |
38 | |
39 | STATIC int |
40 | unset_export_flag (pTHX_ SV *sv, MAGIC *mymg) |
41 | { |
42 | MAGIC *mg, *prevmagic = NULL, *moremagic = NULL; |
43 | |
44 | for (mg = SvMAGIC(sv); mg; prevmagic = mg, mg = moremagic) { |
45 | moremagic = mg->mg_moremagic; |
46 | |
47 | if (mg == mymg) { |
48 | break; |
49 | } |
50 | } |
51 | |
52 | if (!mg) { |
53 | return 0; |
54 | } |
55 | |
56 | if (prevmagic) { |
57 | prevmagic->mg_moremagic = moremagic; |
58 | } |
59 | else { |
60 | SvMAGIC_set(sv, moremagic); |
61 | } |
62 | |
63 | mg->mg_moremagic = NULL; |
64 | |
65 | Safefree (mg); |
66 | |
67 | return 0; |
68 | } |
69 | |
70 | MODULE = Moose PACKAGE = Moose::Exporter |
71 | |
72 | void |
73 | _flag_as_reexport (SV *sv) |
74 | PROTOTYPE: \* |
75 | CODE: |
76 | sv_magicext(SvRV(sv), NULL, PERL_MAGIC_ext, &export_flag_vtbl, NULL, 0); |
77 | |
78 | bool |
79 | _export_is_flagged (SV *sv) |
80 | PROTOTYPE: \* |
81 | CODE: |
82 | RETVAL = export_flag_is_set(aTHX_ sv); |
83 | OUTPUT: |
84 | RETVAL |