1 package # hide from PAUSE
2 DBIx::Class::CDBICompat::LiveObjectIndex;
7 use Scalar::Util qw/weaken/;
10 use base 'DBIx::Class';
12 __PACKAGE__->mk_classdata('purge_object_index_every' => 1000);
13 __PACKAGE__->mk_classdata('live_object_index' => { });
14 __PACKAGE__->mk_classdata('live_object_init_count' => { });
16 # Caching is on by default, but a classic CDBI hack to turn it off is to
17 # set this variable false.
18 $Class::DBI::Weaken_Is_Available = 1
19 unless defined $Class::DBI::Weaken_Is_Available;
20 __PACKAGE__->mk_classdata('__nocache' => 0);
25 return $class->__nocache(@_) if @_;
27 return 1 if $Class::DBI::Weaken_Is_Available == 0;
28 return $class->__nocache;
31 # Ripped from Class::DBI 0.999, all credit due to Tony Bowden for this code,
32 # all blame due to me for whatever bugs I introduced porting it.
34 sub purge_dead_from_object_index {
35 my $live = shift->live_object_index;
36 delete @$live{ grep !defined $live->{$_}, keys %$live };
39 sub remove_from_object_index {
41 delete $self->live_object_index->{$self->ID};
44 sub clear_object_index {
45 my $live = shift->live_object_index;
46 delete @$live{ keys %$live };
50 # And now the fragments to tie it in to DBIx::Class::Table
53 my ($self, @rest) = @_;
54 $self->next::method(@rest);
56 return $self if $self->nocache;
58 # Because the insert will die() if it can't insert into the db (or should)
59 # we can be sure the object *was* inserted if we got this far. In which
60 # case, given primary keys are unique and ID only returns a
61 # value if the object has all its primary keys, we can be sure there
62 # isn't a real one in the object index already because such a record
63 # cannot have existed without the insert failing.
64 if (my $key = $self->ID) {
65 my $live = $self->live_object_index;
66 weaken($live->{$key} = $self);
67 $self->purge_dead_from_object_index
68 if ++$self->live_object_init_count->{count}
69 % $self->purge_object_index_every == 0;
76 my ($class, @rest) = @_;
77 my $new = $class->next::method(@rest);
79 return $new if $new->nocache;
81 if (my $key = $new->ID) {
83 my $live = $class->live_object_index;
84 return $live->{$key} if $live->{$key};
85 weaken($live->{$key} = $new);
86 $class->purge_dead_from_object_index
87 if ++$class->live_object_init_count->{count}
88 % $class->purge_object_index_every == 0;