view release on metacpan or  search on metacpan

bin/plstrace  view on Meta::CPAN

B<plstrace> is "strace for your Perl functions". Its interface and output is
similar to Unix utility B<strace>. But only a few strace options are currently
supported.

Some notes (caveats, limitations):

=over

=item * Currently implemented by wrapping Perl subroutines with Perl subroutines during INIT phase

caller() has been adjusted so the wrapped subroutines does not see the trace
wrappers (see L<Hook::LexWrap>).

There are other low-level approaches for tracing (that might be used), see
L</"SEE ALSO">.

=item * Perl builtin functions are not traced, only user-defined subroutines

=item * O/S system calls or external programs are not traced

=item * Time spent in each subroutine (-T) is inclusive

lib/Debug/LTrace/plstrace.pm  view on Meta::CPAN

    $self->{wrappers} = {};
    my @messages;

    foreach my $sub ( @{ $self->{subs} } ) {
        next if $self->{wrappers}{$sub};    # Skip already wrapped

        $self->{wrappers}{$sub} = Hook::LexWrap::wrap(
            $sub,
            pre => sub {
                pop();
                #my ( $pkg, $file, $line ) = caller(0);
                #my ($caller_sub) = ( caller(1) )[3];

                my $args = join(", ", map {$self->_esc($_)} @_);
                my $entry_time = time();
                my $msg = "> $sub($args)";
                $msg = $self->_fmttime($entry_time) . " $msg" if $self->{-show_time};
                if ($self->{-show_time}) {
                    warn "$msg\n";
                    $prevtime = $entry_time;
                }
                unshift @messages, [ "$sub($args)", $entry_time ];
            },
            post => sub {
                my $exit_time = time();
                my $wantarray = ( caller(0) )[5];
                my $call_data = shift(@messages);

                my $res = defined($wantarray) ? " = ".$self->_esc($wantarray ? pop : [pop]) : '';
                my $msg = "< $call_data->[0]$res";
                $msg = $self->_fmttime($exit_time) . " $msg" if $self->{-show_time};
                $msg .= sprintf(" <%.6f>", $exit_time - $call_data->[1] ) if $self->{-show_spent_time};
                if ($self->{-show_exit}) {
                    warn "$msg\n";
                    $prevtime = $exit_time;
                }