1package Sub::Identify;
2
3use strict;
4use Exporter;
5
6BEGIN {
7    our $VERSION = '0.04';
8    our @ISA = ('Exporter');
9    our %EXPORT_TAGS = (all => [ our @EXPORT_OK = qw(sub_name stash_name sub_fullname get_code_info) ]);
10
11    my $loaded = 0;
12    unless ($ENV{PERL_SUB_IDENTIFY_PP}) {
13        local $@;
14        eval {
15            if ($] >= 5.006) {
16                require XSLoader;
17                XSLoader::load(__PACKAGE__, $VERSION);
18            }
19            else {
20                require DynaLoader;
21                push @ISA, 'DynaLoader';
22                __PACKAGE__->bootstrap($VERSION);
23            }
24        };
25
26        die $@ if $@ && $@ !~ /object version|loadable object/;
27
28        $loaded = 1 unless $@;
29    }
30
31    our $IsPurePerl = !$loaded;
32
33    if ($IsPurePerl) {
34        require B;
35        *get_code_info = sub ($) {
36            my ($coderef) = @_;
37            ref $coderef or return;
38            my $cv = B::svref_2object($coderef);
39            $cv->isa('B::CV') or return;
40            # bail out if GV is undefined
41            $cv->GV->isa('B::SPECIAL') and return;
42
43            return ($cv->GV->STASH->NAME, $cv->GV->NAME);
44        };
45    }
46}
47
48sub stash_name   ($) { (get_code_info($_[0]))[0] }
49sub sub_name     ($) { (get_code_info($_[0]))[1] }
50sub sub_fullname ($) { join '::', get_code_info($_[0]) }
51
521;
53
54__END__
55
56=head1 NAME
57
58Sub::Identify - Retrieve names of code references
59
60=head1 SYNOPSIS
61
62    use Sub::Identify ':all';
63    my $subname = sub_name( $some_coderef );
64    my $p = stash_name( $some_coderef );
65    my $fully_qualified_name = sub_fullname( $some_coderef );
66    defined $subname
67	and print "this coderef points to sub $subname in package $p\n";
68
69=head1 DESCRIPTION
70
71C<Sub::Identify> allows you to retrieve the real name of code references. For
72this, it uses perl's introspection mechanism, provided by the C<B> module.
73
74It provides four functions : C<sub_name> returns the name of the
75subroutine (or C<__ANON__> if it's an anonymous code reference),
76C<stash_name> returns its package, and C<sub_fullname> returns the
77concatenation of the two.
78
79The fourth function, C<get_code_info>, returns a list of two elements,
80the package and the subroutine name (in case of you want both and are worried
81by the speed.)
82
83In case of subroutine aliasing, those functions always return the
84original name.
85
86=head1 LICENSE
87
88(c) Rafael Garcia-Suarez (rgarciasuarez at gmail dot com) 2005, 2008
89
90This program is free software; you may redistribute it and/or modify it under
91the same terms as Perl itself.
92
93=cut
94