diff options
Diffstat (limited to 'contrib/perl5/ext/attrs/attrs.xs')
-rw-r--r-- | contrib/perl5/ext/attrs/attrs.xs | 66 |
1 files changed, 0 insertions, 66 deletions
diff --git a/contrib/perl5/ext/attrs/attrs.xs b/contrib/perl5/ext/attrs/attrs.xs deleted file mode 100644 index 4c00cd7..0000000 --- a/contrib/perl5/ext/attrs/attrs.xs +++ /dev/null @@ -1,66 +0,0 @@ -#define PERL_NO_GET_CONTEXT -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" - -static cv_flags_t -get_flag(char *attr) -{ - if (strnEQ(attr, "method", 6)) - return CVf_METHOD; - else if (strnEQ(attr, "locked", 6)) - return CVf_LOCKED; - else - return 0; -} - -MODULE = attrs PACKAGE = attrs - -void -import(Class, ...) -char * Class - ALIAS: - unimport = 1 - PREINIT: - int i; - CV *cv; - PPCODE: - if (!PL_compcv || !(cv = CvOUTSIDE(PL_compcv))) - croak("can't set attributes outside a subroutine scope"); - if (ckWARN(WARN_DEPRECATED)) - Perl_warner(aTHX_ WARN_DEPRECATED, - "pragma \"attrs\" is deprecated, " - "use \"sub NAME : ATTRS\" instead"); - for (i = 1; i < items; i++) { - STRLEN n_a; - char *attr = SvPV(ST(i), n_a); - cv_flags_t flag = get_flag(attr); - if (!flag) - croak("invalid attribute name %s", attr); - if (ix) - CvFLAGS(cv) &= ~flag; - else - CvFLAGS(cv) |= flag; - } - -void -get(sub) -SV * sub - PPCODE: - if (SvROK(sub)) { - sub = SvRV(sub); - if (SvTYPE(sub) != SVt_PVCV) - sub = Nullsv; - } - else { - STRLEN n_a; - char *name = SvPV(sub, n_a); - sub = (SV*)perl_get_cv(name, FALSE); - } - if (!sub) - croak("invalid subroutine reference or name"); - if (CvFLAGS(sub) & CVf_METHOD) - XPUSHs(sv_2mortal(newSVpvn("method", 6))); - if (CvFLAGS(sub) & CVf_LOCKED) - XPUSHs(sv_2mortal(newSVpvn("locked", 6))); - |