File Coverage

blib/lib/Devel/Backtrace.pm

Criterion	Covered	Total	%
statement	60	61	98.3
branch	11	12	91.6
condition	6	8	75.0
subroutine	13	13	100.0
pod	7	7	100.0
total	97	101	96.0

package Devel::Backtrace;
use strict;
use warnings;
use Devel::Backtrace::Point;
use Carp;

use overload '""' => \&to_string;

=head1 NAME

Devel::Backtrace - Object-oriented backtrace

=head1 VERSION

This is version 0.11_01.

=cut

our $VERSION = '0.11_01';

=head1 SYNOPSIS

    my $backtrace = Devel::Backtrace->new;

    print $backtrace; # use automatic stringification
                      # See EXAMPLES to see what the output might look like

    print $backtrace->point(0)->line;

=head1 METHODS

=head2 Devel::Backtrace->new()

Optional parameters: -start => $start, -format => $format

If only one parameter is given, it will be used as $start.

Constructs a new C which is filled with all the information
C provides, where C<$i> starts from C<$start>.  If no argument is
given, C<$start> defaults to 0.

If C<$start> is 1 (or higher), the backtrace won't contain the information that
(and where) Devel::Backtrace::new() was called.

=cut

sub new {
    my $class = shift;
    my (@opts) = @_;

    my $start;
    my %pointopts;

    if (1 == @opts) {
        $start = shift @opts;
    }
    while (my $opt = shift @opts) {
        if ('-format' eq $opt) {
            $pointopts{$opt} = shift @opts;
        } elsif ('-start' eq $opt) {
            $start = shift @opts;
        } else {
            croak "Unknown option $opt";
        }
    }

    if (defined $start) {
        $pointopts{'-skip'} = $start;
    } else {
        $start = 0;
    }

    my @backtrace;
    for (my $deep = $start; my @caller = caller($deep); ++$deep) {
	push @backtrace, Devel::Backtrace::Point->new(
            \@caller,
            -level => $deep,
            %pointopts,
        );
    }

    return bless \@backtrace, $class;
}

=head2 $backtrace->point($i)

Returns the i'th tracepoint as a L object (see its documentation
for how to access every bit of information).

Note that the following code snippet will print the information of
C:

    print Devel::Backtrace->new($start)->point($i)

=cut

sub point {
    my $this = shift;
    my ($i) = @_;
    return $this->[$i];
}

=head2 $backtrace->points()

Returns a list of all tracepoints.  In scalar context, the number of
tracepoints is returned.

=cut

sub points {
    my $this = shift;
    return @$this;
}

=head2 $backtrace->skipme([$package])

This method deletes all leading tracepoints that contain information about calls
within C<$package>.  Afterwards the C<$backtrace> will look as though it had
been created with a higher value of C<$start>.

If the optional parameter C<$package> is not given, it defaults to the calling
package.

The effect is similar to what the L module does.

This module ships with an example "skipme.pl" that demonstrates how to use this
method.  See also L.

=cut

sub skipme {
    my $this = shift;
    my $package = @_ ? $_[0] : caller;

    my $skip = 0;
    my $skipped;
    while (@$this and $package eq $this->point(0)->package) {
        $skipped = shift @$this;
        $skip++;
    }
    $this->_adjustskip($skip);
    return $skipped;
}

sub _adjustskip {
    my ($this, $newskip) = @_;

    $_->_skip($newskip + ($_->_skip || 0)) for $this->points;
}

=head2 $backtrace->skipmysubs([$package])

This method is like C except that it deletes calls I the package
rather than calls I the package.

Before discarding those calls, C is called.  This is because usually
the topmost call in the stack is to Devel::Backtrace->new, which would not be
catched by C otherwise.

This means that skipmysubs usually deletes more lines than skipme would.

C was added in Devel::Backtrace version 0.06.

See also L and the example "skipme.pl".

=cut

sub skipmysubs {
    my $this = shift;
    my $package = @_ ? $_[0] : caller;

    my $skipped = $this->skipme($package);
    my $skip = 0;
    while (@$this and $package eq $this->point(0)->called_package) {
        $skipped = shift @$this;
        $skip++;
    }
    $this->_adjustskip($skip);
    return $skipped;
}

=head2 $backtrace->to_string()

Returns a string that contains one line for each tracepoint.  It will contain
the information from C's to_string() method.  To get
more information, use the to_long_string() method.

Note that you don't have to call to_string() if you print a C
object or otherwise treat it as a string, as the stringification operator is
overloaded.

See L.

=cut

sub to_string {
    my $this = shift;
    return join '', map "$_\n", $this->points;
}


=head2 $backtrace->to_long_string()

Returns a very long string that contains several lines for each trace point.
The result will contain every available bit of information.  See
L for an example of what the result
looks like.

=cut

sub to_long_string {
    my $this = shift;
    return join "\n", map $_->to_long_string, $this->points;
}


1
__END__