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 | BEGIN@4 | Devel::Backtrace::
1 | 1 | 1 | 13µs | 16µs | BEGIN@2 | Devel::Backtrace::
1 | 1 | 1 | 10µs | 28µs | BEGIN@3 | Devel::Backtrace::
1 | 1 | 1 | 9µs | 54µs | BEGIN@5 | Devel::Backtrace::
1 | 1 | 1 | 9µs | 37µs | BEGIN@7 | Devel::Backtrace::
0 | 0 | 0 | 0s | 0s | _adjustskip | Devel::Backtrace::
0 | 0 | 0 | 0s | 0s | new | Devel::Backtrace::
0 | 0 | 0 | 0s | 0s | point | Devel::Backtrace::
0 | 0 | 0 | 0s | 0s | points | Devel::Backtrace::
0 | 0 | 0 | 0s | 0s | skipme | Devel::Backtrace::
0 | 0 | 0 | 0s | 0s | skipmysubs | Devel::Backtrace::
0 | 0 | 0 | 0s | 0s | to_long_string | Devel::Backtrace::
0 | 0 | 0 | 0s | 0s | to_string | Devel::Backtrace::
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__ |