Don't turn hash into array when copying the old hash value
[gitmo/Moose.git] / Moose.xs
1 #include "EXTERN.h"
2 #include "perl.h"
3 #include "XSUB.h"
4 #include "ppport.h"
5
6 #ifndef MGf_COPY
7 # define MGf_COPY 0
8 #endif
9
10 #ifndef MGf_DUP
11 # define MGf_DUP 0
12 #endif
13
14 #ifndef MGf_LOCAL
15 # define MGf_LOCAL 0
16 #endif
17
18 STATIC int unset_export_flag (pTHX_ SV *sv, MAGIC *mg);
19
20 STATIC MGVTBL export_flag_vtbl = {
21     NULL, /* get */
22     unset_export_flag, /* set */
23     NULL, /* len */
24     NULL, /* clear */
25     NULL, /* free */
26 #if MGf_COPY
27     NULL, /* copy */
28 #endif
29 #if MGf_DUP
30     NULL, /* dup */
31 #endif
32 #if MGf_LOCAL
33     NULL, /* local */
34 #endif
35 };
36
37 STATIC bool
38 export_flag_is_set (pTHX_ SV *sv)
39 {
40     MAGIC *mg, *moremagic;
41
42     if (SvTYPE(SvRV(sv)) != SVt_PVGV) {
43         return 0;
44     }
45
46     for (mg = SvMAGIC(SvRV(sv)); mg; mg = moremagic) {
47         moremagic = mg->mg_moremagic;
48
49         if (mg->mg_type == PERL_MAGIC_ext && mg->mg_virtual == &export_flag_vtbl) {
50             break;
51         }
52     }
53
54     return !!mg;
55 }
56
57 STATIC int
58 unset_export_flag (pTHX_ SV *sv, MAGIC *mymg)
59 {
60     MAGIC *mg, *prevmagic = NULL, *moremagic = NULL;
61
62     for (mg = SvMAGIC(sv); mg; prevmagic = mg, mg = moremagic) {
63         moremagic = mg->mg_moremagic;
64
65         if (mg == mymg) {
66             break;
67         }
68     }
69
70     if (!mg) {
71         return 0;
72     }
73
74     if (prevmagic) {
75         prevmagic->mg_moremagic = moremagic;
76     }
77     else {
78         SvMAGIC_set(sv, moremagic);
79     }
80
81     mg->mg_moremagic = NULL;
82
83     Safefree (mg);
84
85     return 0;
86 }
87
88 MODULE = Moose  PACKAGE = Moose::Exporter
89
90 void
91 _flag_as_reexport (SV *sv)
92     PROTOTYPE: \*
93     CODE:
94         sv_magicext(SvRV(sv), NULL, PERL_MAGIC_ext, &export_flag_vtbl, NULL, 0);
95
96 bool
97 _export_is_flagged (SV *sv)
98     PROTOTYPE: \*
99     CODE:
100         RETVAL = export_flag_is_set(aTHX_ sv);
101     OUTPUT:
102         RETVAL