| Filename | /2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/Devel/Backtrace.pm |
| Statements | Executed 17 statements in 595µs |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 1 | 1 | 1 | 897µs | 6.40ms | Devel::Backtrace::BEGIN@4 |
| 1 | 1 | 1 | 13µs | 16µs | Devel::Backtrace::BEGIN@2 |
| 1 | 1 | 1 | 10µs | 28µs | Devel::Backtrace::BEGIN@3 |
| 1 | 1 | 1 | 9µs | 54µs | Devel::Backtrace::BEGIN@5 |
| 1 | 1 | 1 | 9µs | 37µs | Devel::Backtrace::BEGIN@7 |
| 0 | 0 | 0 | 0s | 0s | Devel::Backtrace::_adjustskip |
| 0 | 0 | 0 | 0s | 0s | Devel::Backtrace::new |
| 0 | 0 | 0 | 0s | 0s | Devel::Backtrace::point |
| 0 | 0 | 0 | 0s | 0s | Devel::Backtrace::points |
| 0 | 0 | 0 | 0s | 0s | Devel::Backtrace::skipme |
| 0 | 0 | 0 | 0s | 0s | Devel::Backtrace::skipmysubs |
| 0 | 0 | 0 | 0s | 0s | Devel::Backtrace::to_long_string |
| 0 | 0 | 0 | 0s | 0s | Devel::Backtrace::to_string |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | package Devel::Backtrace; | ||||
| 2 | 3 | 18µs | 2 | 19µs | # spent 16µs (13+3) within Devel::Backtrace::BEGIN@2 which was called:
# once (13µs+3µs) by main::BEGIN@24 at line 2 # spent 16µs making 1 call to Devel::Backtrace::BEGIN@2
# spent 3µs making 1 call to strict::import |
| 3 | 3 | 19µs | 2 | 47µs | # spent 28µs (10+18) within Devel::Backtrace::BEGIN@3 which was called:
# once (10µs+18µs) by main::BEGIN@24 at line 3 # spent 28µs making 1 call to Devel::Backtrace::BEGIN@3
# spent 18µs making 1 call to warnings::import |
| 4 | 3 | 97µs | 2 | 6.40ms | # spent 6.40ms (897µs+5.50) within Devel::Backtrace::BEGIN@4 which was called:
# once (897µs+5.50ms) by main::BEGIN@24 at line 4 # spent 6.40ms making 1 call to Devel::Backtrace::BEGIN@4
# spent 4µs making 1 call to Class::Accessor::import |
| 5 | 3 | 27µs | 2 | 100µs | # spent 54µs (9+45) within Devel::Backtrace::BEGIN@5 which was called:
# once (9µs+45µs) by main::BEGIN@24 at line 5 # spent 54µs making 1 call to Devel::Backtrace::BEGIN@5
# spent 45µs making 1 call to Exporter::import |
| 6 | |||||
| 7 | 3 | 431µs | 2 | 66µs | # spent 37µs (9+28) within Devel::Backtrace::BEGIN@7 which was called:
# once (9µs+28µs) by main::BEGIN@24 at line 7 # spent 37µs making 1 call to Devel::Backtrace::BEGIN@7
# spent 28µs making 1 call to overload::import |
| 8 | |||||
| 9 | =head1 NAME | ||||
| 10 | |||||
| 11 | Devel::Backtrace - Object-oriented backtrace | ||||
| 12 | |||||
| 13 | =head1 VERSION | ||||
| 14 | |||||
| 15 | This is version 0.12. | ||||
| 16 | |||||
| 17 | =cut | ||||
| 18 | |||||
| 19 | 1 | 400ns | our $VERSION = '0.12'; | ||
| 20 | |||||
| 21 | =head1 SYNOPSIS | ||||
| 22 | |||||
| 23 | my $backtrace = Devel::Backtrace->new; | ||||
| 24 | |||||
| 25 | print $backtrace; # use automatic stringification | ||||
| 26 | # See EXAMPLES to see what the output might look like | ||||
| 27 | |||||
| 28 | print $backtrace->point(0)->line; | ||||
| 29 | |||||
| 30 | =head1 METHODS | ||||
| 31 | |||||
| 32 | =head2 Devel::Backtrace->new() | ||||
| 33 | |||||
| 34 | Optional parameters: -start => $start, -format => $format | ||||
| 35 | |||||
| 36 | If only one parameter is given, it will be used as $start. | ||||
| 37 | |||||
| 38 | Constructs a new C<Devel::Backtrace> which is filled with all the information | ||||
| 39 | C<caller($i)> provides, where C<$i> starts from C<$start>. If no argument is | ||||
| 40 | given, C<$start> defaults to 0. | ||||
| 41 | |||||
| 42 | If C<$start> is 1 (or higher), the backtrace won't contain the information that | ||||
| 43 | (and where) Devel::Backtrace::new() was called. | ||||
| 44 | |||||
| 45 | =cut | ||||
| 46 | |||||
| 47 | sub new { | ||||
| 48 | my $class = shift; | ||||
| 49 | my (@opts) = @_; | ||||
| 50 | |||||
| 51 | my $start; | ||||
| 52 | my %pointopts; | ||||
| 53 | |||||
| 54 | if (1 == @opts) { | ||||
| 55 | $start = shift @opts; | ||||
| 56 | } | ||||
| 57 | while (my $opt = shift @opts) { | ||||
| 58 | if ('-format' eq $opt) { | ||||
| 59 | $pointopts{$opt} = shift @opts; | ||||
| 60 | } elsif ('-start' eq $opt) { | ||||
| 61 | $start = shift @opts; | ||||
| 62 | } else { | ||||
| 63 | croak "Unknown option $opt"; | ||||
| 64 | } | ||||
| 65 | } | ||||
| 66 | |||||
| 67 | if (defined $start) { | ||||
| 68 | $pointopts{'-skip'} = $start; | ||||
| 69 | } else { | ||||
| 70 | $start = 0; | ||||
| 71 | } | ||||
| 72 | |||||
| 73 | my @backtrace; | ||||
| 74 | for (my $deep = $start; my @caller = caller($deep); ++$deep) { | ||||
| 75 | push @backtrace, Devel::Backtrace::Point->new( | ||||
| 76 | \@caller, | ||||
| 77 | -level => $deep, | ||||
| 78 | %pointopts, | ||||
| 79 | ); | ||||
| 80 | } | ||||
| 81 | |||||
| 82 | return bless \@backtrace, $class; | ||||
| 83 | } | ||||
| 84 | |||||
| 85 | =head2 $backtrace->point($i) | ||||
| 86 | |||||
| 87 | Returns the i'th tracepoint as a L<Devel::Backtrace::Point> object (see its documentation | ||||
| 88 | for how to access every bit of information). | ||||
| 89 | |||||
| 90 | Note that the following code snippet will print the information of | ||||
| 91 | C<caller($start+$i)>: | ||||
| 92 | |||||
| 93 | print Devel::Backtrace->new($start)->point($i) | ||||
| 94 | |||||
| 95 | =cut | ||||
| 96 | |||||
| 97 | sub point { | ||||
| 98 | my $this = shift; | ||||
| 99 | my ($i) = @_; | ||||
| 100 | return $this->[$i]; | ||||
| 101 | } | ||||
| 102 | |||||
| 103 | =head2 $backtrace->points() | ||||
| 104 | |||||
| 105 | Returns a list of all tracepoints. In scalar context, the number of | ||||
| 106 | tracepoints is returned. | ||||
| 107 | |||||
| 108 | =cut | ||||
| 109 | |||||
| 110 | sub points { | ||||
| 111 | my $this = shift; | ||||
| 112 | return @$this; | ||||
| 113 | } | ||||
| 114 | |||||
| 115 | =head2 $backtrace->skipme([$package]) | ||||
| 116 | |||||
| 117 | This method deletes all leading tracepoints that contain information about calls | ||||
| 118 | within C<$package>. Afterwards the C<$backtrace> will look as though it had | ||||
| 119 | been created with a higher value of C<$start>. | ||||
| 120 | |||||
| 121 | If the optional parameter C<$package> is not given, it defaults to the calling | ||||
| 122 | package. | ||||
| 123 | |||||
| 124 | The effect is similar to what the L<Carp> module does. | ||||
| 125 | |||||
| 126 | This module ships with an example "skipme.pl" that demonstrates how to use this | ||||
| 127 | method. See also L</EXAMPLES>. | ||||
| 128 | |||||
| 129 | =cut | ||||
| 130 | |||||
| 131 | sub skipme { | ||||
| 132 | my $this = shift; | ||||
| 133 | my $package = @_ ? $_[0] : caller; | ||||
| 134 | |||||
| 135 | my $skip = 0; | ||||
| 136 | my $skipped; | ||||
| 137 | while (@$this and $package eq $this->point(0)->package) { | ||||
| 138 | $skipped = shift @$this; | ||||
| 139 | $skip++; | ||||
| 140 | } | ||||
| 141 | $this->_adjustskip($skip); | ||||
| 142 | return $skipped; | ||||
| 143 | } | ||||
| 144 | |||||
| 145 | sub _adjustskip { | ||||
| 146 | my ($this, $newskip) = @_; | ||||
| 147 | |||||
| 148 | $_->_skip($newskip + ($_->_skip || 0)) for $this->points; | ||||
| 149 | } | ||||
| 150 | |||||
| 151 | =head2 $backtrace->skipmysubs([$package]) | ||||
| 152 | |||||
| 153 | This method is like C<skipme> except that it deletes calls I<to> the package | ||||
| 154 | rather than calls I<from> the package. | ||||
| 155 | |||||
| 156 | Before discarding those calls, C<skipme> is called. This is because usually | ||||
| 157 | the topmost call in the stack is to Devel::Backtrace->new, which would not be | ||||
| 158 | catched by C<skipmysubs> otherwise. | ||||
| 159 | |||||
| 160 | This means that skipmysubs usually deletes more lines than skipme would. | ||||
| 161 | |||||
| 162 | C<skipmysubs> was added in Devel::Backtrace version 0.06. | ||||
| 163 | |||||
| 164 | See also L</EXAMPLES> and the example "skipme.pl". | ||||
| 165 | |||||
| 166 | =cut | ||||
| 167 | |||||
| 168 | sub skipmysubs { | ||||
| 169 | my $this = shift; | ||||
| 170 | my $package = @_ ? $_[0] : caller; | ||||
| 171 | |||||
| 172 | my $skipped = $this->skipme($package); | ||||
| 173 | my $skip = 0; | ||||
| 174 | while (@$this and $package eq $this->point(0)->called_package) { | ||||
| 175 | $skipped = shift @$this; | ||||
| 176 | $skip++; | ||||
| 177 | } | ||||
| 178 | $this->_adjustskip($skip); | ||||
| 179 | return $skipped; | ||||
| 180 | } | ||||
| 181 | |||||
| 182 | =head2 $backtrace->to_string() | ||||
| 183 | |||||
| 184 | Returns a string that contains one line for each tracepoint. It will contain | ||||
| 185 | the information from C<Devel::Backtrace::Point>'s to_string() method. To get | ||||
| 186 | more information, use the to_long_string() method. | ||||
| 187 | |||||
| 188 | Note that you don't have to call to_string() if you print a C<Devel::Backtrace> | ||||
| 189 | object or otherwise treat it as a string, as the stringification operator is | ||||
| 190 | overloaded. | ||||
| 191 | |||||
| 192 | See L</EXAMPLES>. | ||||
| 193 | |||||
| 194 | =cut | ||||
| 195 | |||||
| 196 | sub to_string { | ||||
| 197 | my $this = shift; | ||||
| 198 | return join '', map "$_\n", $this->points; | ||||
| 199 | } | ||||
| 200 | |||||
| 201 | |||||
| 202 | =head2 $backtrace->to_long_string() | ||||
| 203 | |||||
| 204 | Returns a very long string that contains several lines for each trace point. | ||||
| 205 | The result will contain every available bit of information. See | ||||
| 206 | L<Devel::Backtrace::Point/to_long_string> for an example of what the result | ||||
| 207 | looks like. | ||||
| 208 | |||||
| 209 | =cut | ||||
| 210 | |||||
| 211 | sub to_long_string { | ||||
| 212 | my $this = shift; | ||||
| 213 | return join "\n", map $_->to_long_string, $this->points; | ||||
| 214 | } | ||||
| 215 | |||||
| 216 | |||||
| 217 | 1 | 3µs | 1 | ||
| 218 | __END__ |