summaryrefslogtreecommitdiff
path: root/xs/Moose.xs
blob: 22686cd4d0c4b844359321d45c06d17e9d65a5f9 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include "ppport.h"
#include "mop.h"

#ifndef MGf_COPY
# define MGf_COPY 0
#endif

#ifndef MGf_DUP
# define MGf_DUP 0
#endif

#ifndef MGf_LOCAL
# define MGf_LOCAL 0
#endif

STATIC int unset_export_flag (pTHX_ SV *sv, MAGIC *mg);

STATIC MGVTBL export_flag_vtbl = {
    NULL, /* get */
    unset_export_flag, /* set */
    NULL, /* len */
    NULL, /* clear */
    NULL, /* free */
#if MGf_COPY
    NULL, /* copy */
#endif
#if MGf_DUP
    NULL, /* dup */
#endif
#if MGf_LOCAL
    NULL, /* local */
#endif
};

STATIC bool
export_flag_is_set (pTHX_ SV *sv)
{
    MAGIC *mg, *moremagic;

    if (SvTYPE(SvRV(sv)) != SVt_PVGV) {
        return 0;
    }

    for (mg = SvMAGIC(SvRV(sv)); mg; mg = moremagic) {
        moremagic = mg->mg_moremagic;

        if (mg->mg_type == PERL_MAGIC_ext && mg->mg_virtual == &export_flag_vtbl) {
            break;
        }
    }

    return !!mg;
}

STATIC int
unset_export_flag (pTHX_ SV *sv, MAGIC *mymg)
{
    MAGIC *mg, *prevmagic = NULL, *moremagic = NULL;

    for (mg = SvMAGIC(sv); mg; prevmagic = mg, mg = moremagic) {
        moremagic = mg->mg_moremagic;

        if (mg == mymg) {
            break;
        }
    }

    if (!mg) {
        return 0;
    }

    if (prevmagic) {
        prevmagic->mg_moremagic = moremagic;
    }
    else {
        SvMAGIC_set(sv, moremagic);
    }

    mg->mg_moremagic = NULL;

    Safefree (mg);

    return 0;
}

#ifndef SvRXOK
/* SvRXOK appeared before SVt_REGEXP did, so this implementation assumes magic
 * based qr//. Note re::is_regexp isn't in 5.8, hence the need for this XS.
 */
#define SvRXOK(sv) is_regexp(aTHX_ sv)

STATIC int
is_regexp (pTHX_ SV* sv) {
    SV* tmpsv;

    if (SvMAGICAL(sv)) {
        mg_get(sv);
    }

    if (SvROK(sv) &&
        (tmpsv = (SV*) SvRV(sv)) &&
        SvTYPE(tmpsv) == SVt_PVMG &&
        (mg_find(tmpsv, PERL_MAGIC_qr))) {
        return TRUE;
    }

    return FALSE;
}
#endif

XS_EXTERNAL(boot_Class__MOP);
XS_EXTERNAL(boot_Class__MOP__Mixin__HasAttributes);
XS_EXTERNAL(boot_Class__MOP__Mixin__HasMethods);
XS_EXTERNAL(boot_Class__MOP__Package);
XS_EXTERNAL(boot_Class__MOP__Mixin__AttributeCore);
XS_EXTERNAL(boot_Class__MOP__Method);
XS_EXTERNAL(boot_Class__MOP__Method__Inlined);
XS_EXTERNAL(boot_Class__MOP__Method__Generated);
XS_EXTERNAL(boot_Class__MOP__Class);
XS_EXTERNAL(boot_Class__MOP__Attribute);
XS_EXTERNAL(boot_Class__MOP__Instance);
XS_EXTERNAL(boot_Moose__Meta__Role__Application__ToInstance);

MODULE = Moose  PACKAGE = Moose::Exporter

PROTOTYPES: DISABLE

BOOT:
    mop_prehash_keys();

    MOP_CALL_BOOT (boot_Class__MOP);
    MOP_CALL_BOOT (boot_Class__MOP__Mixin__HasAttributes);
    MOP_CALL_BOOT (boot_Class__MOP__Mixin__HasMethods);
    MOP_CALL_BOOT (boot_Class__MOP__Package);
    MOP_CALL_BOOT (boot_Class__MOP__Mixin__AttributeCore);
    MOP_CALL_BOOT (boot_Class__MOP__Method);
    MOP_CALL_BOOT (boot_Class__MOP__Method__Inlined);
    MOP_CALL_BOOT (boot_Class__MOP__Method__Generated);
    MOP_CALL_BOOT (boot_Class__MOP__Class);
    MOP_CALL_BOOT (boot_Class__MOP__Attribute);
    MOP_CALL_BOOT (boot_Class__MOP__Instance);
    MOP_CALL_BOOT (boot_Moose__Meta__Role__Application__ToInstance);

void
_flag_as_reexport (SV *sv)
    CODE:
        sv_magicext(SvRV(sv), NULL, PERL_MAGIC_ext, &export_flag_vtbl, NULL, 0);

bool
_export_is_flagged (SV *sv)
    CODE:
        RETVAL = export_flag_is_set(aTHX_ sv);
    OUTPUT:
        RETVAL

MODULE = Moose  PACKAGE = Moose::Util::TypeConstraints::Builtins

bool
_RegexpRef (SV *sv=NULL)
    INIT:
        if (!items) {
            sv = DEFSV;
        }
    CODE:
        RETVAL = SvRXOK(sv);
    OUTPUT:
        RETVAL