File Coverage

lib/Carp/Trace.pm

Criterion	Covered	Total	%
statement	42	42	100.0
branch	15	18	83.3
condition	5	9	55.5
subroutine	7	7	100.0
pod	1	1	100.0
total	70	77	90.9

package Carp::Trace;
use strict;
use Data::Dumper;
use Devel::Caller::Perl qw[called_args];

BEGIN {
    use     vars qw[@ISA @EXPORT $VERSION $DEPTH $OFFSET $ARGUMENTS];
    use     Exporter;

    @ISA    = 'Exporter';
    @EXPORT = 'trace';
}

$OFFSET     = 0;
$DEPTH      = 0;
$ARGUMENTS  = 0;
$VERSION    = '0.12';

sub trace {
    my $level   = shift || $DEPTH       || 0;
    my $offset  = shift || $OFFSET      || 0;
    my $args    = shift || $ARGUMENTS   || 0;

    my $trace = '';
    my $i = 1 + $OFFSET;

    while (1) {
        last if $level && $level < $i;

        my  @caller = caller($i);
        last unless scalar @caller;

        my  ($package, $filename, $line, $subroutine, $hasargs, $wantarray,
            $evaltext, $is_require, $hints, $bitmask) = @caller;

        my $string = $subroutine eq '(eval)'
                    ?   $package . '::' . $subroutine . qq| [$i]|
                        . (defined $evaltext ? qq[\n\t$evaltext] : '')
                    :   $subroutine . qq| [$i]|;
        $string =~ s/\n;$/;/gs;

        $string .= qq[\n\t];

        $string .= q[require|use - ] if $is_require;
        $string .= defined $wantarray
                        ? $wantarray ? 'list - ' : 'scalar - '
                        : 'void - ';
        $string .= $hasargs ? 'new stash' : 'no new stash';
        $string .=  qq[\n\t] . $filename . ' line ' . $line . qq[\n];

        if ($args) {
            local $Data::Dumper::Varname    = 'ARGS';
            local $Data::Dumper::Indent     = 1;

            for my $line ( split $/, Dumper( called_args($i) ) ) {
                $string .=  "\t$line\n";
            }
        }

        $trace = $string . $trace;

        $i++;
    }

    return $trace;
}

__END__