← 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:40 2010

Filename/home/doy/perl5/perlbrew/perls/perl-5.10.1/lib/site_perl/5.10.1/KiokuDB/Linker.pm
StatementsExecuted 29 statements in 7.59ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1111.60ms71.5msKiokuDB::Linker::::BEGIN@18KiokuDB::Linker::BEGIN@18
11198µs21.6msKiokuDB::Linker::::BEGIN@4KiokuDB::Linker::BEGIN@4
11156µs209µsKiokuDB::Linker::::BEGIN@14KiokuDB::Linker::BEGIN@14
11150µs312µsKiokuDB::Linker::::BEGIN@15KiokuDB::Linker::BEGIN@15
11144µs1.83msKiokuDB::Linker::::BEGIN@20KiokuDB::Linker::BEGIN@20
11142µs204µsKiokuDB::Linker::::BEGIN@13KiokuDB::Linker::BEGIN@13
11125µs25µsKiokuDB::Linker::::BEGIN@16KiokuDB::Linker::BEGIN@16
0000s0sKiokuDB::Linker::::__ANON__[:51]KiokuDB::Linker::__ANON__[:51]
0000s0sKiokuDB::Linker::::__ANON__[:57]KiokuDB::Linker::__ANON__[:57]
0000s0sKiokuDB::Linker::::expand_objectKiokuDB::Linker::expand_object
0000s0sKiokuDB::Linker::::expand_objectsKiokuDB::Linker::expand_objects
0000s0sKiokuDB::Linker::::get_or_load_entriesKiokuDB::Linker::get_or_load_entries
0000s0sKiokuDB::Linker::::get_or_load_entryKiokuDB::Linker::get_or_load_entry
0000s0sKiokuDB::Linker::::get_or_load_objectKiokuDB::Linker::get_or_load_object
0000s0sKiokuDB::Linker::::get_or_load_objectsKiokuDB::Linker::get_or_load_objects
0000s0sKiokuDB::Linker::::inflate_dataKiokuDB::Linker::inflate_data
0000s0sKiokuDB::Linker::::load_entriesKiokuDB::Linker::load_entries
0000s0sKiokuDB::Linker::::load_entryKiokuDB::Linker::load_entry
0000s0sKiokuDB::Linker::::load_objectKiokuDB::Linker::load_object
0000s0sKiokuDB::Linker::::load_objectsKiokuDB::Linker::load_objects
0000s0sKiokuDB::Linker::::load_queueKiokuDB::Linker::load_queue
0000s0sKiokuDB::Linker::::queue_finalizerKiokuDB::Linker::queue_finalizer
0000s0sKiokuDB::Linker::::queue_refKiokuDB::Linker::queue_ref
0000s0sKiokuDB::Linker::::refresh_objectKiokuDB::Linker::refresh_object
0000s0sKiokuDB::Linker::::refresh_objectsKiokuDB::Linker::refresh_objects
0000s0sKiokuDB::Linker::::register_and_expand_entriesKiokuDB::Linker::register_and_expand_entries
0000s0sKiokuDB::Linker::::register_objectKiokuDB::Linker::register_object
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 KiokuDB::Linker;
43198µs243.1ms
# spent 21.6ms (98µs+21.5) within KiokuDB::Linker::BEGIN@4 which was called: # once (98µs+21.5ms) by KiokuDB::BEGIN@12 at line 4
use Moose;
# spent 21.6ms making 1 call to KiokuDB::Linker::BEGIN@4 # spent 21.5ms making 1 call to Moose::Exporter::__ANON__[Moose/Exporter.pm:456]
5
6# perf improvements:
7# use a queue of required objects, queue up references, and bulk fetch
8# bulk fetch arrays
9# could support a Backend::Queueing which allows queuing of IDs for fetching,
10# to help clump or start a request and only read it when it's actually needed
11
12
133116µs2365µs
# spent 204µs (42+161) within KiokuDB::Linker::BEGIN@13 which was called: # once (42µs+161µs) by KiokuDB::BEGIN@12 at line 13
use Carp qw(croak);
# spent 204µs making 1 call to KiokuDB::Linker::BEGIN@13 # spent 161µs making 1 call to Exporter::import
143107µs2361µs
# spent 209µs (56+153) within KiokuDB::Linker::BEGIN@14 which was called: # once (56µs+153µs) by KiokuDB::BEGIN@12 at line 14
use Scalar::Util qw(reftype weaken);
# spent 209µs making 1 call to KiokuDB::Linker::BEGIN@14 # spent 153µs making 1 call to Exporter::import
153116µs2575µs
# spent 312µs (50+262) within KiokuDB::Linker::BEGIN@15 which was called: # once (50µs+262µs) by KiokuDB::BEGIN@12 at line 15
use Symbol qw(gensym);
# spent 312µs making 1 call to KiokuDB::Linker::BEGIN@15 # spent 263µs making 1 call to Exporter::import
16389µs125µs
# spent 25µs within KiokuDB::Linker::BEGIN@16 which was called: # once (25µs+0s) by KiokuDB::BEGIN@12 at line 16
use Tie::ToObject;
# spent 25µs making 1 call to KiokuDB::Linker::BEGIN@16
17
183663µs171.5ms
# spent 71.5ms (1.60+69.9) within KiokuDB::Linker::BEGIN@18 which was called: # once (1.60ms+69.9ms) by KiokuDB::BEGIN@12 at line 18
use KiokuDB::Error::MissingObjects;
# spent 71.5ms making 1 call to KiokuDB::Linker::BEGIN@18
19
2036.01ms23.62ms
# spent 1.83ms (44µs+1.79) within KiokuDB::Linker::BEGIN@20 which was called: # once (44µs+1.79ms) by KiokuDB::BEGIN@12 at line 20
use namespace::clean -except => 'meta';
# spent 1.83ms making 1 call to KiokuDB::Linker::BEGIN@20 # spent 1.79ms making 1 call to namespace::clean::import
21
22121µs116.9mshas live_objects => (
# spent 16.9ms making 1 call to Moose::has
23 isa => "KiokuDB::LiveObjects",
24 is => "ro",
25 required => 1,
26 handles => [qw(id_to_object ids_to_objects object_to_id objects_to_ids id_to_entry ids_to_entries)],
27);
28
29114µs18.05mshas backend => (
# spent 8.05ms making 1 call to Moose::has
30 does => "KiokuDB::Backend",
31 is => "ro",
32 required => 1,
33);
34
35119µs111.1mshas typemap_resolver => (
# spent 11.1ms making 1 call to Moose::has
36 isa => "KiokuDB::TypeMap::Resolver",
37 is => "ro",
38 handles => [qw(expand_method refresh_method)],
39 required => 1,
40);
41
42113µs17.97mshas queue => (
# spent 7.97ms making 1 call to Moose::has
43 isa => "Bool",
44 is => "ro",
45 default => 1,
46);
47
48has _queue => (
49 isa => "ArrayRef",
50 is => "ro",
51 default => sub { [] },
52120µs110.0ms);
# spent 10.0ms making 1 call to Moose::has
53
54has _deferred => (
55 isa => "ArrayRef",
56 is => "ro",
57 default => sub { [] },
58121µs18.11ms);
# spent 8.11ms making 1 call to Moose::has
59
60sub register_object {
61 my ( $self, $entry, $object, @args ) = @_;
62
63 if ( my $id = $entry->id ) {
64 my $l = $self->live_objects;
65
66 $l->register_entry( $id => $entry );
67 $l->register_object( $id => $object, @args );
68 }
69}
70
71sub expand_objects {
72 my ( $self, @entries ) = @_;
73
74 my $l = $self->live_objects;
75
76 my @objects;
77
78 foreach my $entry ( @entries ) {
79 # if the object was referred to in some other entry in @entries, it may
80 # have already been loaded.
81 if ( defined ( my $obj = $l->id_to_object($entry->id) ) ) {
82 push @objects, $obj;
83 } else {
84 $self->inflate_data( $entry, \($objects[@objects]) );
85 }
86 }
87
88 $self->load_queue;
89
90 return @objects;
91}
92
93sub expand_object {
94 my ( $self, $entry ) = @_;
95
96 $self->inflate_data( $entry, \(my $obj) );
97
98 $self->load_queue;
99
100 return $obj;
101}
102
103sub queue_ref {
104 my ( $self, $ref, $into ) = @_;
105
106 if ( $self->queue ) {
107
108 #my $b = $self->backend;
109
110 #if ( $b->can("prefetch") ) {
111 # $b->prefetch($ref->id);
112 #}
113
114 push @{ $self->_queue }, [ $ref, $into ];
115 } else {
116 if ( ref $ref ) {
117 $$into = $self->get_or_load_object($ref->id);
118 weaken($$into) if $ref->is_weak;
119 } else {
120 $$into = $self->get_or_load_object($ref);
121 }
122 }
123}
124
125sub queue_finalizer {
126 my ( $self, @hooks ) = @_;
127
128 if ( $self->queue ) {
129 push @{ $self->_deferred }, @hooks;
130 } else {
131 foreach my $hook ( @hooks ) {
132 $self->$hook();
133 }
134 }
135}
136
137sub load_queue {
138 my $self = shift;
139
140 return unless $self->queue;
141
142 my $queue = $self->_queue;
143 my $deferred = $self->_deferred;
144
145 my @queue = @$queue;
146 my @deferred = @$deferred;
147
148 @$queue = ();
149 @$deferred = ();
150
151 if ( @queue ) {
152 my @ids;
153
154 foreach my $entry ( @queue ) {
155 my $ref = $entry->[0];
156 push @ids, ref($ref) ? $ref->id : $ref;
157 }
158
159 my @objects = $self->get_or_load_objects(@ids);
160
161 foreach my $item ( @queue ) {
162 my ( $data, $into ) = @$item;
163 my $obj = shift @objects;
164
165 $$into = $obj;
166
167 weaken $$into if ref $data and $data->is_weak;
168 }
169 }
170
171 if ( @deferred ) {
172 foreach my $item ( @deferred ) {
173 $self->$item;
174 }
175 }
176}
177
178sub inflate_data {
179 my ( $self, $data, $into, $entry ) = @_;
180
181 # Kinda ugly... inflates $data into the scalar ref in $into
182 # but this allows us to handle weakening properly.
183 # god I hate perl's reftypes, why couldn't they be a little more consistent
184
185 unless ( ref $data ) {
186 $$into = $data;
187 } elsif ( ref $data eq 'KiokuDB::Reference' ) {
188 $self->queue_ref( $data, $into );
189 } elsif ( ref $data eq 'KiokuDB::Entry' ) {
190 if ( my $class = $data->class ) {
191 my $expand_method = $self->expand_method($class);
192 $$into = $self->$expand_method($data);
193 } else {
194 my $obj;
195
196 $self->inflate_data($data->data, \$obj, $data);
197
198 $self->load_queue; # force vivification of $obj
199
200 if ( my $tie = $data->tied ) {
201 if ( $tie eq 'H' ) {
202 tie my %h, "Tie::ToObject" => $obj;
203 $obj = \%h;
204 } elsif ( $tie eq 'A' ) {
205 tie my @a, "Tie::ToObject" => $obj;
206 $obj = \@a;
207 } elsif ( $tie eq 'G' ) {
208 my $glob = gensym();
209 tie *$glob, "Tie::ToObject" => $obj,
210 $obj = $glob;
211 } elsif ( $tie eq 'S' ) {
212 my $scalar;
213 tie $scalar, "Tie::ToObject" => $obj;
214 $obj = \$scalar;
215 } else {
216 die "Don't know how to tie $tie";
217 }
218 }
219
220 $$into = $obj;
221 }
222
223 $data->object($$into);
224 } elsif ( ref($data) eq 'HASH' ) {
225 my %targ;
226 $self->register_object( $entry => \%targ ) if $entry;
227 foreach my $key ( keys %$data ) {
228 $self->inflate_data( $data->{$key}, \$targ{$key} );
229 }
230 $$into = \%targ;
231 } elsif ( ref($data) eq 'ARRAY' ) {
232 my @targ;
233 $self->register_object( $entry => \@targ ) if $entry;
234 for (@$data ) {
235 push @targ, undef;
236 $self->inflate_data( $_, \$targ[-1] );
237 }
238 $$into = \@targ;
239 } elsif ( ref($data) eq 'SCALAR' ) {
240 my $targ = $$data;
241 $self->register_object( $entry => \$targ ) if $entry;
242 $$into = \$targ;
243 } elsif ( ref($data) eq 'REF' ) {
244 my $targ;
245 $self->register_object( $entry => \$targ ) if $entry;
246 $self->inflate_data( $$data, \$targ );
247 $$into = \$targ;
248 } else {
249 if ( blessed($data) ) {
250 # this branch is for passthrough intrinsic values
251 $self->register_object( $entry => $data ) if $entry;
252 $$into = $data;
253 } else {
254 die "unsupported reftype: " . ref $data;
255 }
256 }
257}
258
259sub get_or_load_objects {
260 my ( $self, @ids ) = @_;
261
262 return $self->get_or_load_object($ids[0]) if @ids == 1;
263
264 my %objects;
265 @objects{@ids} = $self->live_objects->ids_to_objects(@ids);
266
267 my @missing = grep { not defined $objects{$_} } keys %objects; # @ids may contain duplicates
268
269 @objects{@missing} = $self->load_objects(@missing);
270
271 return @objects{@ids};
272}
273
274sub load_objects {
275 my ( $self, @ids ) = @_;
276
277 return $self->expand_objects( $self->get_or_load_entries(@ids) );
278}
279
280sub get_or_load_entries {
281 my ( $self, @ids ) = @_;
282
283 my %entries;
284 @entries{@ids} = $self->ids_to_entries(@ids);
285
286 if ( my @load = grep { !$entries{$_} } @ids ) {
287 @entries{@load} = $self->load_entries(@load);
288 }
289
290 return @entries{@ids};
291}
292
293sub load_entries {
294 my ( $self, @ids ) = @_;
295
296 my @entries = $self->backend->get(@ids);
297
298 if ( @entries != @ids or grep { !$_ } @entries ) {
299 my %entries;
300 @entries{@ids} = @entries;
301 my @missing = grep { !$entries{$_} } @ids;
302
303 KiokuDB::Error::MissingObjects->throw( ids => \@missing );
304 }
305
306 my $l = $self->live_objects;
307 foreach my $entry ( @entries ) {
308 $l->register_entry( $entry->id, $entry, in_storage => 1 );
309 }
310
311 return @entries;
312}
313
314sub register_and_expand_entries {
315 my ( $self, @entries ) = @_;
316
317 my $l = $self->live_objects;
318 foreach my $entry ( @entries ) {
319 $l->register_entry( $entry->id, $entry, in_storage => 1 );
320 }
321
322 $self->expand_objects(@entries);
323}
324
325sub get_or_load_object {
326 my ( $self, $id ) = @_;
327
328 if ( defined( my $obj = $self->live_objects->id_to_object($id) ) ) {
329 return $obj;
330 } else {
331 return $self->load_object($id);
332 }
333}
334
335sub refresh_objects {
336 my ( $self, @objects ) = @_;
337
338 $self->refresh_object($_) for @objects;
339}
340
341sub refresh_object {
342 my ( $self, $object ) = @_;
343
344 my $id = $self->object_to_id($object);
345
346 my $entry = $self->load_entry($id);
347
348 my $refresh = $self->refresh_method( $entry->class );
349
350 $self->$refresh($object, $entry);
351 $self->load_queue;
352
353 return $object;
354}
355
356sub get_or_load_entry {
357 my ( $self, $id ) = @_;
358
359 return $self->id_to_entry($id) || $self->load_entry($id);
360}
361
362sub load_entry {
363 my ( $self, $id ) = @_;
364
365 my $entry = ( $self->backend->get($id) )[0]
366 or KiokuDB::Error::MissingObjects->throw( ids => [ $id ] );
367
368 $self->live_objects->register_entry( $id => $entry, in_storage => 1 );
369
370 return $entry;
371}
372
373sub load_object {
374 my ( $self, $id ) = @_;
375
376 my $entry = $self->get_or_load_entry($id);
377
378 return $self->expand_object($entry);
379}
380
381125µs221.9ms__PACKAGE__->meta->make_immutable;
# spent 21.8ms making 1 call to Class::MOP::Class::make_immutable # spent 101µs making 1 call to KiokuDB::Linker::meta
382
383191µs__PACKAGE__
384
385159µs15.66ms__END__
# spent 5.66ms 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.