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