← Index
NYTProf Performance Profile   « block view • line view • sub view »
For xt/tapper-mcp-scheduler-with-db-longrun.t
  Run on Tue May 22 17:18:39 2012
Reported on Tue May 22 17:24:09 2012

Filename/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/Devel/Backtrace/Point.pm
StatementsExecuted 34 statements in 958µs
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
1113.35ms4.75msDevel::Backtrace::Point::::BEGIN@6Devel::Backtrace::Point::BEGIN@6
11118µs52µsDevel::Backtrace::Point::::BEGIN@26Devel::Backtrace::Point::BEGIN@26
11116µs62µsDevel::Backtrace::Point::::BEGIN@29Devel::Backtrace::Point::BEGIN@29
11115µs100µsDevel::Backtrace::Point::::BEGIN@25Devel::Backtrace::Point::BEGIN@25
11113µs15µsDevel::Backtrace::Point::::BEGIN@2Devel::Backtrace::Point::BEGIN@2
11111µs14µsDevel::Backtrace::Point::::BEGIN@27Devel::Backtrace::Point::BEGIN@27
1118µs47µsDevel::Backtrace::Point::::BEGIN@5Devel::Backtrace::Point::BEGIN@5
1117µs15µsDevel::Backtrace::Point::::BEGIN@3Devel::Backtrace::Point::BEGIN@3
0000s0sDevel::Backtrace::Point::::_virtlevelDevel::Backtrace::Point::_virtlevel
0000s0sDevel::Backtrace::Point::::by_indexDevel::Backtrace::Point::by_index
0000s0sDevel::Backtrace::Point::::called_packageDevel::Backtrace::Point::called_package
0000s0sDevel::Backtrace::Point::::newDevel::Backtrace::Point::new
0000s0sDevel::Backtrace::Point::::to_long_stringDevel::Backtrace::Point::to_long_string
0000s0sDevel::Backtrace::Point::::to_stringDevel::Backtrace::Point::to_string
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package Devel::Backtrace::Point;
2317µs217µs
# spent 15µs (13+2) within Devel::Backtrace::Point::BEGIN@2 which was called: # once (13µs+2µs) by Devel::Backtrace::BEGIN@4 at line 2
use strict;
# spent 15µs making 1 call to Devel::Backtrace::Point::BEGIN@2 # spent 2µs making 1 call to strict::import
3328µs222µs
# spent 15µs (7+8) within Devel::Backtrace::Point::BEGIN@3 which was called: # once (7µs+8µs) by Devel::Backtrace::BEGIN@4 at line 3
use warnings;
# spent 15µs making 1 call to Devel::Backtrace::Point::BEGIN@3 # spent 8µs making 1 call to warnings::import
41700nsour $VERSION = '0.11';
5321µs287µs
# spent 47µs (8+39) within Devel::Backtrace::Point::BEGIN@5 which was called: # once (8µs+39µs) by Devel::Backtrace::BEGIN@4 at line 5
use Carp;
# spent 47µs making 1 call to Devel::Backtrace::Point::BEGIN@5 # spent 39µs making 1 call to Exporter::import
63139µs24.88ms
# spent 4.75ms (3.35+1.41) within Devel::Backtrace::Point::BEGIN@6 which was called: # once (3.35ms+1.41ms) by Devel::Backtrace::BEGIN@4 at line 6
use String::Escape qw(printable);
# spent 4.75ms making 1 call to Devel::Backtrace::Point::BEGIN@6 # spent 121µs making 1 call to Exporter::import
7
8=head1 NAME
9
10Devel::Backtrace::Point - Object oriented access to the information caller()
11provides
12
13=head1 SYNOPSIS
14
15 print Devel::Backtrace::Point->new([caller(0)])->to_long_string;
16
17=head1 DESCRIPTION
18
19This class is a nice way to access all the information caller provides on a
20given level. It is used by L<Devel::Backtrace>, which generates an array of
21all trace points.
22
23=cut
24
25334µs2185µs
# spent 100µs (15+85) within Devel::Backtrace::Point::BEGIN@25 which was called: # once (15µs+85µs) by Devel::Backtrace::BEGIN@4 at line 25
use base qw(Class::Accessor::Fast);
# spent 100µs making 1 call to Devel::Backtrace::Point::BEGIN@25 # spent 85µs making 1 call to base::import
26325µs287µs
# spent 52µs (18+35) within Devel::Backtrace::Point::BEGIN@26 which was called: # once (18µs+35µs) by Devel::Backtrace::BEGIN@4 at line 26
use overload '""' => \&to_string;
# spent 52µs making 1 call to Devel::Backtrace::Point::BEGIN@26 # spent 35µs making 1 call to overload::import
27398µs218µs
# spent 14µs (11+3) within Devel::Backtrace::Point::BEGIN@27 which was called: # once (11µs+3µs) by Devel::Backtrace::BEGIN@4 at line 27
use constant;
# spent 14µs making 1 call to Devel::Backtrace::Point::BEGIN@27 # spent 3µs making 1 call to constant::import
28
29
# spent 62µs (16+46) within Devel::Backtrace::Point::BEGIN@29 which was called: # once (16µs+46µs) by Devel::Backtrace::BEGIN@4 at line 49
BEGIN {
3012µs my @known_fields = (qw(package filename line subroutine hasargs wantarray
31 evaltext is_require hints bitmask hinthash));
32 # The number of caller()'s return values depends on the perl version. For
33 # instance, hinthash is not available below perl 5.9. We try and see how
34 # many fields are supported
3516µs my $supported_fields_number = () = caller(0)
36 or die "Caller doesn't work as expected";
37
38 # If not all known fields are supported, remove some
391900ns while (@known_fields > $supported_fields_number) {
40 pop @known_fields;
41 }
42
43 # If not all supported fields are known, add placeholders
441800ns while (@known_fields < $supported_fields_number) {
45 push @known_fields, "_unknown".scalar(@known_fields);
46 }
47
4815µs145µs constant->import (FIELDS => @known_fields);
# spent 45µs making 1 call to constant::import
491546µs162µs}
# spent 62µs making 1 call to Devel::Backtrace::Point::BEGIN@29
50
51=head1 METHODS
52
53=head2 $p->package, $p->filename, $p->line, $p->subroutine, $p->hasargs,
54$p->wantarray, $p->evaltext, $p->is_require, $p->hints, $p->bitmask,
55$p->hinthash
56
57See L<perlfunc/caller> for documentation of these fields.
58
59hinthash is only available in perl 5.9 and higher. When this module is loaded,
60it tests how many values caller returns. Depending on the result, it adds the
61necessary accessors. Thus, you should be able to find out if your perl
62supports hinthash by using L<UNIVERSAL/can>:
63
64 Devel::Backtrace::Point->can('hinthash');
65
66=cut
67
6818µs2337µs__PACKAGE__->mk_ro_accessors(FIELDS);
# spent 333µs making 1 call to Class::Accessor::mk_ro_accessors # spent 4µs making 1 call to constant::__ANON__[constant.pm:141]
69
70=head2 $p->level
71
72This is the level given to new(). It's intended to be the parameter that was
73given to caller().
74
75=cut
76
7711µs130µs__PACKAGE__->mk_ro_accessors('level');
# spent 30µs making 1 call to Class::Accessor::mk_ro_accessors
78
79=head2 $p->called_package
80
81This returns the package that $p->subroutine is in.
82
83If $p->subroutine does not contain '::', then '(unknown)' is returned. This is
84the case if $p->subroutine is '(eval)'.
85
86=cut
87
88sub called_package {
89 my $this = shift;
90 my $sub = $this->subroutine;
91
92 my $idx = rindex($sub, '::');
93 return '(unknown)' if -1 == $idx;
94 return substr($sub, 0, $idx);
95}
96
97=head2 $p->by_index($i)
98
99You may also access the fields by their index in the list that caller()
100returns. This may be useful if some future perl version introduces a new field
101for caller, and the author of this module doesn't react in time.
102
103=cut
104
105sub by_index {
106 my ($this, $idx) = @_;
107 my $fieldname = (FIELDS)[$idx];
108 unless (defined $fieldname) {
109 croak "There is no field with index $idx.";
110 }
111 return $this->$fieldname();
112}
113
114=head2 new([caller($i)])
115
116This constructs a Devel::Backtrace object. The argument must be a reference to
117an array holding the return values of caller(). This array must have either
118three or ten elements (or eleven if hinthash is supported) (see
119L<perlfunc/caller>).
120
121Optional additional parameters:
122
123 -format => 'formatstring',
124 -level => $i
125
126The format string will be used as a default for to_string().
127
128The level should be the parameter that was given to caller() to obtain the
129caller information.
130
131=cut
132
13311µs129µs__PACKAGE__->mk_ro_accessors('_format');
# spent 29µs making 1 call to Class::Accessor::mk_ro_accessors
13418µs140µs__PACKAGE__->mk_accessors('_skip');
# spent 40µs making 1 call to Class::Accessor::mk_accessors
135
136sub new {
137 my $class = shift;
138 my ($caller, %opts) = @_;
139
140 my %data;
141
142 unless ('ARRAY' eq ref $caller) {
143 croak 'That is not an array reference.';
144 }
145
146 if (@$caller == (() = FIELDS)) {
147 for (FIELDS) {
148 $data{$_} = $caller->[keys %data]
149 }
150 } elsif (@$caller == 3) {
151 @data{qw(package filename line)} = @$caller;
152 } else {
153 croak 'That does not look like the return values of caller.';
154 }
155
156 for my $opt (keys %opts) {
157 if ('-format' eq $opt) {
158 $data{'_format'} = $opts{$opt};
159 } elsif ('-level' eq $opt) {
160 $data{'level'} = $opts{$opt};
161 } elsif ('-skip' eq $opt) {
162 $data{'_skip'} = $opts{$opt};
163 } else {
164 croak "Unknown option $opt";
165 }
166 }
167
168 return $class->SUPER::new(\%data);
169}
170
171sub _virtlevel {
172 my $this = shift;
173
174 return $this->level - ($this->_skip || 0);
175}
176
177=head2 $tracepoint->to_string()
178
179Returns a string of the form "Blah::subname called from main (foo.pl:17)".
180This means that the subroutine C<subname> from package C<Blah> was called by
181package C<main> in C<foo.pl> line 17.
182
183If you print a C<Devel::Backtrace::Point> object or otherwise treat it as a
184string, to_string() will be called automatically due to overloading.
185
186Optional parameters: -format => 'formatstring'
187
188The format string changes the appearance of the return value. It can contain
189C<%p> (package), C<%c> (called_package), C<%f> (filename), C<%l> (line), C<%s>
190(subroutine), C<%a> (hasargs), C<%e> (evaltext), C<%r> (is_require), C<%h>
191(hints), C<%b> (bitmask), C<%i> (level), C<%I> (level, see below).
192
193The difference between C<%i> and C<%I> is that the former is the argument to
194caller() while the latter is actually the index in $backtrace->points(). C<%i>
195and C<%I> are different if C<-start>, skipme() or skipmysubs() is used in
196L<Devel::Backtrace>.
197
198If no format string is given, the one passed to C<new> will be used. If none
199was given to C<new>, the format string defaults to 'default', which is an
200abbreviation for C<%s called from %p (%f:%l)>.
201
202Format strings have been added in Devel-Backtrace-0.10.
203
204=cut
205
20611µsmy %formats = (
207 'default' => '%s called from %p (%f:%l)',
208);
209
21017µsmy %percent = (
211 'p' => 'package',
212 'c' => 'called_package',
213 'f' => 'filename',
214 'l' => 'line',
215 's' => 'subroutine',
216 'a' => 'hasargs',
217 'w' => 'wantarray',
218 'e' => 'evaltext',
219 'r' => 'is_require',
220 'h' => 'hints',
221 'b' => 'bitmask',
222 'i' => 'level',
223 'I' => '_virtlevel',
224);
225
226sub to_string {
227 my ($this, @opts) = @_;
228
229 my %opts;
230 if (defined $opts[0]) { # check that we are not called as stringification
231 %opts = @opts;
232 }
233
234 my $format = $this->_format();
235
236 for my $opt (keys %opts) {
237 if ($opt eq '-format') {
238 $format = $opts{$opt};
239 } else {
240 croak "Unknown option $opt";
241 }
242 }
243
244 $format = 'default' unless defined $format;
245 $format = $formats{$format} if exists $formats{$format};
246
247 my $result = $format;
248 $result =~ s{%(\S)} {
249 my $percent = $percent{$1} or croak "Unknown symbol %$1\n";
250 my $val = $this->$percent();
251 defined($val) ? printable($val) : 'undef';
252 }ge;
253
254 return $result;
255}
256
257=head2 $tracepoint->to_long_string()
258
259This returns a string which lists all available fields in a table that spans
260several lines.
261
262Example:
263
264 package: main
265 filename: /tmp/foo.pl
266 line: 6
267 subroutine: main::foo
268 hasargs: 1
269 wantarray: undef
270 evaltext: undef
271 is_require: undef
272 hints: 0
273 bitmask: \00\00\00\00\00\00\00\00\00\00\00\00
274
275hinthash is not included in the output, as it is a hash.
276
277=cut
278
279sub to_long_string {
280 my $this = shift;
281 return join '',
282 map {
283 "$_: " .
284 (defined ($this->{$_}) ? printable($this->{$_}) : 'undef')
285 . "\n"
286 } grep {
287 ! /^_/ && 'hinthash' ne $_
288 } FIELDS;
289}
290
291=head2 FIELDS
292
293This constant contains a list of all the available field names. The number of
294fields depends on your perl version.
295
296=cut
297
29818µs1
299__END__