1 package DBIx::Class::CDBICompat::LiveObjectIndex;
6 use Scalar::Util qw/weaken/;
8 use base qw/Class::Data::Inheritable/;
10 __PACKAGE__->mk_classdata('purge_object_index_every' => 1000);
11 __PACKAGE__->mk_classdata('live_object_index' => { });
12 __PACKAGE__->mk_classdata('live_object_init_count' => { });
14 # Ripped from Class::DBI 0.999, all credit due to Tony Bowden for this code,
15 # all blame due to me for whatever bugs I introduced porting it.
17 sub purge_dead_from_object_index {
18 my $live = shift->live_object_index;
19 delete @$live{ grep !defined $live->{$_}, keys %$live };
22 sub remove_from_object_index {
24 delete $self->live_object_index->{$self->ID};
27 sub clear_object_index {
28 my $live = shift->live_object_index;
29 delete @$live{ keys %$live };
32 # And now the fragments to tie it in to DBIx::Class::Table
35 my ($self, @rest) = @_;
36 $self->next::method(@rest);
37 # Because the insert will die() if it can't insert into the db (or should)
38 # we can be sure the object *was* inserted if we got this far. In which
39 # case, given primary keys are unique and ID only returns a
40 # value if the object has all its primary keys, we can be sure there
41 # isn't a real one in the object index already because such a record
42 # cannot have existed without the insert failing.
43 if (my $key = $self->ID) {
44 my $live = $self->live_object_index;
45 weaken($live->{$key} = $self);
46 $self->purge_dead_from_object_index
47 if ++$self->live_object_init_count->{count}
48 % $self->purge_object_index_every == 0;
50 #use Data::Dumper; warn Dumper($self);
55 my ($class, @rest) = @_;
56 my $new = $class->next::method(@rest);
57 if (my $key = $new->ID) {
59 my $live = $class->live_object_index;
60 return $live->{$key} if $live->{$key};
61 weaken($live->{$key} = $new);
62 $class->purge_dead_from_object_index
63 if ++$class->live_object_init_count->{count}
64 % $class->purge_object_index_every == 0;
71 if (my $key = $self->ID) {
72 $self->remove_from_object_index;
73 my $ret = $self->next::method;
74 $self->live_object_index->{$key} = $self if $self->in_storage;
77 return $self->next::method;