| Filename | /home/doy/perl5/perlbrew/perls/perl-5.10.1/lib/site_perl/5.10.1/KiokuDB/LiveObjects.pm |
| Statements | Executed 47 statements in 12.8ms |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 1 | 1 | 1 | 1.88ms | 96.5ms | KiokuDB::LiveObjects::BEGIN@14 |
| 1 | 1 | 1 | 1.56ms | 633ms | KiokuDB::LiveObjects::BEGIN@13 |
| 1 | 1 | 1 | 1.34ms | 2.96ms | KiokuDB::LiveObjects::BEGIN@7 |
| 1 | 1 | 1 | 179µs | 132ms | KiokuDB::LiveObjects::BEGIN@10 |
| 1 | 1 | 1 | 69µs | 22.0ms | KiokuDB::LiveObjects::BEGIN@4 |
| 1 | 1 | 1 | 54µs | 261µs | KiokuDB::LiveObjects::BEGIN@8 |
| 1 | 1 | 1 | 50µs | 122µs | KiokuDB::LiveObjects::BEGIN@67 |
| 1 | 1 | 1 | 48µs | 9.92ms | KiokuDB::LiveObjects::BEGIN@16 |
| 1 | 1 | 1 | 46µs | 3.14ms | KiokuDB::LiveObjects::BEGIN@18 |
| 1 | 1 | 1 | 46µs | 151µs | KiokuDB::LiveObjects::BEGIN@11 |
| 1 | 1 | 1 | 42µs | 232µs | KiokuDB::LiveObjects::BEGIN@6 |
| 1 | 1 | 1 | 37µs | 160µs | KiokuDB::LiveObjects::BEGIN@9 |
| 0 | 0 | 0 | 0s | 0s | KiokuDB::LiveObjects::__ANON__[:166] |
| 0 | 0 | 0 | 0s | 0s | KiokuDB::LiveObjects::__ANON__[:20] |
| 0 | 0 | 0 | 0s | 0s | KiokuDB::LiveObjects::__ANON__[:48] |
| 0 | 0 | 0 | 0s | 0s | KiokuDB::LiveObjects::__ANON__[:56] |
| 0 | 0 | 0 | 0s | 0s | KiokuDB::LiveObjects::_id_info |
| 0 | 0 | 0 | 0s | 0s | KiokuDB::LiveObjects::_vivify_id_info |
| 0 | 0 | 0 | 0s | 0s | KiokuDB::LiveObjects::check_leaks |
| 0 | 0 | 0 | 0s | 0s | KiokuDB::LiveObjects::clear |
| 0 | 0 | 0 | 0s | 0s | KiokuDB::LiveObjects::detach_scope |
| 0 | 0 | 0 | 0s | 0s | KiokuDB::LiveObjects::id_in_root_set |
| 0 | 0 | 0 | 0s | 0s | KiokuDB::LiveObjects::id_in_storage |
| 0 | 0 | 0 | 0s | 0s | KiokuDB::LiveObjects::id_to_entry |
| 0 | 0 | 0 | 0s | 0s | KiokuDB::LiveObjects::id_to_object |
| 0 | 0 | 0 | 0s | 0s | KiokuDB::LiveObjects::ids_to_entries |
| 0 | 0 | 0 | 0s | 0s | KiokuDB::LiveObjects::ids_to_objects |
| 0 | 0 | 0 | 0s | 0s | KiokuDB::LiveObjects::insert |
| 0 | 0 | 0 | 0s | 0s | KiokuDB::LiveObjects::known_ids |
| 0 | 0 | 0 | 0s | 0s | KiokuDB::LiveObjects::live_entries |
| 0 | 0 | 0 | 0s | 0s | KiokuDB::LiveObjects::live_ids |
| 0 | 0 | 0 | 0s | 0s | KiokuDB::LiveObjects::live_objects |
| 0 | 0 | 0 | 0s | 0s | KiokuDB::LiveObjects::loaded_ids |
| 0 | 0 | 0 | 0s | 0s | KiokuDB::LiveObjects::new_scope |
| 0 | 0 | 0 | 0s | 0s | KiokuDB::LiveObjects::new_txn |
| 0 | 0 | 0 | 0s | 0s | KiokuDB::LiveObjects::object_in_storage |
| 0 | 0 | 0 | 0s | 0s | KiokuDB::LiveObjects::object_to_entry |
| 0 | 0 | 0 | 0s | 0s | KiokuDB::LiveObjects::object_to_id |
| 0 | 0 | 0 | 0s | 0s | KiokuDB::LiveObjects::objects_to_entries |
| 0 | 0 | 0 | 0s | 0s | KiokuDB::LiveObjects::objects_to_ids |
| 0 | 0 | 0 | 0s | 0s | KiokuDB::LiveObjects::register_entry |
| 0 | 0 | 0 | 0s | 0s | KiokuDB::LiveObjects::register_object |
| 0 | 0 | 0 | 0s | 0s | KiokuDB::LiveObjects::remove |
| 0 | 0 | 0 | 0s | 0s | KiokuDB::LiveObjects::remove_scope |
| 0 | 0 | 0 | 0s | 0s | KiokuDB::LiveObjects::rollback_entries |
| 0 | 0 | 0 | 0s | 0s | KiokuDB::LiveObjects::size |
| 0 | 0 | 0 | 0s | 0s | KiokuDB::LiveObjects::update_entries |
| 0 | 0 | 0 | 0s | 0s | KiokuDB::LiveObjects::update_object_entry |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | #!/usr/bin/perl | ||||
| 2 | |||||
| 3 | package KiokuDB::LiveObjects; | ||||
| 4 | 3 | 172µs | 2 | 43.9ms | # spent 22.0ms (69µs+21.9) within KiokuDB::LiveObjects::BEGIN@4 which was called:
# once (69µs+21.9ms) by KiokuDB::BEGIN@13 at line 4 # spent 22.0ms making 1 call to KiokuDB::LiveObjects::BEGIN@4
# spent 21.9ms making 1 call to Moose::Exporter::__ANON__[Moose/Exporter.pm:456] |
| 5 | |||||
| 6 | 3 | 107µs | 2 | 423µs | # spent 232µs (42+190) within KiokuDB::LiveObjects::BEGIN@6 which was called:
# once (42µs+190µs) by KiokuDB::BEGIN@13 at line 6 # spent 232µs making 1 call to KiokuDB::LiveObjects::BEGIN@6
# spent 190µs making 1 call to Exporter::import |
| 7 | 3 | 618µs | 1 | 2.96ms | # spent 2.96ms (1.34+1.62) within KiokuDB::LiveObjects::BEGIN@7 which was called:
# once (1.34ms+1.62ms) by KiokuDB::BEGIN@13 at line 7 # spent 2.96ms making 1 call to KiokuDB::LiveObjects::BEGIN@7 |
| 8 | 3 | 112µs | 2 | 315µs | # spent 261µs (54+207) within KiokuDB::LiveObjects::BEGIN@8 which was called:
# once (54µs+207µs) by KiokuDB::BEGIN@13 at line 8 # spent 261µs making 1 call to KiokuDB::LiveObjects::BEGIN@8
# spent 54µs making 1 call to Hash::Util::FieldHash::Compat::import |
| 9 | 3 | 132µs | 2 | 283µs | # spent 160µs (37+123) within KiokuDB::LiveObjects::BEGIN@9 which was called:
# once (37µs+123µs) by KiokuDB::BEGIN@13 at line 9 # spent 160µs making 1 call to KiokuDB::LiveObjects::BEGIN@9
# spent 123µs making 1 call to Exporter::import |
| 10 | 2 | 243µs | 1 | 132ms | # spent 132ms (179µs+132) within KiokuDB::LiveObjects::BEGIN@10 which was called:
# once (179µs+132ms) by KiokuDB::BEGIN@13 at line 10 # spent 132ms making 1 call to KiokuDB::LiveObjects::BEGIN@10 # spent 641µs executing statements in string eval # includes 7.85ms spent executing 1 call to 1 sub defined therein. |
| 11 | 3 | 105µs | 2 | 256µs | # spent 151µs (46+105) within KiokuDB::LiveObjects::BEGIN@11 which was called:
# once (46µs+105µs) by KiokuDB::BEGIN@13 at line 11 # spent 151µs making 1 call to KiokuDB::LiveObjects::BEGIN@11
# spent 105µs making 1 call to Exporter::import |
| 12 | |||||
| 13 | 3 | 620µs | 1 | 633ms | # spent 633ms (1.56+631) within KiokuDB::LiveObjects::BEGIN@13 which was called:
# once (1.56ms+631ms) by KiokuDB::BEGIN@13 at line 13 # spent 633ms making 1 call to KiokuDB::LiveObjects::BEGIN@13 |
| 14 | 3 | 666µs | 1 | 96.5ms | # spent 96.5ms (1.88+94.6) within KiokuDB::LiveObjects::BEGIN@14 which was called:
# once (1.88ms+94.6ms) by KiokuDB::BEGIN@13 at line 14 # spent 96.5ms making 1 call to KiokuDB::LiveObjects::BEGIN@14 |
| 15 | |||||
| 16 | 3 | 182µs | 2 | 19.8ms | # spent 9.92ms (48µs+9.87) within KiokuDB::LiveObjects::BEGIN@16 which was called:
# once (48µs+9.87ms) by KiokuDB::BEGIN@13 at line 16 # spent 9.92ms making 1 call to KiokuDB::LiveObjects::BEGIN@16
# spent 9.87ms making 1 call to Moose::Exporter::__ANON__[Moose/Exporter.pm:456] |
| 17 | |||||
| 18 | 3 | 896µs | 2 | 6.23ms | # spent 3.14ms (46µs+3.09) within KiokuDB::LiveObjects::BEGIN@18 which was called:
# once (46µs+3.09ms) by KiokuDB::BEGIN@13 at line 18 # spent 3.14ms making 1 call to KiokuDB::LiveObjects::BEGIN@18
# spent 3.09ms making 1 call to namespace::clean::import |
| 19 | |||||
| 20 | 1 | 39µs | 3 | 2.02ms | coerce __PACKAGE__, from "HashRef", via { __PACKAGE__->new($_) }; # spent 2.00ms making 1 call to Moose::Util::TypeConstraints::coerce
# spent 11µs making 1 call to Moose::Util::TypeConstraints::via
# spent 11µs making 1 call to Moose::Util::TypeConstraints::from |
| 21 | |||||
| 22 | 1 | 15µs | 1 | 8.94ms | has clear_leaks => ( # spent 8.94ms making 1 call to Moose::has |
| 23 | isa => "Bool", | ||||
| 24 | is => "rw", | ||||
| 25 | ); | ||||
| 26 | |||||
| 27 | 1 | 13µs | 1 | 8.55ms | has cache => ( # spent 8.55ms making 1 call to Moose::has |
| 28 | isa => "Cache::Ref", | ||||
| 29 | is => "ro", | ||||
| 30 | ); | ||||
| 31 | |||||
| 32 | 1 | 14µs | 1 | 14.8ms | has leak_tracker => ( # spent 14.8ms making 1 call to Moose::has |
| 33 | isa => "CodeRef|Object", | ||||
| 34 | is => "rw", | ||||
| 35 | clearer => "clear_leak_tracker", | ||||
| 36 | ); | ||||
| 37 | |||||
| 38 | 1 | 13µs | 1 | 8.11ms | has keep_entries => ( # spent 8.11ms making 1 call to Moose::has |
| 39 | isa => "Bool", | ||||
| 40 | is => "ro", | ||||
| 41 | default => 1, | ||||
| 42 | ); | ||||
| 43 | |||||
| 44 | has [qw(_objects _entries _object_entries)] => ( | ||||
| 45 | isa => "HashRef", | ||||
| 46 | is => "ro", | ||||
| 47 | init_arg => undef, | ||||
| 48 | default => sub { fieldhash my %hash }, | ||||
| 49 | 1 | 32µs | 1 | 24.0ms | ); # spent 24.0ms making 1 call to Moose::has |
| 50 | |||||
| 51 | has _ids => ( | ||||
| 52 | #metaclass => 'Collection::Hash', | ||||
| 53 | isa => "HashRef", | ||||
| 54 | is => "ro", | ||||
| 55 | init_arg => undef, | ||||
| 56 | default => sub { return {} }, | ||||
| 57 | 1 | 22µs | 1 | 8.34ms | ); # spent 8.34ms making 1 call to Moose::has |
| 58 | |||||
| 59 | sub size { | ||||
| 60 | my $self = shift; | ||||
| 61 | scalar keys %{ $self->_objects }; | ||||
| 62 | } | ||||
| 63 | |||||
| 64 | sub _id_info { | ||||
| 65 | my ( $self, @ids ) = @_; | ||||
| 66 | |||||
| 67 | 3 | 8.45ms | 2 | 194µs | # spent 122µs (50+72) within KiokuDB::LiveObjects::BEGIN@67 which was called:
# once (50µs+72µs) by KiokuDB::BEGIN@13 at line 67 # spent 122µs making 1 call to KiokuDB::LiveObjects::BEGIN@67
# spent 72µs making 1 call to warnings::unimport |
| 68 | |||||
| 69 | if ( @ids == 1 ) { | ||||
| 70 | return $self->_ids->{$ids[0]}; | ||||
| 71 | } else { | ||||
| 72 | return @{ $self->_ids }{@ids}; | ||||
| 73 | } | ||||
| 74 | } | ||||
| 75 | |||||
| 76 | sub _vivify_id_info { | ||||
| 77 | my ( $self, $id ) = @_; | ||||
| 78 | |||||
| 79 | my $info; | ||||
| 80 | |||||
| 81 | my $i = $self->_ids; | ||||
| 82 | |||||
| 83 | unless ( $info = $i->{$id} ) { | ||||
| 84 | $info = { guard => KiokuDB::LiveObjects::Guard->new( $i, $id ) }; | ||||
| 85 | weaken( $i->{$id} = $info ); | ||||
| 86 | } | ||||
| 87 | |||||
| 88 | return $info; | ||||
| 89 | } | ||||
| 90 | |||||
| 91 | sub id_to_object { | ||||
| 92 | my ( $self, $id ) = @_; | ||||
| 93 | |||||
| 94 | if ( my $c = $self->cache ) { | ||||
| 95 | $c->hit($id); | ||||
| 96 | } | ||||
| 97 | |||||
| 98 | if ( my $data = $self->_id_info($id) ) { | ||||
| 99 | return $data->{object}; | ||||
| 100 | } | ||||
| 101 | } | ||||
| 102 | |||||
| 103 | sub ids_to_objects { | ||||
| 104 | my ( $self, @ids ) = @_; | ||||
| 105 | |||||
| 106 | if ( my $c = $self->cache ) { | ||||
| 107 | $c->hit(@ids); | ||||
| 108 | } | ||||
| 109 | |||||
| 110 | map { $_ && $_->{object} } $self->_id_info(@ids); | ||||
| 111 | } | ||||
| 112 | |||||
| 113 | sub known_ids { | ||||
| 114 | keys %{ shift->_ids }; | ||||
| 115 | } | ||||
| 116 | |||||
| 117 | sub live_ids { | ||||
| 118 | my $self = shift; | ||||
| 119 | |||||
| 120 | grep { ref $self->_id_info($_)->{object} } $self->known_ids; | ||||
| 121 | } | ||||
| 122 | |||||
| 123 | sub live_objects { | ||||
| 124 | grep { ref } map { $_->{object} } values %{ shift->_ids }; | ||||
| 125 | } | ||||
| 126 | |||||
| 127 | sub id_to_entry { | ||||
| 128 | my ( $self, $id ) = @_; | ||||
| 129 | |||||
| 130 | if ( my $data = $self->_id_info($id) ) { | ||||
| 131 | return $data->{entry}; | ||||
| 132 | } | ||||
| 133 | |||||
| 134 | return undef; | ||||
| 135 | } | ||||
| 136 | |||||
| 137 | sub ids_to_entries { | ||||
| 138 | my ( $self, @ids ) = @_; | ||||
| 139 | |||||
| 140 | return $self->id_to_entry($ids[0]) if @ids == 1; | ||||
| 141 | |||||
| 142 | map { $_ && $_->{entry} } $self->_id_info(@ids); | ||||
| 143 | } | ||||
| 144 | |||||
| 145 | sub loaded_ids { | ||||
| 146 | my $self = shift; | ||||
| 147 | |||||
| 148 | grep { $self->_id_info($_)->{entry} } $self->known_ids; | ||||
| 149 | } | ||||
| 150 | |||||
| 151 | sub live_entries { | ||||
| 152 | grep { ref } map { $_->{entry} } values %{ shift->_ids }; | ||||
| 153 | } | ||||
| 154 | |||||
| 155 | 1 | 16µs | 1 | 17.7ms | has current_scope => ( # spent 17.7ms making 1 call to Moose::has |
| 156 | isa => "KiokuDB::LiveObjects::Scope", | ||||
| 157 | is => "ro", | ||||
| 158 | writer => "_set_current_scope", | ||||
| 159 | clearer => "_clear_current_scope", | ||||
| 160 | weak_ref => 1, | ||||
| 161 | ); | ||||
| 162 | |||||
| 163 | has _known_scopes => ( | ||||
| 164 | isa => "Set::Object", | ||||
| 165 | is => "ro", | ||||
| 166 | default => sub { Set::Object::Weak->new }, | ||||
| 167 | 1 | 20µs | 1 | 9.06ms | ); # spent 9.06ms making 1 call to Moose::has |
| 168 | |||||
| 169 | sub detach_scope { | ||||
| 170 | my ( $self, $scope ) = @_; | ||||
| 171 | |||||
| 172 | my $current_scope = $self->current_scope; | ||||
| 173 | if ( defined($current_scope) and refaddr($current_scope) == refaddr($scope) ) { | ||||
| 174 | if ( my $parent = $scope->parent ) { | ||||
| 175 | $self->_set_current_scope($parent); | ||||
| 176 | } else { | ||||
| 177 | $self->_clear_current_scope; | ||||
| 178 | } | ||||
| 179 | } | ||||
| 180 | } | ||||
| 181 | |||||
| 182 | sub remove_scope { | ||||
| 183 | my ( $self, $scope ) = @_; | ||||
| 184 | |||||
| 185 | $self->detach_scope($scope); | ||||
| 186 | |||||
| 187 | $scope->clear; | ||||
| 188 | |||||
| 189 | my $known = $self->_known_scopes; | ||||
| 190 | |||||
| 191 | $known->remove($scope); | ||||
| 192 | |||||
| 193 | if ( $known->size == 0 ) { | ||||
| 194 | $self->check_leaks; | ||||
| 195 | } | ||||
| 196 | } | ||||
| 197 | |||||
| 198 | sub check_leaks { | ||||
| 199 | my $self = shift; | ||||
| 200 | |||||
| 201 | return if $self->_known_scopes->size; | ||||
| 202 | |||||
| 203 | my @still_live = grep { defined } $self->live_objects; | ||||
| 204 | |||||
| 205 | if (@still_live) { | ||||
| 206 | # immortal objects are still live but not considered leaks | ||||
| 207 | my $o = $self->_objects; | ||||
| 208 | my @leaked = grep { | ||||
| 209 | my $i = $o->{$_}; | ||||
| 210 | not($i->{immortal} or $i->{cache}) | ||||
| 211 | } @still_live; | ||||
| 212 | |||||
| 213 | weaken($_) for @leaked; | ||||
| 214 | @still_live = (); | ||||
| 215 | |||||
| 216 | if ( $self->clear_leaks ) { | ||||
| 217 | $self->clear; | ||||
| 218 | } | ||||
| 219 | |||||
| 220 | if ( my $tracker = $self->leak_tracker and grep { defined } @leaked ) { | ||||
| 221 | if ( ref($tracker) eq 'CODE' ) { | ||||
| 222 | $tracker->(grep { defined } @leaked); | ||||
| 223 | } else { | ||||
| 224 | $tracker->leaked_objects(grep { defined } @leaked); | ||||
| 225 | } | ||||
| 226 | } | ||||
| 227 | |||||
| 228 | if ( my $cache = $self->cache and $self->size > $self->cache->size * 1.1 ) { | ||||
| 229 | # all live objects are marked 'cached', but the live object set is bigger than | ||||
| 230 | # the cache size. This means objects have been expired out of the | ||||
| 231 | # cache but are still referenced by other cache entries | ||||
| 232 | |||||
| 233 | do { | ||||
| 234 | $cache->expire( 1 + int ( ( $self->size - $cache->size ) / 2 ) ); | ||||
| 235 | } while $self->size > $cache->size; | ||||
| 236 | } | ||||
| 237 | } | ||||
| 238 | } | ||||
| 239 | |||||
| 240 | 1 | 14µs | 1 | 16.8ms | has txn_scope => ( # spent 16.8ms making 1 call to Moose::has |
| 241 | isa => "KiokuDB::LiveObjects::TXNScope", | ||||
| 242 | is => "ro", | ||||
| 243 | writer => "_set_txn_scope", | ||||
| 244 | clearer => "_clear_txn_scope", | ||||
| 245 | weak_ref => 1, | ||||
| 246 | ); | ||||
| 247 | |||||
| 248 | sub new_scope { | ||||
| 249 | my $self = shift; | ||||
| 250 | |||||
| 251 | my $parent = $self->current_scope; | ||||
| 252 | |||||
| 253 | my $child = KiokuDB::LiveObjects::Scope->new( | ||||
| 254 | ( $parent ? ( parent => $parent ) : () ), | ||||
| 255 | live_objects => $self, | ||||
| 256 | ); | ||||
| 257 | |||||
| 258 | $self->_set_current_scope($child); | ||||
| 259 | |||||
| 260 | $self->_known_scopes->insert($child); | ||||
| 261 | |||||
| 262 | return $child; | ||||
| 263 | } | ||||
| 264 | |||||
| 265 | sub new_txn { | ||||
| 266 | my $self = shift; | ||||
| 267 | |||||
| 268 | return unless $self->keep_entries; | ||||
| 269 | |||||
| 270 | my $parent = $self->txn_scope; | ||||
| 271 | |||||
| 272 | my $child = KiokuDB::LiveObjects::TXNScope->new( | ||||
| 273 | ( $parent ? ( parent => $parent ) : () ), | ||||
| 274 | live_objects => $self, | ||||
| 275 | ); | ||||
| 276 | |||||
| 277 | $self->_set_txn_scope($child); | ||||
| 278 | |||||
| 279 | return $child; | ||||
| 280 | } | ||||
| 281 | |||||
| 282 | sub objects_to_ids { | ||||
| 283 | my ( $self, @objects ) = @_; | ||||
| 284 | |||||
| 285 | return $self->object_to_id($objects[0]) | ||||
| 286 | if @objects == 1; | ||||
| 287 | |||||
| 288 | map { $_ && $_->{guard}->key } @{ $self->_objects }{@objects}; | ||||
| 289 | } | ||||
| 290 | |||||
| 291 | sub object_to_id { | ||||
| 292 | my ( $self, $obj ) = @_; | ||||
| 293 | |||||
| 294 | if ( my $info = $self->_objects->{$obj} ){ | ||||
| 295 | return $info->{guard}->key; | ||||
| 296 | } | ||||
| 297 | |||||
| 298 | return undef; | ||||
| 299 | } | ||||
| 300 | |||||
| 301 | sub objects_to_entries { | ||||
| 302 | my ( $self, @objects ) = @_; | ||||
| 303 | |||||
| 304 | return $self->ids_to_entries( $self->objects_to_ids(@objects) ); | ||||
| 305 | } | ||||
| 306 | |||||
| 307 | sub object_to_entry { | ||||
| 308 | my ( $self, $obj ) = @_; | ||||
| 309 | |||||
| 310 | return $self->id_to_entry( $self->object_to_id($obj) || return ); | ||||
| 311 | } | ||||
| 312 | |||||
| 313 | sub id_in_root_set { | ||||
| 314 | my ( $self, $id ) = @_; | ||||
| 315 | |||||
| 316 | if ( my $data = $self->_id_info($id) ) { | ||||
| 317 | return $data->{root}; | ||||
| 318 | } | ||||
| 319 | |||||
| 320 | return undef; | ||||
| 321 | } | ||||
| 322 | |||||
| 323 | sub id_in_storage { | ||||
| 324 | my ( $self, $id ) = @_; | ||||
| 325 | |||||
| 326 | if ( my $data = $self->_id_info($id) ) { | ||||
| 327 | return $data->{in_storage}; | ||||
| 328 | } | ||||
| 329 | |||||
| 330 | return undef; | ||||
| 331 | } | ||||
| 332 | |||||
| 333 | |||||
| 334 | sub object_in_storage { | ||||
| 335 | my ( $self, $object ) = @_; | ||||
| 336 | |||||
| 337 | $self->id_in_storage( $self->object_to_id($object) || return ); | ||||
| 338 | } | ||||
| 339 | |||||
| 340 | sub update_object_entry { | ||||
| 341 | my ( $self, $object, $entry, %args ) = @_; | ||||
| 342 | |||||
| 343 | |||||
| 344 | my $s = $self->current_scope or croak "no open live object scope"; | ||||
| 345 | |||||
| 346 | my $info = $self->_objects->{$object} or croak "Object not yet registered"; | ||||
| 347 | $self->_entries->{$entry} = $info; | ||||
| 348 | |||||
| 349 | @{$info}{keys %args} = values %args; | ||||
| 350 | weaken($info->{entry} = $entry); | ||||
| 351 | |||||
| 352 | if ( $self->keep_entries ) { | ||||
| 353 | $self->_object_entries->{$object} = $entry; | ||||
| 354 | |||||
| 355 | if ( $args{in_storage} and my $txs = $self->txn_scope ) { | ||||
| 356 | $txs->push($entry); | ||||
| 357 | } | ||||
| 358 | } | ||||
| 359 | |||||
| 360 | # break cycle for passthrough objects | ||||
| 361 | if ( ref($entry->data) and refaddr($object) == refaddr($entry->data) ) { | ||||
| 362 | weaken($entry->{data}); # FIXME there should be a MOP way to do this | ||||
| 363 | } | ||||
| 364 | } | ||||
| 365 | |||||
| 366 | sub register_object { | ||||
| 367 | my ( $self, $id, $object, %args ) = @_; | ||||
| 368 | |||||
| 369 | my $s = $self->current_scope or croak "no open live object scope"; | ||||
| 370 | |||||
| 371 | croak($object, " is not a reference") unless ref($object); | ||||
| 372 | croak($object, " is an entry") if blessed($object) && $object->isa("KiokuDB::Entry"); | ||||
| 373 | |||||
| 374 | if ( my $id = $self->object_to_id($object) ) { | ||||
| 375 | croak($object, " is already registered as $id") | ||||
| 376 | } | ||||
| 377 | |||||
| 378 | my $info = $self->_vivify_id_info($id); | ||||
| 379 | |||||
| 380 | if ( ref $info->{object} ) { | ||||
| 381 | croak "An object with the id '$id' is already registered ($info->{object} != $object)" | ||||
| 382 | } | ||||
| 383 | |||||
| 384 | $self->_objects->{$object} = $info; | ||||
| 385 | |||||
| 386 | weaken($info->{object} = $object); | ||||
| 387 | |||||
| 388 | if ( my $entry = $info->{entry} ) { | ||||
| 389 | # break cycle for passthrough objects | ||||
| 390 | if ( ref($entry->data) and refaddr($object) == refaddr($entry->data) ) { | ||||
| 391 | weaken($entry->{data}); # FIXME there should be a MOP way to do this | ||||
| 392 | } | ||||
| 393 | |||||
| 394 | if ( $self->keep_entries ) { | ||||
| 395 | $self->_object_entries->{$object} = $entry; | ||||
| 396 | } | ||||
| 397 | } | ||||
| 398 | |||||
| 399 | @{$info}{keys %args} = values %args; | ||||
| 400 | |||||
| 401 | if ( $args{cache} and my $c = $self->cache ) { | ||||
| 402 | $c->set( $id => $object ); | ||||
| 403 | } | ||||
| 404 | |||||
| 405 | $s->push($object); | ||||
| 406 | } | ||||
| 407 | |||||
| 408 | sub register_entry { | ||||
| 409 | my ( $self, $id, $entry, %args ) = @_; | ||||
| 410 | |||||
| 411 | my $info = $self->_vivify_id_info($id); | ||||
| 412 | |||||
| 413 | $self->_entries->{$entry} = $info; | ||||
| 414 | |||||
| 415 | confess "$entry" unless $entry->isa("KiokuDB::Entry"); | ||||
| 416 | @{$info}{keys %args, 'root'} = ( values %args, $entry->root ); | ||||
| 417 | |||||
| 418 | weaken($info->{entry} = $entry); | ||||
| 419 | |||||
| 420 | if ( $args{in_storage} and $self->keep_entries and my $txs = $self->txn_scope ) { | ||||
| 421 | $txs->push($entry); | ||||
| 422 | } | ||||
| 423 | } | ||||
| 424 | |||||
| 425 | sub insert { | ||||
| 426 | my ( $self, @pairs ) = @_; | ||||
| 427 | |||||
| 428 | croak "The arguments must be an list of pairs of IDs/Entries to objects" | ||||
| 429 | unless @pairs % 2 == 0; | ||||
| 430 | |||||
| 431 | croak "no open live object scope" unless $self->current_scope; | ||||
| 432 | |||||
| 433 | my @register; | ||||
| 434 | while ( @pairs ) { | ||||
| 435 | my ( $id, $object ) = splice @pairs, 0, 2; | ||||
| 436 | my $entry; | ||||
| 437 | |||||
| 438 | if ( ref $id ) { | ||||
| 439 | $entry = $id; | ||||
| 440 | $id = $entry->id; | ||||
| 441 | } | ||||
| 442 | |||||
| 443 | confess("blah") unless $id; | ||||
| 444 | |||||
| 445 | croak($object, " is not a reference") unless ref($object); | ||||
| 446 | croak($object, " is an entry") if blessed($object) && $object->isa("KiokuDB::Entry"); | ||||
| 447 | |||||
| 448 | if ( $entry ) { | ||||
| 449 | $self->register_entry( $id => $entry, in_storage => 1 ); | ||||
| 450 | $self->register_object( $id => $object ); | ||||
| 451 | } else { | ||||
| 452 | $self->register_object( $id => $object ); | ||||
| 453 | } | ||||
| 454 | } | ||||
| 455 | } | ||||
| 456 | |||||
| 457 | sub update_entries { | ||||
| 458 | my ( $self, @pairs ) = @_; | ||||
| 459 | my @entries; | ||||
| 460 | |||||
| 461 | while ( @pairs ) { | ||||
| 462 | my ( $object, $entry ) = splice @pairs, 0, 2; | ||||
| 463 | |||||
| 464 | $self->register_entry( $entry->id => $entry, in_storage => 1 ); | ||||
| 465 | |||||
| 466 | unless ( $self->object_to_id($object) ) { | ||||
| 467 | $self->register_object( $entry->id => $object ); | ||||
| 468 | } else { | ||||
| 469 | $self->update_object_entry( $object, $entry ); | ||||
| 470 | } | ||||
| 471 | } | ||||
| 472 | |||||
| 473 | return; | ||||
| 474 | } | ||||
| 475 | |||||
| 476 | sub rollback_entries { | ||||
| 477 | my ( $self, @entries ) = @_; | ||||
| 478 | |||||
| 479 | foreach my $entry ( reverse @entries ) { | ||||
| 480 | my $info = $self->_id_info($entry->id); | ||||
| 481 | |||||
| 482 | if ( my $prev = $entry->prev ) { | ||||
| 483 | weaken($info->{entry} = $prev); | ||||
| 484 | } else { | ||||
| 485 | delete $info->{entry}; | ||||
| 486 | } | ||||
| 487 | } | ||||
| 488 | } | ||||
| 489 | |||||
| 490 | sub remove { | ||||
| 491 | my ( $self, @stuff ) = @_; | ||||
| 492 | |||||
| 493 | my ( $i, $o, $e, $oe ) = ( $self->_ids, $self->_objects, $self->_entries, $self->_object_entries ); | ||||
| 494 | |||||
| 495 | while ( @stuff ) { | ||||
| 496 | my $thing = shift @stuff; | ||||
| 497 | |||||
| 498 | if ( ref $thing ) { | ||||
| 499 | # FIXME make this a bit less zealous? | ||||
| 500 | my $info; | ||||
| 501 | if ( $info = delete $o->{$thing} ) { | ||||
| 502 | delete $info->{object}; | ||||
| 503 | delete $oe->{$thing}; | ||||
| 504 | push @stuff, $info->{entry} if $info->{entry}; | ||||
| 505 | } elsif ( $info = delete $e->{$thing} ) { | ||||
| 506 | delete $info->{entry}; | ||||
| 507 | push @stuff, $info->{object} if ref $info->{object}; | ||||
| 508 | } | ||||
| 509 | } else { | ||||
| 510 | my $info = delete $i->{$thing}; | ||||
| 511 | push @stuff, grep { ref } delete @{$info}{qw(entry object)}; | ||||
| 512 | } | ||||
| 513 | } | ||||
| 514 | } | ||||
| 515 | |||||
| 516 | sub clear { | ||||
| 517 | my $self = shift; | ||||
| 518 | |||||
| 519 | # don't waste too much time in DESTROY | ||||
| 520 | $_->{guard}->dismiss for values %{ $self->_ids }; | ||||
| 521 | |||||
| 522 | %{ $self->_ids } = (); | ||||
| 523 | %{ $self->_objects } = (); | ||||
| 524 | %{ $self->_object_entries } = (); | ||||
| 525 | %{ $self->_entries } = (); | ||||
| 526 | |||||
| 527 | $self->_clear_current_scope; | ||||
| 528 | $self->_known_scopes->clear; | ||||
| 529 | } | ||||
| 530 | |||||
| 531 | 1 | 26µs | 2 | 28.0ms | __PACKAGE__->meta->make_immutable; # spent 27.9ms making 1 call to Class::MOP::Class::make_immutable
# spent 101µs making 1 call to KiokuDB::LiveObjects::meta |
| 532 | |||||
| 533 | 1 | 110µs | __PACKAGE__ | ||
| 534 | |||||
| 535 | 1 | 141µs | 1 | 11.5ms | __END__ # spent 11.5ms making 1 call to B::Hooks::EndOfScope::__ANON__[B/Hooks/EndOfScope.pm:26] |