← Index
NYTProf Performance Profile   « block view • line view • sub view »
For -e
  Run on Wed Nov 17 21:42:38 2010
Reported on Wed Nov 17 22:08:44 2010

Filename/home/doy/perl5/perlbrew/perls/perl-5.10.1/lib/site_perl/5.10.1/Devel/PartialDump.pm
StatementsExecuted 37 statements in 7.46ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
11176µs2.42msDevel::PartialDump::::BEGIN@13Devel::PartialDump::BEGIN@13
11170µs21.5msDevel::PartialDump::::BEGIN@4Devel::PartialDump::BEGIN@4
11150µs121µsDevel::PartialDump::::BEGIN@128Devel::PartialDump::BEGIN@128
11146µs116µsDevel::PartialDump::::BEGIN@21Devel::PartialDump::BEGIN@21
11142µs1.62msDevel::PartialDump::::BEGIN@9Devel::PartialDump::BEGIN@9
11137µs254µsDevel::PartialDump::::BEGIN@7Devel::PartialDump::BEGIN@7
11124µs24µsDevel::PartialDump::::BEGIN@6Devel::PartialDump::BEGIN@6
0000s0sDevel::PartialDump::::__ANON__[:24]Devel::PartialDump::__ANON__[:24]
0000s0sDevel::PartialDump::::_dump_as_pairsDevel::PartialDump::_dump_as_pairs
0000s0sDevel::PartialDump::::_joinDevel::PartialDump::_join
0000s0sDevel::PartialDump::::dumpDevel::PartialDump::dump
0000s0sDevel::PartialDump::::dump_as_listDevel::PartialDump::dump_as_list
0000s0sDevel::PartialDump::::dump_as_pairsDevel::PartialDump::dump_as_pairs
0000s0sDevel::PartialDump::::formatDevel::PartialDump::format
0000s0sDevel::PartialDump::::format_arrayDevel::PartialDump::format_array
0000s0sDevel::PartialDump::::format_hashDevel::PartialDump::format_hash
0000s0sDevel::PartialDump::::format_keyDevel::PartialDump::format_key
0000s0sDevel::PartialDump::::format_numberDevel::PartialDump::format_number
0000s0sDevel::PartialDump::::format_objectDevel::PartialDump::format_object
0000s0sDevel::PartialDump::::format_refDevel::PartialDump::format_ref
0000s0sDevel::PartialDump::::format_scalarDevel::PartialDump::format_scalar
0000s0sDevel::PartialDump::::format_stringDevel::PartialDump::format_string
0000s0sDevel::PartialDump::::format_undefDevel::PartialDump::format_undef
0000s0sDevel::PartialDump::::quoteDevel::PartialDump::quote
0000s0sDevel::PartialDump::::replacement_caller_infoDevel::PartialDump::replacement_caller_info
0000s0sDevel::PartialDump::::should_dump_as_pairsDevel::PartialDump::should_dump_as_pairs
0000s0sDevel::PartialDump::::showDevel::PartialDump::show
0000s0sDevel::PartialDump::::show_scalarDevel::PartialDump::show_scalar
0000s0sDevel::PartialDump::::warnDevel::PartialDump::warn
0000s0sDevel::PartialDump::::warn_strDevel::PartialDump::warn_str
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1#!/usr/bin/perl
2
3package Devel::PartialDump;
43152µs243.0ms
# spent 21.5ms (70µs+21.5) within Devel::PartialDump::BEGIN@4 which was called: # once (70µs+21.5ms) by KiokuDB::LiveObjects::BEGIN@1 at line 4
use Moose;
# spent 21.5ms making 1 call to Devel::PartialDump::BEGIN@4 # spent 21.5ms making 1 call to Moose::Exporter::__ANON__[Moose/Exporter.pm:456]
5
63101µs124µs
# spent 24µs within Devel::PartialDump::BEGIN@6 which was called: # once (24µs+0s) by KiokuDB::LiveObjects::BEGIN@1 at line 6
use Carp ();
# spent 24µs making 1 call to Devel::PartialDump::BEGIN@6
73116µs2470µs
# spent 254µs (37+216) within Devel::PartialDump::BEGIN@7 which was called: # once (37µs+216µs) by KiokuDB::LiveObjects::BEGIN@1 at line 7
use Scalar::Util qw(looks_like_number reftype blessed);
# spent 254µs making 1 call to Devel::PartialDump::BEGIN@7 # spent 216µs making 1 call to Exporter::import
8
93286µs23.19ms
# spent 1.62ms (42µs+1.58) within Devel::PartialDump::BEGIN@9 which was called: # once (42µs+1.58ms) by KiokuDB::LiveObjects::BEGIN@1 at line 9
use namespace::clean -except => 'meta';
# spent 1.62ms making 1 call to Devel::PartialDump::BEGIN@9 # spent 1.58ms making 1 call to namespace::clean::import
10
1114µsour $VERSION = "0.13";
12
13
# spent 2.42ms (76µs+2.35) within Devel::PartialDump::BEGIN@13 which was called: # once (76µs+2.35ms) by KiokuDB::LiveObjects::BEGIN@1 at line 26
use Sub::Exporter -setup => {
14 exports => [qw(dump warn show show_scalar croak carp confess cluck $default_dumper)],
15 groups => {
16 easy => [qw(dump warn show show_scalar carp croak)],
17 carp => [qw(croak carp)],
18 },
19 collectors => {
20 override_carp => sub {
213231µs2187µs
# spent 116µs (46+71) within Devel::PartialDump::BEGIN@21 which was called: # once (46µs+71µs) by KiokuDB::LiveObjects::BEGIN@1 at line 21
no warnings 'redefine';
# spent 116µs making 1 call to Devel::PartialDump::BEGIN@21 # spent 70µs making 1 call to warnings::unimport
22 require Carp::Heavy;
23 *Carp::caller_info = \&replacement_caller_info;
24 },
25 },
2631.33ms24.77ms};
# spent 2.42ms making 1 call to Devel::PartialDump::BEGIN@13 # spent 2.35ms making 1 call to Sub::Exporter::__ANON__[Sub/Exporter.pm:756]
27
28# a replacement for Carp::caller_info
29sub replacement_caller_info {
30 my $i = shift(@_) + 1;
31
32 package DB;
33
- -
52114µs116.1mshas max_length => (
# spent 16.1ms making 1 call to Moose::has
53 isa => "Int",
54 is => "rw",
55 predicate => "has_max_length",
56 clearer => "clear_max_length",
57);
58
59115µs116.2mshas max_elements => (
# spent 16.2ms making 1 call to Moose::has
60 isa => "Int",
61 is => "rw",
62 default => 6,
63 predicate => "has_max_elements",
64 clearer => "clear_max_elements",
65);
66
67113µs18.87mshas max_depth => (
# spent 8.87ms making 1 call to Moose::has
68 isa => "Int",
69 is => "rw",
70 required => 1,
71 default => 2,
72);
73
74124µs18.75mshas stringify => (
# spent 8.75ms making 1 call to Moose::has
75 isa => "Bool",
76 is => "rw",
77 default => 0,
78);
79
80113µs18.79mshas pairs => (
# spent 8.79ms making 1 call to Moose::has
81 isa => "Bool",
82 is => "rw",
83 default => 1,
84);
85
86113µs19.30mshas objects => (
# spent 9.30ms making 1 call to Moose::has
87 isa => "Bool",
88 is => "rw",
89 default => 1,
90);
91
92113µs18.86mshas list_delim => (
# spent 8.86ms making 1 call to Moose::has
93 isa => "Str",
94 default => ", ",
95 is => "rw",
96);
97
98113µs18.93mshas pair_delim => (
# spent 8.93ms making 1 call to Moose::has
99 isa => "Str",
100 #default => " => ",
101 default => ": ",
102 is => "rw",
103);
104
105sub warn_str {
106 my ( @args ) = @_;
107 my $self;
108
109 if ( blessed($args[0]) and $args[0]->isa(__PACKAGE__) ) {
110 $self = shift @args;
111 } else {
112 $self = our $default_dumper;
113 }
114 return $self->_join(
115 map {
116 !ref($_) && defined($_)
117 ? $_
118 : $self->dump($_)
119 } @args
120 );
121}
122
123sub warn {
124 Carp::carp(warn_str(@_));
125}
126
12717µsforeach my $f ( qw(carp croak confess cluck) ) {
12834.20ms2193µs
# spent 121µs (50+72) within Devel::PartialDump::BEGIN@128 which was called: # once (50µs+72µs) by KiokuDB::LiveObjects::BEGIN@1 at line 128
no warnings 'redefine';
# spent 121µs making 1 call to Devel::PartialDump::BEGIN@128 # spent 72µs making 1 call to warnings::unimport
1294733µs eval "sub $f {
130 local \$Carp::CarpLevel = \$Carp::CarpLevel + 1;
131 Carp::$f(warn_str(\@_));
132 }";
133}
134
135sub show {
136 my ( @args ) = @_;
137 my $self;
138
139 if ( blessed($args[0]) and $args[0]->isa(__PACKAGE__) ) {
140 $self = shift @args;
141 } else {
142 $self = our $default_dumper;
143 }
144
145 $self->warn(@args);
146
147 return ( @args == 1 ? $args[0] : @args );
148}
149
150sub show_scalar ($) { goto \&show }
151
152sub _join {
153 my ( $self, @strings ) = @_;
154
155 my $ret = "";
156
157 if ( @strings ) {
158 my $sep = $, || $" || " ";
159 my $re = qr/(?: \s| \Q$sep\E )$/x;
160
161 my $last = pop @strings;
162
163 foreach my $string ( @strings ) {
164 $ret .= $string;
165 $ret .= $sep unless $string =~ $re;
166 }
167
168 $ret .= $last;
169 }
170
171 return $ret;
172}
173
174sub dump {
175 my ( @args ) = @_;
176 my $self;
177
178 if ( blessed($args[0]) and $args[0]->isa(__PACKAGE__) ) {
179 $self = shift @args;
180 } else {
181 $self = our $default_dumper;
182 }
183
184 my $method = "dump_as_" . ( $self->should_dump_as_pairs(@args) ? "pairs" : "list" );
185
186 my $dump = $self->$method(1, @args);
187
188 if ( $self->has_max_length ) {
189 if ( length($dump) > $self->max_length ) {
190 $dump = substr($dump, 0, $self->max_length - 3) . "...";
191 }
192 }
193
194 if ( not defined wantarray ) {
195 CORE::warn "$dump\n";
196 } else {
197 return $dump;
198 }
199}
200
201sub should_dump_as_pairs {
202 my ( $self, @what ) = @_;
203
204 return unless $self->pairs;
205
206 return if @what % 2 != 0; # must be an even list
207
208 for ( my $i = 0; $i < @what; $i += 2 ) {
209 return if ref $what[$i]; # plain strings are keys
210 }
211
212 return 1;
213}
214
215sub dump_as_pairs {
216 my ( $self, $depth, @what ) = @_;
217
218 my $truncated;
219 if ( $self->has_max_elements and ( @what / 2 ) > $self->max_elements ) {
220 $truncated = 1;
221 @what = splice(@what, 0, $self->max_elements * 2 );
222 }
223
224 return join($self->list_delim, $self->_dump_as_pairs($depth, @what), ($truncated ? "..." : ()) );
225}
226
227sub _dump_as_pairs {
228 my ( $self, $depth, @what ) = @_;
229
230 return unless @what;
231
232 my ( $key, $value, @rest ) = @what;
233
234 return (
235 ( $self->format_key($depth, $key) . $self->pair_delim . $self->format($depth, $value) ),
236 $self->_dump_as_pairs($depth, @rest),
237 );
238}
239
240sub dump_as_list {
241 my ( $self, $depth, @what ) = @_;
242
243 my $truncated;
244 if ( $self->has_max_elements and @what > $self->max_elements ) {
245 $truncated = 1;
246 @what = splice(@what, 0, $self->max_elements );
247 }
248
249 return join( ", ", ( map { $self->format($depth, $_) } @what ), ($truncated ? "..." : ()) );
250}
251
252sub format {
253 my ( $self, $depth, $value ) = @_;
254
255 defined($value)
256 ? ( ref($value)
257 ? ( blessed($value)
258 ? $self->format_object($depth, $value)
259 : $self->format_ref($depth, $value) )
260 : ( looks_like_number($value)
261 ? $self->format_number($depth, $value)
262 : $self->format_string($depth, $value) ) )
263 : $self->format_undef($depth, $value),
264}
265
266sub format_key {
267 my ( $self, $depth, $key ) = @_;
268 return $key;
269}
270
271sub format_ref {
272 my ( $self, $depth, $ref ) = @_;
273
274 if ( $depth > $self->max_depth ) {
275 return overload::StrVal($ref);
276 } else {
277 my $reftype = reftype($ref);
278 my $method = "format_" . lc reftype $ref;
279
280 if ( $self->can($method) ) {
281 return $self->$method( $depth, $ref );
282 } else {
283 return overload::StrVal($ref);
284 }
285 }
286}
287
288sub format_array {
289 my ( $self, $depth, $array ) = @_;
290
291 my $class = blessed($array) || '';
292
293 return $class . "[ " . $self->dump_as_list($depth + 1, @$array) . " ]";
294}
295
296sub format_hash {
297 my ( $self, $depth, $hash ) = @_;
298
299 my $class = blessed($hash) || '';
300
301 return $class . "{ " . $self->dump_as_pairs($depth + 1, map { $_ => $hash->{$_} } sort keys %$hash) . " }";
302}
303
304sub format_scalar {
305 my ( $self, $depth, $scalar ) = @_;
306
307 my $class = blessed($scalar) || '';
308 $class .= "=" if $class;
309
310 return $class . "\\" . $self->format($depth + 1, $$scalar);
311}
312
313sub format_object {
314 my ( $self, $depth, $object ) = @_;
315
316 if ( $self->objects ) {
317 return $self->format_ref($depth, $object);
318 } else {
319 return $self->stringify ? "$object" : overload::StrVal($object);
320 }
321}
322
323sub format_string {
324 my ( $self, $depth, $str ) =@_;
325 # FIXME use String::Escape ?
326
327 # remove vertical whitespace
328 $str =~ s/\n/\\n/g;
329 $str =~ s/\r/\\r/g;
330
331 # reformat nonprintables
332 $str =~ s/(\P{IsPrint})/"\\x{" . sprintf("%x", ord($1)) . "}"/ge;
333
334 $self->quote($str);
335}
336
337sub quote {
338 my ( $self, $str ) = @_;
339
340 qq{"$str"};
341}
342
343sub format_undef { "undef" }
344
345sub format_number {
346 my ( $self, $depth, $value ) = @_;
347 return "$value";
348}
349
350130µs16.32msour $default_dumper = __PACKAGE__->new;
# spent 6.32ms making 1 call to Moose::Object::new
351
352186µs__PACKAGE__
353
354161µs15.01ms__END__
# spent 5.01ms making 1 call to B::Hooks::EndOfScope::__ANON__[B/Hooks/EndOfScope.pm:26]
Report produced by the NYTProf 4.04 Perl profiler, developed by Tim Bunce and Adam Kaplan.