Establishing a Subroutine Chain of Custody

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

colspan=2> Establishing a Subroutine Chain of CustodyAnonymous Monk on Jun 20, 2008 at 11:17 UTC bgcolor='ffffff'> colspan=2> Establishing a Subroutine Chain of Custodynothingmuch(Priest) on Jun 20, 2008 at 14:52 UTC bgcolor='ffffff'>

Replies are listed 'Best First'.
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	[reply]
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, +of 165: # this allows Set and 429:sub set	+ C:/Perl/lib/constant.pm (definitions) + + test.pl (definitions) 0 Regexp + test.pl (definitions) + test.pl (definitions) + test.pl (definitions) + test.pl (definitions) + test.pl (definitions) +olders test.pl (definitions) + test.pl (definitions) + test.pl (definitions) + test.pl (definitions) + C:/Perl/lib/constant.pm (definitions) + test.pl (definitions) 0 Win32 + test.pl (definitions) 0 Win32 +e test.pl (definitions) 0 Win32 + test.pl (definitions) 0 Win32 + test.pl (definitions) 0 Win32 +dow test.pl (definitions) 0 Win32 + test.pl (definitions) 0 Win32 + test.pl (definitions) 0 Win32 + test.pl (definitions) 0 Win32 + test.pl (definitions) 0 Win32 + test.pl (definitions) 0 Win32 + test.pl (definitions) 0 Win32 + test.pl (definitions) 0 Win32 + test.pl (definitions) 0 Win32 + test.pl (definitions) 0 Win32 + test.pl (definitions) 0 Win32 +ve test.pl (definitions) 0 Win32 + test.pl (definitions) 0 Win32 + test.pl (definitions) 0 Win32 + test.pl (definitions) 0 Win32 + test.pl (definitions) 0 Win32 + test.pl (definitions) 0 Win32 + test.pl (definitions) 0 PerlIO + C:/Perl/lib/constant.pm (definitions) + test.pl (main) 5 main + used test.pl (main) 6 main + used C:/Perl/lib/constant.pm constant::import + C:/Perl/lib/constant.pm constant::import + C:/Perl/lib/constant.pm constant::import + C:/Perl/lib/constant.pm constant::import +ants C:/Perl/lib/constant.pm constant::import +ple C:/Perl/lib/constant.pm constant::import +ple C:/Perl/lib/constant.pm constant::import + C:/Perl/lib/constant.pm constant::import + C:/Perl/lib/constant.pm constant::import + C:/Perl/lib/constant.pm constant::import + C:/Perl/lib/constant.pm constant::import +ants C:/Perl/lib/constant.pm constant::import +ants C:/Perl/lib/constant.pm constant::import + C:/Perl/lib/constant.pm constant::import + C:/Perl/lib/constant.pm constant::import + C:/Perl/lib/constant.pm constant::import + C:/Perl/lib/constant.pm constant::import +dden C:/Perl/lib/constant.pm constant::import + C:/Perl/lib/constant.pm constant::import + C:/Perl/lib/constant.pm constant::import + C:/Perl/lib/constant.pm constant::import +name C:/Perl/lib/constant.pm constant::import +red C:/Perl/lib/constant.pm constant::import +name C:/Perl/lib/constant.pm constant::import +ple C:/Perl/lib/constant.pm constant::import +ants C:/Perl/lib/constant.pm constant::import + C:/Perl/lib/constant.pm constant::import +r C:/Perl/lib/constant.pm constant::import +name C:/Perl/lib/constant.pm constant::import +name C:/Perl/lib/constant.pm constant::import + C:/Perl/lib/constant.pm constant::import +r C:/Perl/lib/constant.pm constant::import +name C:/Perl/lib/constant.pm constant::import +name C:/Perl/lib/constant.pm constant::import + C:/Perl/lib/constant.pm constant::import + C:/Perl/lib/constant.pm constant::import + C:/Perl/lib/constant.pm constant::import +name C:/Perl/lib/constant.pm constant::import +name C:/Perl/lib/constant.pm constant::import +name C:/Perl/lib/constant.pm constant::import +_name C:/Perl/lib/constant.pm constant::import +d_into_main C:/Perl/lib/constant.pm constant::import + C:/Perl/lib/constant.pm constant::import + C:/Perl/lib/constant.pm constant::import + C:/Perl/lib/constant.pm constant::import + C:/Perl/lib/constant.pm constant::import + C:/Perl/lib/constant.pm constant::import + C:/Perl/lib/constant.pm constant::import + C:/Perl/lib/constant.pm constant::import + C:/Perl/lib/constant.pm constant::import +ed C:/Perl/lib/constant.pm constant::import +rds C:/Perl/lib/constant.pm constant::import + C:/Perl/lib/constant.pm constant::import + C:/Perl/lib/constant.pm constant::import + C:/Perl/lib/constant.pm constant::import +d_into_main C:/Perl/lib/constant.pm constant::import + C:/Perl/lib/constant.pm constant::import + C:/Perl/lib/constant.pm constant::import + C:/Perl/lib/constant.pm constant::import + C:/Perl/lib/constant.pm constant::import + C:/Perl/lib/constant.pm constant::import + C:/Perl/lib/constant.pm constant::import + C:/Perl/lib/constant.pm constant::import + C:/Perl/lib/constant.pm constant::import + C:/Perl/lib/constant.pm constant::import + C:/Perl/lib/constant.pm constant::import +ants C:/Perl/lib/constant.pm constant::import + test.pl syntax OK C:\>	grep the source `lib/Test/Deep.pm cmp_deeply cmp_set cmp_bag cmp_methods bag subbagof superbagof subsetof superset Bag to handle circular refs href="?part=1;abspart=1;node_id=693128;displaytype=displaycode">[download]` `adjunct-links' align='left' valign='bottom'>[reply] [d/l]`
Looks like you could use B::Xref class='codeblock'>C:/Perl/lib/constant.pm (definitions) 103 main & PI subdef 103 main & DEBUG subdef href="?node_id=693131;part=1;abspart=1;displaytype=displaycode">[download] class='codetext'> * atan2(1, 1); 113 constant & import subdef & DESTROY subdef 0 UNIVERSAL & isa subdef 0 UNIVERSAL & VERSION subdef 0 UNIVERSAL & can subdef 0 Internals & SvREFCNT subdef 0 Internals & hv_clear_placeh subdef 0 Internals & hash_seed subdef 0 Internals & SvREADONLY subdef 0 Internals & HvREHASH subdef 0 Internals & rehash_seed subdef 103 main & DEBUG subdef & GetCwd subdef & GetShortPathNam subdef & GetOSVersion subdef & SetLastError subdef & SetChildShowWin subdef & Sleep subdef & FormatMessage subdef & GetFullPathName subdef & SetCwd subdef & GetTickCount subdef & IsWinNT subdef & GetLastError subdef & CopyFile subdef & NodeName subdef & GetLongPathName subdef & GetNextAvailDri subdef & FsType subdef & IsWin95 subdef & Spawn subdef & BuildNumber subdef & DomainName subdef & LoginName subdef & get_layers subdef 103 main & PI subdef $ / $ / 29 main @ _ used 29 (lexical) $ class intro 30 main @ _ used 31 (lexical) % const intro 32 (lexical) $ multi intro 34 (lexical) $ multi used 37 main @ _ used 37 Carp & croak subused 39 main @ _ used 39 main %@ _ used 39 (lexical) % const used 44 (lexical) % const used 45 (lexical) $ name used 47 Carp & croak subused 49 (lexical) $ pkg intro 52 (lexical) $ name used 52 (lexical) % forbi used 52 (lexical) $ name used 95 (lexical) $ pkg used 95 (lexical) $ name used 95 (lexical) $ full_ intro 96 constant % decla used 96 (lexical) $ full_ used 97 (lexical) $ multi used 98 (lexical) % const used 98 (lexical) $ name used 98 (lexical) $ scala intro 99 (lexical) $ full_ used 99 (lexical) $ full_ used 101 main @ _ used 102 (lexical) $ scala intro 103 (lexical) $ full_ used 103 (lexical) $ full_ used 103 main @ _ used 105 main @ _ used 105 (lexical) @ list intro 106 (lexical) $ full_ used 106 (lexical) *$ full_ used 108 (lexical) $ full_ used 108 (lexical) ***$ full used 108 (lexical) % force used 108 (lexical) $ name used 108 (lexical) $ pkg used 58 (lexical) $ name used 58 Carp & croak subused 58 (lexical) $ name used 63 (lexical) $ name used 63 Carp & croak subused 63 (lexical) $ name used 68 warnings & enabl subused 69 (lexical) % keywo used 69 (lexical) $ name used 69 (lexical) $ name used 69 warnings & warn subused 69 (lexical) % force used 69 (lexical) $ name used 69 (lexical) $ name used 69 warnings & warn subused 69 (lexical) $ name used 81 main @ _ used 81 (lexical) $ name used 81 Carp & croak subused 84 Carp & croak subused 90 (lexical) $ name used 90 Carp & croak subused 41 (lexical) % const used 41 main @ _ used href="?node_id=693131;abspart=1;part=2;displaytype=displaycode">[download] adjunct-links' align='left' valign='bottom'>[reply] [d/l] [select]
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	[reply]


Clear questions and runnable code get the best and fastest answer
	PerlMonks