Beefy Boxes and Bandwidth Generously Provided by pair Networks DiBona
The stupid question is the question not asked
 
PerlMonks  

Establishing a Subroutine Chain of Custody

by Ovid (Cardinal)
on Jun 20, 2008 at 10:40 UTC ( #693121=perlquestion: print w/ replies, xml ) Need Help??
Ovid has asked for the wisdom of the Perl Monks concerning the following question:

Hi all. Nasty little problem in trying to figure out where a subroutine has come from.

Imagine that you have package 'A' which has a sub named 'foo'. It exports that subroutine to 'B'. It's easy enough, once in 'B', to figure out where 'foo' came from. If you get really confused, you can use &Sub::Identify::stash_name to determine the original package the sub was declared in. However, let's say that you're deep down in the guts of package 'G' and you discover that &A::foo is in your namespace, but you don't know how it got there and the twisty little maze of packages makes it hard to figure out.

Is there some way (I can't think of one offhand) of establishing a "chain of custody" for a subroutine so you can figure out how it got into your target package? I'm thinking that maybe coderefs in @INC might help, but I'm stumped (I'll probably fall back to a brute force binary search through packages, but I'd rather not).

Update: Backstory is that a particular package is calling $self->some_method($foo); and it inherits from Class::Accessor. The latter internally calls $self->set( 'some_method', $foo );, but that &set is &Test::Deep::set and I've no idea how it got there.

Cheers,
Ovid

New address of my CGI Course.

Comment on Establishing a Subroutine Chain of Custody
Re: Establishing a Subroutine Chain of Custody
by jettero (Monsignor) on Jun 20, 2008 at 10:48 UTC
    I think about the best you can get is finding all the namespaces that have the sub (by that name). But if you look at the source for constant, you'll see that it exports a sub into your namespace without naming it in the constant namespace...

    Since it does this without ever calling any magic subs, that is, it's just using a package glob-hash thingy (that people usually call a symbol table), there's nothing to overload, and likely no way to trap it. I mean... unless you tie the symbol table hash. I wonder if you can do that without breaking perl completely.

    -Paul

Re: Establishing a Subroutine Chain of Custody
by Anonymous Monk on Jun 20, 2008 at 11:08 UTC
    yes, add a subroutine in @INC, and interrogate the namespace you're interested in every time before/after loading a module for changes

    On the other hand, grep the source

    lib/Test/Deep.pm 33:@EXPORT = qw( eq_deeply cmp_deeply cmp_set cmp_bag cmp_methods 34: useclass noclass set bag subbagof superbagof subsetof superset +of 165: # this allows Set and Bag to handle circular refs 429:sub set
Re: Establishing a Subroutine Chain of Custody
by Anonymous Monk on Jun 20, 2008 at 11:17 UTC
    Looks like you could use B::Xref ( note
    C:/Perl/lib/constant.pm (definitions) 103 main & PI + subdef C:/Perl/lib/constant.pm (definitions) 103 main & DEBUG + subdef
    C:\>cat test.pl use constant PI => 4 * atan2(1, 1); use constant DEBUG => 0; print "Hello", PI,$/; print "Hello", DEBUG,$/; C:\>perl -MO=Xref,-r test.pl C:/Perl/lib/constant.pm (definitions) 113 constant & import + subdef test.pl (definitions) 0 Regexp & DESTROY + subdef test.pl (definitions) 0 UNIVERSAL & isa + subdef test.pl (definitions) 0 UNIVERSAL & VERSION + subdef test.pl (definitions) 0 UNIVERSAL & can + subdef test.pl (definitions) 0 Internals & SvREFCNT + subdef test.pl (definitions) 0 Internals & hv_clear_placeh +olders subdef test.pl (definitions) 0 Internals & hash_seed + subdef test.pl (definitions) 0 Internals & SvREADONLY + subdef test.pl (definitions) 0 Internals & HvREHASH + subdef test.pl (definitions) 0 Internals & rehash_seed + subdef C:/Perl/lib/constant.pm (definitions) 103 main & DEBUG + subdef test.pl (definitions) 0 Win32 & GetCwd + subdef test.pl (definitions) 0 Win32 & GetShortPathNam +e subdef test.pl (definitions) 0 Win32 & GetOSVersion + subdef test.pl (definitions) 0 Win32 & SetLastError + subdef test.pl (definitions) 0 Win32 & SetChildShowWin +dow subdef test.pl (definitions) 0 Win32 & Sleep + subdef test.pl (definitions) 0 Win32 & FormatMessage + subdef test.pl (definitions) 0 Win32 & GetFullPathName + subdef test.pl (definitions) 0 Win32 & SetCwd + subdef test.pl (definitions) 0 Win32 & GetTickCount + subdef test.pl (definitions) 0 Win32 & IsWinNT + subdef test.pl (definitions) 0 Win32 & GetLastError + subdef test.pl (definitions) 0 Win32 & CopyFile + subdef test.pl (definitions) 0 Win32 & NodeName + subdef test.pl (definitions) 0 Win32 & GetLongPathName + subdef test.pl (definitions) 0 Win32 & GetNextAvailDri +ve subdef test.pl (definitions) 0 Win32 & FsType + subdef test.pl (definitions) 0 Win32 & IsWin95 + subdef test.pl (definitions) 0 Win32 & Spawn + subdef test.pl (definitions) 0 Win32 & BuildNumber + subdef test.pl (definitions) 0 Win32 & DomainName + subdef test.pl (definitions) 0 Win32 & LoginName + subdef test.pl (definitions) 0 PerlIO & get_layers + subdef C:/Perl/lib/constant.pm (definitions) 103 main & PI + subdef test.pl (main) 5 main $ / + used test.pl (main) 6 main $ / + used C:/Perl/lib/constant.pm constant::import 29 main @ _ + used C:/Perl/lib/constant.pm constant::import 29 (lexical) $ class + intro C:/Perl/lib/constant.pm constant::import 30 main @ _ + used C:/Perl/lib/constant.pm constant::import 31 (lexical) % const +ants intro C:/Perl/lib/constant.pm constant::import 32 (lexical) $ multi +ple intro C:/Perl/lib/constant.pm constant::import 34 (lexical) $ multi +ple used C:/Perl/lib/constant.pm constant::import 37 main @ _ + used C:/Perl/lib/constant.pm constant::import 37 Carp & croak + subused C:/Perl/lib/constant.pm constant::import 39 main @ _ + used C:/Perl/lib/constant.pm constant::import 39 main %@ _ + used C:/Perl/lib/constant.pm constant::import 39 (lexical) % const +ants used C:/Perl/lib/constant.pm constant::import 44 (lexical) % const +ants used C:/Perl/lib/constant.pm constant::import 45 (lexical) $ name + used C:/Perl/lib/constant.pm constant::import 47 Carp & croak + subused C:/Perl/lib/constant.pm constant::import 49 (lexical) $ pkg + intro C:/Perl/lib/constant.pm constant::import 52 (lexical) $ name + used C:/Perl/lib/constant.pm constant::import 52 (lexical) % forbi +dden used C:/Perl/lib/constant.pm constant::import 52 (lexical) $ name + used C:/Perl/lib/constant.pm constant::import 95 (lexical) $ pkg + used C:/Perl/lib/constant.pm constant::import 95 (lexical) $ name + used C:/Perl/lib/constant.pm constant::import 95 (lexical) $ full_ +name intro C:/Perl/lib/constant.pm constant::import 96 constant % decla +red used C:/Perl/lib/constant.pm constant::import 96 (lexical) $ full_ +name used C:/Perl/lib/constant.pm constant::import 97 (lexical) $ multi +ple used C:/Perl/lib/constant.pm constant::import 98 (lexical) % const +ants used C:/Perl/lib/constant.pm constant::import 98 (lexical) $ name + used C:/Perl/lib/constant.pm constant::import 98 (lexical) $ scala +r intro C:/Perl/lib/constant.pm constant::import 99 (lexical) $ full_ +name used C:/Perl/lib/constant.pm constant::import 99 (lexical) *$ full_ +name used C:/Perl/lib/constant.pm constant::import 101 main @ _ + used C:/Perl/lib/constant.pm constant::import 102 (lexical) $ scala +r intro C:/Perl/lib/constant.pm constant::import 103 (lexical) *$ full_ +name used C:/Perl/lib/constant.pm constant::import 103 (lexical) **$ full_ +name used C:/Perl/lib/constant.pm constant::import 103 main @ _ + used C:/Perl/lib/constant.pm constant::import 105 main @ _ + used C:/Perl/lib/constant.pm constant::import 105 (lexical) @ list + intro C:/Perl/lib/constant.pm constant::import 106 (lexical) **$ full_ +name used C:/Perl/lib/constant.pm constant::import 106 (lexical) ***$ full_ +name used C:/Perl/lib/constant.pm constant::import 108 (lexical) ***$ full_ +name used C:/Perl/lib/constant.pm constant::import 108 (lexical) ****$ full +_name used C:/Perl/lib/constant.pm constant::import 108 (lexical) % force +d_into_main used C:/Perl/lib/constant.pm constant::import 108 (lexical) $ name + used C:/Perl/lib/constant.pm constant::import 108 (lexical) $ pkg + used C:/Perl/lib/constant.pm constant::import 58 (lexical) $ name + used C:/Perl/lib/constant.pm constant::import 58 Carp & croak + subused C:/Perl/lib/constant.pm constant::import 58 (lexical) $ name + used C:/Perl/lib/constant.pm constant::import 63 (lexical) $ name + used C:/Perl/lib/constant.pm constant::import 63 Carp & croak + subused C:/Perl/lib/constant.pm constant::import 63 (lexical) $ name + used C:/Perl/lib/constant.pm constant::import 68 warnings & enabl +ed subused C:/Perl/lib/constant.pm constant::import 69 (lexical) % keywo +rds used C:/Perl/lib/constant.pm constant::import 69 (lexical) $ name + used C:/Perl/lib/constant.pm constant::import 69 (lexical) $ name + used C:/Perl/lib/constant.pm constant::import 69 warnings & warn + subused C:/Perl/lib/constant.pm constant::import 69 (lexical) % force +d_into_main used C:/Perl/lib/constant.pm constant::import 69 (lexical) $ name + used C:/Perl/lib/constant.pm constant::import 69 (lexical) $ name + used C:/Perl/lib/constant.pm constant::import 69 warnings & warn + subused C:/Perl/lib/constant.pm constant::import 69 (lexical) $ name + used C:/Perl/lib/constant.pm constant::import 81 main @ _ + used C:/Perl/lib/constant.pm constant::import 81 (lexical) $ name + used C:/Perl/lib/constant.pm constant::import 81 Carp & croak + subused C:/Perl/lib/constant.pm constant::import 84 Carp & croak + subused C:/Perl/lib/constant.pm constant::import 90 (lexical) $ name + used C:/Perl/lib/constant.pm constant::import 90 Carp & croak + subused C:/Perl/lib/constant.pm constant::import 41 (lexical) % const +ants used C:/Perl/lib/constant.pm constant::import 41 main @ _ + used test.pl syntax OK C:\>
Re: Establishing a Subroutine Chain of Custody
by nothingmuch (Priest) on Jun 20, 2008 at 14:52 UTC

    Maybe wrapping Test::Deep::import is enough?

    Unfortunately using Tie::Trace doesn't seem possible with a symbol table. Oh well...

    -nuffin
    zz zZ Z Z #!perl

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://693121]
Approved by moritz
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others drinking their drinks and smoking their pipes about the Monastery: (10)
As of 2014-04-16 07:17 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    April first is:







    Results (417 votes), past polls