1 #define PERL_NO_GET_CONTEXT
7 get_flag(const char *attr)
9 if (strnEQ(attr, "method", 6))
11 else if (strnEQ(attr, "locked", 6))
17 MODULE = attrs PACKAGE = attrs
27 Perl_croak(aTHX_ "Usage: %s(Class, ...)", GvNAME(CvGV(cv)));
28 if (!PL_compcv || !(cv = CvOUTSIDE(PL_compcv)))
29 croak("can't set attributes outside a subroutine scope");
30 if (ckWARN(WARN_DEPRECATED))
31 Perl_warner(aTHX_ packWARN(WARN_DEPRECATED),
32 "pragma \"attrs\" is deprecated, "
33 "use \"sub NAME : ATTRS\" instead");
34 for (i = 1; i < items; i++) {
35 const char * const attr = SvPV_nolen(ST(i));
36 const cv_flags_t flag = get_flag(attr);
38 croak("invalid attribute name %s", attr);
51 if (SvTYPE(sub) != SVt_PVCV)
55 const char * const name = SvPV_nolen(sub);
56 sub = (SV*)perl_get_cv(name, FALSE);
59 croak("invalid subroutine reference or name");
60 if (CvFLAGS(sub) & CVf_METHOD)
61 XPUSHs(sv_2mortal(newSVpvn("method", 6)));
62 if (CvFLAGS(sub) & CVf_LOCKED)
63 XPUSHs(sv_2mortal(newSVpvn("locked", 6)));