view release on metacpan or  search on metacpan

lib/Devel/TraceUse.pm  view on Meta::CPAN

package Devel::TraceUse;
$Devel::TraceUse::VERSION = '2.097';
# detect being loaded via -d:TraceUse and disable the debugger features we
# don't need. better names for evals (0x100) and anon subs (0x200).
BEGIN {
    if (!defined &DB::DB && $^P & 0x02) {
        $^P = 0x100 | 0x200;
    }
}

BEGIN {
    unshift @INC, \&trace_use;
    *CORE::GLOBAL::require = sub {
        my ($arg) = @_;

        # ensure our hook remains first in @INC
        @INC = ( \&trace_use, grep "$_" ne \&trace_use . '', @INC )
          if $INC[0] ne \&trace_use;

        # let require do the heavy lifting
        CORE::require($arg);
    };
}

# initialize the tree of require calls
my $root = (caller)[1];

# keys in %TRACE:
# - ranked:    modules load attemps in chronological order
# - loaded_by: track "filename"s loaded by "filepath" (value from %INC)
# - used:      track loaded modules by "filename" (parameter to require)
# - loader:    track potential proxy modules
#
# %TRACE is built incrementally by trace_use, and augmented by post_process
my %TRACE;

my %reported;    # track reported "filename"
my $rank  = 0;   # record the loading order of modules
my $quiet = 1;   # no output until decided otherwise
my $output_fh;   # optional write filehandle where results will be output

# Hide core modules (for the specified version)?
my $hide_core = 0;

sub import {
    my $class = shift;

    # ensure "use Devel::TraceUse ();" will produce no output
    $quiet = 0;

    # process options
    for(@_) {
        if(/^hidecore(?::(.*))?/) {
            $hide_core = numify( $1 ? $1 : $] );
        } elsif (/^output:(.*)$/) {
            open $output_fh, '>', $1 or die "can't open $1: $!";
        } else {
            die "Unknown argument to $class: $_\n";
        }
    }
}

my @caller_info = qw( package filepath line );

### %TRACE CONSTRUCTION

# Keys used in the data structure:
# - filename: parameter passed to use/require
# - module:   module, computed from filename
# - rank:     rank of loading
# - eval:     was this use/require done in an eval?
# - loaded:   list of files loaded from this one
# - filepath: file that was actually loaded from disk (obtained from %INC)
# - caller:   information on the caller (same keys + everything from caller())

sub trace_use
{
    my ( $code, $filename ) = @_;

    # $filename may be an actual filename, e.g. with do()
    # try to compute a module name from it
    my $module = $filename;
    $module =~ s{/}{::}g
        if $module =~ s/\.pm$//;

    # chronological list of modules we tried to load