← Index
NYTProf Performance Profile   « block view • line view • sub view »
For -e
  Run on Wed Nov 17 21:39:01 2010
Reported on Wed Nov 17 22:04:58 2010

Filename/home/doy/perl5/perlbrew/perls/perl-5.10.1/lib/site_perl/5.10.1/Data/Visitor.pm
StatementsExecuted 32 statements in 10.9ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1112.21ms2.31msData::Visitor::::BEGIN@8Data::Visitor::BEGIN@8
1111.07ms1.79msData::Visitor::::BEGIN@10Data::Visitor::BEGIN@10
11169µs23.1msData::Visitor::::BEGIN@4Data::Visitor::BEGIN@4
11158µs120µsData::Visitor::::BEGIN@370Data::Visitor::BEGIN@370
11149µs224µsData::Visitor::::BEGIN@17Data::Visitor::BEGIN@17
11145µs315µsData::Visitor::::BEGIN@6Data::Visitor::BEGIN@6
11143µs4.60msData::Visitor::::BEGIN@14Data::Visitor::BEGIN@14
11142µs110µsData::Visitor::::BEGIN@12Data::Visitor::BEGIN@12
11120µs20µsData::Visitor::::BEGIN@7Data::Visitor::BEGIN@7
0000s0sData::Visitor::::_get_mappingData::Visitor::_get_mapping
0000s0sData::Visitor::::_print_traceData::Visitor::_print_trace
0000s0sData::Visitor::::_register_mappingData::Visitor::_register_mapping
0000s0sData::Visitor::::retain_magicData::Visitor::retain_magic
0000s0sData::Visitor::::traceData::Visitor::trace
0000s0sData::Visitor::::visitData::Visitor::visit
0000s0sData::Visitor::::visit_arrayData::Visitor::visit_array
0000s0sData::Visitor::::visit_array_entriesData::Visitor::visit_array_entries
0000s0sData::Visitor::::visit_array_entryData::Visitor::visit_array_entry
0000s0sData::Visitor::::visit_codeData::Visitor::visit_code
0000s0sData::Visitor::::visit_globData::Visitor::visit_glob
0000s0sData::Visitor::::visit_hashData::Visitor::visit_hash
0000s0sData::Visitor::::visit_hash_entriesData::Visitor::visit_hash_entries
0000s0sData::Visitor::::visit_hash_entryData::Visitor::visit_hash_entry
0000s0sData::Visitor::::visit_hash_keyData::Visitor::visit_hash_key
0000s0sData::Visitor::::visit_hash_valueData::Visitor::visit_hash_value
0000s0sData::Visitor::::visit_no_rec_checkData::Visitor::visit_no_rec_check
0000s0sData::Visitor::::visit_normal_arrayData::Visitor::visit_normal_array
0000s0sData::Visitor::::visit_normal_globData::Visitor::visit_normal_glob
0000s0sData::Visitor::::visit_normal_hashData::Visitor::visit_normal_hash
0000s0sData::Visitor::::visit_normal_scalarData::Visitor::visit_normal_scalar
0000s0sData::Visitor::::visit_objectData::Visitor::visit_object
0000s0sData::Visitor::::visit_refData::Visitor::visit_ref
0000s0sData::Visitor::::visit_scalarData::Visitor::visit_scalar
0000s0sData::Visitor::::visit_seenData::Visitor::visit_seen
0000s0sData::Visitor::::visit_tiedData::Visitor::visit_tied
0000s0sData::Visitor::::visit_tied_arrayData::Visitor::visit_tied_array
0000s0sData::Visitor::::visit_tied_globData::Visitor::visit_tied_glob
0000s0sData::Visitor::::visit_tied_hashData::Visitor::visit_tied_hash
0000s0sData::Visitor::::visit_tied_scalarData::Visitor::visit_tied_scalar
0000s0sData::Visitor::::visit_valueData::Visitor::visit_value
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 Data::Visitor;
43242µs246.1ms
# spent 23.1ms (69µs+23.0) within Data::Visitor::BEGIN@4 which was called: # once (69µs+23.0ms) by KiokuDB::Collapser::BEGIN@18 at line 4
use Moose;
# spent 23.1ms making 1 call to Data::Visitor::BEGIN@4 # spent 23.0ms making 1 call to Moose::Exporter::__ANON__[Moose/Exporter.pm:456]
5
63110µs2585µs
# spent 315µs (45+270) within Data::Visitor::BEGIN@6 which was called: # once (45µs+270µs) by KiokuDB::Collapser::BEGIN@18 at line 6
use Scalar::Util qw/blessed refaddr reftype weaken isweak/;
# spent 315µs making 1 call to Data::Visitor::BEGIN@6 # spent 270µs making 1 call to Exporter::import
7377µs120µs
# spent 20µs within Data::Visitor::BEGIN@7 which was called: # once (20µs+0s) by KiokuDB::Collapser::BEGIN@18 at line 7
use overload ();
# spent 20µs making 1 call to Data::Visitor::BEGIN@7
83529µs12.31ms
# spent 2.31ms (2.21+102µs) within Data::Visitor::BEGIN@8 which was called: # once (2.21ms+102µs) by KiokuDB::Collapser::BEGIN@18 at line 8
use Symbol ();
# spent 2.31ms making 1 call to Data::Visitor::BEGIN@8
9
103491µs11.79ms
# spent 1.79ms (1.07+723µs) within Data::Visitor::BEGIN@10 which was called: # once (1.07ms+723µs) by KiokuDB::Collapser::BEGIN@18 at line 10
use Tie::ToObject;
# spent 1.79ms making 1 call to Data::Visitor::BEGIN@10
11
123116µs2178µs
# spent 110µs (42+68) within Data::Visitor::BEGIN@12 which was called: # once (42µs+68µs) by KiokuDB::Collapser::BEGIN@18 at line 12
no warnings 'recursion';
# spent 110µs making 1 call to Data::Visitor::BEGIN@12 # spent 68µs making 1 call to warnings::unimport
13
143209µs29.16ms
# spent 4.60ms (43µs+4.56) within Data::Visitor::BEGIN@14 which was called: # once (43µs+4.56ms) by KiokuDB::Collapser::BEGIN@18 at line 14
use namespace::clean -except => 'meta';
# spent 4.60ms making 1 call to Data::Visitor::BEGIN@14 # spent 4.56ms making 1 call to namespace::clean::import
15
16# the double not makes this no longer undef, so exempt from useless constant warnings in older perls
1737.14ms2399µs
# spent 224µs (49+175) within Data::Visitor::BEGIN@17 which was called: # once (49µs+175µs) by KiokuDB::Collapser::BEGIN@18 at line 17
use constant DEBUG => not not our $DEBUG || $ENV{DATA_VISITOR_DEBUG};
# spent 224µs making 1 call to Data::Visitor::BEGIN@17 # spent 175µs making 1 call to constant::import
18
1914µsour $VERSION = "0.27";
20
21112µs18.79mshas tied_as_objects => (
# spent 8.79ms making 1 call to Moose::has
22 isa => "Bool",
23 is => "rw",
24);
25
26# currently broken
27115µs18.39mshas weaken => (
# spent 8.39ms making 1 call to Moose::has
28 isa => "Bool",
29 is => "rw",
30 default => 0,
31);
32
33sub trace {
34 my ( $self, $category, @msg ) = @_;
35
36 our %DEBUG;
37
38 if ( $DEBUG{$category} or !exists($DEBUG{$category}) ) {
39 $self->_print_trace("$self: " . join("",
40 ( " " x ( $self->{depth} - 1 ) ),
41 ( join(" ", "$category:", map { overload::StrVal($_) } @msg) ),
42 ));
43 }
44}
45
46sub _print_trace {
47 my ( $self, @msg ) = @_;
48 warn "@msg\n";
49}
50
51sub visit {
52 my $self = shift;
53
54 local $self->{depth} = (($self->{depth}||0) + 1) if DEBUG;
55 my $seen_hash = local $self->{_seen} = ($self->{_seen} || {}); # delete it after we're done with the whole visit
56
57 my @ret;
58
59 foreach my $data ( @_ ) {
60 $self->trace( flow => visit => $data ) if DEBUG;
61
62 if ( my $refaddr = ref($data) && refaddr($data) ) { # only references need recursion checks
63 $seen_hash->{weak} ||= isweak($data) if $self->weaken;
64
65 if ( exists $seen_hash->{$refaddr} ) {
66 $self->trace( mapping => found_mapping => from => $data, to => $seen_hash->{$refaddr} ) if DEBUG;
67 push @ret, $self->visit_seen( $data, $seen_hash->{$refaddr} );
68 next;
69 } else {
70 $self->trace( mapping => no_mapping => $data ) if DEBUG;
71 }
72 }
73
74 if ( defined wantarray ) {
75 push @ret, scalar($self->visit_no_rec_check($data));
76 } else {
77 $self->visit_no_rec_check($data);
78 }
79 }
80
81 return ( @_ == 1 ? $ret[0] : @ret );
82}
83
84sub visit_seen {
85 my ( $self, $data, $result ) = @_;
86 return $result;
87}
88
89sub _get_mapping {
90 my ( $self, $data ) = @_;
91 $self->{_seen}{ refaddr($data) };
92}
93
94sub _register_mapping {
95 my ( $self, $data, $new_data ) = @_;
96 return $new_data unless ref $data;
97 $self->trace( mapping => register_mapping => from => $data, to => $new_data, in => (caller(1))[3] ) if DEBUG;
98 $self->{_seen}{ refaddr($data) } = $new_data;
99}
100
101sub visit_no_rec_check {
102 my ( $self, $data ) = @_;
103
104 if ( blessed($data) ) {
105 return $self->visit_object($_[1]);
106 } elsif ( ref $data ) {
107 return $self->visit_ref($_[1]);
108 }
109
110 return $self->visit_value($_[1]);
111}
112
113sub visit_object {
114 my ( $self, $object ) = @_;
115 $self->trace( flow => visit_object => $object ) if DEBUG;
116
117 if ( not defined wantarray ) {
118 $self->_register_mapping( $object, $object );
119 $self->visit_value($_[1]);
120 return;
121 } else {
122 return $self->_register_mapping( $object, $self->visit_value($_[1]) );
123 }
124}
125
126sub visit_ref {
127 my ( $self, $data ) = @_;
128
129 local $self->{depth} = (($self->{depth}||0) + 1) if DEBUG;
130
131 $self->trace( flow => visit_ref => $data ) if DEBUG;
132
133 my $reftype = reftype $data;
134
135 $reftype = "SCALAR" if $reftype =~ /^(?:REF|LVALUE|VSTRING)$/;
136
137 my $method = $self->can(lc "visit_$reftype") || "visit_value";
138
139 return $self->$method($_[1]);
140}
141
142sub visit_value {
143 my ( $self, $value ) = @_;
144 $self->trace( flow => visit_value => $value ) if DEBUG;
145 return $value;
146}
147
148sub visit_hash {
149 my ( $self, $hash ) = @_;
150
151 local $self->{depth} = (($self->{depth}||0) + 1) if DEBUG;
152
153 if ( defined(tied(%$hash)) and $self->tied_as_objects ) {
154 return $self->visit_tied_hash(tied(%$hash), $_[1]);
155 } else {
156 return $self->visit_normal_hash($_[1]);
157 }
158}
159
160sub visit_normal_hash {
161 my ( $self, $hash ) = @_;
162
163 if ( defined wantarray ) {
164 my $new_hash = {};
165 $self->_register_mapping( $hash, $new_hash );
166
167 %$new_hash = $self->visit_hash_entries($_[1]);
168
169 return $self->retain_magic( $_[1], $new_hash );
170 } else {
171 $self->_register_mapping($hash, $hash);
172 $self->visit_hash_entries($_[1]);
173 return;
174 }
175}
176
177sub visit_tied_hash {
178 my ( $self, $tied, $hash ) = @_;
179
180 if ( defined wantarray ) {
181 my $new_hash = {};
182 $self->_register_mapping( $hash, $new_hash );
183
184 if ( blessed(my $new_tied = $self->visit_tied($_[1], $_[2])) ) {
185 $self->trace( data => tying => var => $new_hash, to => $new_tied ) if DEBUG;
186 tie %$new_hash, 'Tie::ToObject', $new_tied;
187 return $self->retain_magic($_[2], $new_hash);
188 } else {
189 return $self->visit_normal_hash($_[2]);
190 }
191 } else {
192 $self->_register_mapping($hash, $hash);
193 $self->visit_tied($_[1], $_[2]);
194 return;
195 }
196}
197
198sub visit_hash_entries {
199 my ( $self, $hash ) = @_;
200
201 if ( not defined wantarray ) {
202 $self->visit_hash_entry( $_, $hash->{$_}, $hash ) for keys %$hash;
203 } else {
204 return map { $self->visit_hash_entry( $_, $hash->{$_}, $hash ) } keys %$hash;
205 }
206}
207
208sub visit_hash_entry {
209 my ( $self, $key, $value, $hash ) = @_;
210
211 $self->trace( flow => visit_hash_entry => key => $key, value => $value ) if DEBUG;
212
213 if ( not defined wantarray ) {
214 $self->visit_hash_key($key,$value,$hash);
215 $self->visit_hash_value($_[2],$key,$hash);
216 } else {
217 return (
218 $self->visit_hash_key($key,$value,$hash),
219 $self->visit_hash_value($_[2],$key,$hash),
220 );
221 }
222}
223
224sub visit_hash_key {
225 my ( $self, $key, $value, $hash ) = @_;
226 $self->visit($key);
227}
228
229sub visit_hash_value {
230 my ( $self, $value, $key, $hash ) = @_;
231 $self->visit($_[1]);
232}
233
234sub visit_array {
235 my ( $self, $array ) = @_;
236
237 if ( defined(tied(@$array)) and $self->tied_as_objects ) {
238 return $self->visit_tied_array(tied(@$array), $_[1]);
239 } else {
240 return $self->visit_normal_array($_[1]);
241 }
242}
243
244sub visit_normal_array {
245 my ( $self, $array ) = @_;
246
247 if ( defined wantarray ) {
248 my $new_array = [];
249 $self->_register_mapping( $array, $new_array );
250
251 @$new_array = $self->visit_array_entries($_[1]);
252
253 return $self->retain_magic( $_[1], $new_array );
254 } else {
255 $self->_register_mapping( $array, $array );
256 $self->visit_array_entries($_[1]);
257
258 return;
259 }
260}
261
262sub visit_tied_array {
263 my ( $self, $tied, $array ) = @_;
264
265 if ( defined wantarray ) {
266 my $new_array = [];
267 $self->_register_mapping( $array, $new_array );
268
269 if ( blessed(my $new_tied = $self->visit_tied($_[1], $_[2])) ) {
270 $self->trace( data => tying => var => $new_array, to => $new_tied ) if DEBUG;
271 tie @$new_array, 'Tie::ToObject', $new_tied;
272 return $self->retain_magic($_[2], $new_array);
273 } else {
274 return $self->visit_normal_array($_[2]);
275 }
276 } else {
277 $self->_register_mapping( $array, $array );
278 $self->visit_tied($_[1], $_[2]);
279
280 return;
281 }
282}
283
284sub visit_array_entries {
285 my ( $self, $array ) = @_;
286
287 if ( not defined wantarray ) {
288 $self->visit_array_entry( $array->[$_], $_, $array ) for 0 .. $#$array;
289 } else {
290 return map { $self->visit_array_entry( $array->[$_], $_, $array ) } 0 .. $#$array;
291 }
292}
293
294sub visit_array_entry {
295 my ( $self, $value, $index, $array ) = @_;
296 $self->visit($_[1]);
297}
298
299sub visit_scalar {
300 my ( $self, $scalar ) = @_;
301
302 if ( defined(tied($$scalar)) and $self->tied_as_objects ) {
303 return $self->visit_tied_scalar(tied($$scalar), $_[1]);
304 } else {
305 return $self->visit_normal_scalar($_[1]);
306 }
307}
308
309sub visit_normal_scalar {
310 my ( $self, $scalar ) = @_;
311
312 if ( defined wantarray ) {
313 my $new_scalar;
314 $self->_register_mapping( $scalar, \$new_scalar );
315
316 $new_scalar = $self->visit( $$scalar );
317
318 return $self->retain_magic($_[1], \$new_scalar);
319 } else {
320 $self->_register_mapping( $scalar, $scalar );
321 $self->visit( $$scalar );
322 return;
323 }
324
325}
326
327sub visit_tied_scalar {
328 my ( $self, $tied, $scalar ) = @_;
329
330 if ( defined wantarray ) {
331 my $new_scalar;
332 $self->_register_mapping( $scalar, \$new_scalar );
333
334 if ( blessed(my $new_tied = $self->visit_tied($_[1], $_[2])) ) {
335 $self->trace( data => tying => var => $new_scalar, to => $new_tied ) if DEBUG;
336 tie $new_scalar, 'Tie::ToObject', $new_tied;
337 return $self->retain_magic($_[2], \$new_scalar);
338 } else {
339 return $self->visit_normal_scalar($_[2]);
340 }
341 } else {
342 $self->_register_mapping( $scalar, $scalar );
343 $self->visit_tied($_[1], $_[2]);
344 return;
345 }
346}
347
348sub visit_code {
349 my ( $self, $code ) = @_;
350 $self->visit_value($_[1]);
351}
352
353sub visit_glob {
354 my ( $self, $glob ) = @_;
355
356 if ( defined(tied(*$glob)) and $self->tied_as_objects ) {
357 return $self->visit_tied_glob(tied(*$glob), $_[1]);
358 } else {
359 return $self->visit_normal_glob($_[1]);
360 }
361}
362
363sub visit_normal_glob {
364 my ( $self, $glob ) = @_;
365
366 if ( defined wantarray ) {
367 my $new_glob = Symbol::gensym();
368 $self->_register_mapping( $glob, $new_glob );
369
37031.80ms2183µs
# spent 120µs (58+63) within Data::Visitor::BEGIN@370 which was called: # once (58µs+63µs) by KiokuDB::Collapser::BEGIN@18 at line 370
no warnings 'misc'; # Undefined value assigned to typeglob
# spent 120µs making 1 call to Data::Visitor::BEGIN@370 # spent 62µs making 1 call to warnings::unimport
371 *$new_glob = $self->visit( *$glob{$_} || next ) for qw/SCALAR ARRAY HASH/;
372
373 return $self->retain_magic($_[1], $new_glob);
374 } else {
375 $self->_register_mapping( $glob, $glob );
376 $self->visit( *$glob{$_} || next ) for qw/SCALAR ARRAY HASH/;
377 return;
378 }
379}
380
381sub visit_tied_glob {
382 my ( $self, $tied, $glob ) = @_;
383
384 if ( defined wantarray ) {
385 my $new_glob = Symbol::gensym();
386 $self->_register_mapping( $glob, \$new_glob );
387
388 if ( blessed(my $new_tied = $self->visit_tied($_[1], $_[2])) ) {
389 $self->trace( data => tying => var => $new_glob, to => $new_tied ) if DEBUG;
390 tie *$new_glob, 'Tie::ToObject', $new_tied;
391 return $self->retain_magic($_[2], $new_glob);
392 } else {
393 return $self->visit_normal_glob($_[2]);
394 }
395 } else {
396 $self->_register_mapping( $glob, $glob );
397 $self->visit_tied($_[1], $_[2]);
398 return;
399 }
400}
401
402sub retain_magic {
403 my ( $self, $proto, $new ) = @_;
404
405 if ( blessed($proto) and !blessed($new) ) {
406 $self->trace( data => blessing => $new, ref $proto ) if DEBUG;
407 bless $new, ref $proto;
408 }
409
410 my $seen_hash = $self->{_seen};
411 if ( $seen_hash->{weak} ) {
412 require Data::Alias;
413
414 my @weak_refs;
415 foreach my $value ( Data::Alias::deref($proto) ) {
416 if ( ref $value and isweak($value) ) {
417 push @weak_refs, refaddr $value;
418 }
419 }
420
421 if ( @weak_refs ) {
422 my %targets = map { refaddr($_) => 1 } @{ $self->{_seen} }{@weak_refs};
423 foreach my $value ( Data::Alias::deref($new) ) {
424 if ( ref $value and $targets{refaddr($value)}) {
425 push @{ $seen_hash->{weakened} ||= [] }, $value; # keep a ref around
426 weaken($value);
427 }
428 }
429 }
430 }
431
432 # FIXME real magic, too
433
434 return $new;
435}
436
437sub visit_tied {
438 my ( $self, $tied, $var ) = @_;
439 $self->trace( flow => visit_tied => $tied ) if DEBUG;
440 $self->visit($_[1]); # as an object eventually
441}
442
443153µs413.3ms__PACKAGE__->meta->make_immutable if __PACKAGE__->meta->can("make_immutable");
# spent 13.2ms making 1 call to Class::MOP::Class::make_immutable # spent 165µs making 2 calls to Data::Visitor::meta, avg 82µs/call # spent 7µs making 1 call to UNIVERSAL::can
444
445157µs__PACKAGE__
446
447156µs114.2ms__END__
# spent 14.2ms 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.