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