1 #include "EXTERN.h" 2 #include "perl.h" 3 #include "XSUB.h" 4 5 #ifndef PadARRAY 6 typedef AV PADNAMELIST; 7 typedef SV PADNAME; 8 # if PERL_VERSION < 8 || (PERL_VERSION == 8 && !PERL_SUBVERSION) 9 typedef AV PAD; 10 # endif 11 # define PadlistARRAY(pl) ((PAD **)AvARRAY(pl)) 12 # define PadlistNAMES(pl) (*PadlistARRAY(pl)) 13 # define PadnamelistARRAY(pnl) ((PADNAME **)AvARRAY(pnl)) 14 # define PadnamelistMAX(pnl) AvFILLp(pnl) 15 # define PadARRAY AvARRAY 16 # define PadnamePV(pn) (SvPOKp(pn) ? SvPVX(pn) : NULL) 17 #endif 18 19 20 21 /* cargo-culted from PadWalker */ 22 23 MODULE = Devel::LexAlias PACKAGE = Devel::LexAlias 24 25 void _lexalias(SV * cv_ref,char * name,SV * new_rv)26_lexalias(SV* cv_ref, char *name, SV* new_rv) 27 CODE: 28 { 29 CV* cv = SvROK(cv_ref) ? (CV*) SvRV(cv_ref) : NULL; 30 PADNAMELIST* padn = cv ? PadlistNAMES(CvPADLIST(cv)) : PL_comppad_name; 31 PAD* padv = cv ? PadlistARRAY(CvPADLIST(cv))[1] : PL_comppad; 32 SV* new_sv; 33 I32 i; 34 35 if (!SvROK(new_rv)) croak("ref is not a reference"); 36 new_sv = SvRV(new_rv); 37 38 for (i = 0; i <= PadnamelistMAX(padn); ++i) { 39 PADNAME* namesv = PadnamelistARRAY(padn)[i]; 40 char* name_str; 41 if (namesv && (name_str = PadnamePV(namesv))) { 42 if (!strcmp(name, name_str)) { 43 SvREFCNT_dec(PadARRAY(padv)[i]); 44 PadARRAY(padv)[i] = new_sv; 45 SvREFCNT_inc(new_sv); 46 SvPADMY_on(new_sv); 47 } 48 } 49 } 50 } 51