Commit | Line | Data |
---|---|---|
c5be433b | 1 | #define PERL_NO_GET_CONTEXT |
77a005ab MB |
2 | #include "EXTERN.h" |
3 | #include "perl.h" | |
4 | #include "XSUB.h" | |
5 | ||
6 | static cv_flags_t | |
f0f333f4 | 7 | get_flag(char *attr) |
77a005ab MB |
8 | { |
9 | if (strnEQ(attr, "method", 6)) | |
10 | return CVf_METHOD; | |
11 | else if (strnEQ(attr, "locked", 6)) | |
12 | return CVf_LOCKED; | |
13 | else | |
14 | return 0; | |
15 | } | |
16 | ||
17 | MODULE = attrs PACKAGE = attrs | |
18 | ||
19 | void | |
c6c619a9 | 20 | import(...) |
77a005ab MB |
21 | ALIAS: |
22 | unimport = 1 | |
23 | PREINIT: | |
24 | int i; | |
77a005ab | 25 | PPCODE: |
c6c619a9 DM |
26 | if (items < 1) |
27 | Perl_croak(aTHX_ "Usage: %s(Class, ...)", GvNAME(CvGV(cv))); | |
3280af22 | 28 | if (!PL_compcv || !(cv = CvOUTSIDE(PL_compcv))) |
77a005ab | 29 | croak("can't set attributes outside a subroutine scope"); |
a98df962 GS |
30 | if (ckWARN(WARN_DEPRECATED)) |
31 | Perl_warner(aTHX_ WARN_DEPRECATED, | |
32 | "pragma \"attrs\" is deprecated, " | |
33 | "use \"sub NAME : ATTRS\" instead"); | |
77a005ab | 34 | for (i = 1; i < items; i++) { |
2d8e6c8d GS |
35 | STRLEN n_a; |
36 | char *attr = SvPV(ST(i), n_a); | |
77a005ab MB |
37 | cv_flags_t flag = get_flag(attr); |
38 | if (!flag) | |
39 | croak("invalid attribute name %s", attr); | |
40 | if (ix) | |
41 | CvFLAGS(cv) &= ~flag; | |
42 | else | |
43 | CvFLAGS(cv) |= flag; | |
44 | } | |
45 | ||
46 | void | |
47 | get(sub) | |
48 | SV * sub | |
49 | PPCODE: | |
50 | if (SvROK(sub)) { | |
51 | sub = SvRV(sub); | |
52 | if (SvTYPE(sub) != SVt_PVCV) | |
53 | sub = Nullsv; | |
54 | } | |
55 | else { | |
2d8e6c8d GS |
56 | STRLEN n_a; |
57 | char *name = SvPV(sub, n_a); | |
77a005ab MB |
58 | sub = (SV*)perl_get_cv(name, FALSE); |
59 | } | |
60 | if (!sub) | |
61 | croak("invalid subroutine reference or name"); | |
62 | if (CvFLAGS(sub) & CVf_METHOD) | |
79cb57f6 | 63 | XPUSHs(sv_2mortal(newSVpvn("method", 6))); |
77a005ab | 64 | if (CvFLAGS(sub) & CVf_LOCKED) |
79cb57f6 | 65 | XPUSHs(sv_2mortal(newSVpvn("locked", 6))); |
77a005ab | 66 |