LiveObjectIndex.pm [plain text]
package DBIx::Class::CDBICompat::LiveObjectIndex;
use strict;
use warnings;
use Scalar::Util qw/weaken/;
use base qw/Class::Data::Inheritable/;
__PACKAGE__->mk_classdata('purge_object_index_every' => 1000);
__PACKAGE__->mk_classdata('live_object_index' => { });
__PACKAGE__->mk_classdata('live_object_init_count' => { });
$Class::DBI::Weaken_Is_Available = 1
unless defined $Class::DBI::Weaken_Is_Available;
__PACKAGE__->mk_classdata('__nocache' => 0);
sub nocache {
my $class = shift;
return $class->__nocache(@_) if @_;
return 1 if $Class::DBI::Weaken_Is_Available == 0;
return $class->__nocache;
}
sub purge_dead_from_object_index {
my $live = shift->live_object_index;
delete @$live{ grep !defined $live->{$_}, keys %$live };
}
sub remove_from_object_index {
my $self = shift;
delete $self->live_object_index->{$self->ID};
}
sub clear_object_index {
my $live = shift->live_object_index;
delete @$live{ keys %$live };
}
sub insert {
my ($self, @rest) = @_;
$self->next::method(@rest);
return $self if $self->nocache;
if (my $key = $self->ID) {
my $live = $self->live_object_index;
weaken($live->{$key} = $self);
$self->purge_dead_from_object_index
if ++$self->live_object_init_count->{count}
% $self->purge_object_index_every == 0;
}
return $self;
}
sub inflate_result {
my ($class, @rest) = @_;
my $new = $class->next::method(@rest);
return $new if $new->nocache;
if (my $key = $new->ID) {
my $live = $class->live_object_index;
return $live->{$key} if $live->{$key};
weaken($live->{$key} = $new);
$class->purge_dead_from_object_index
if ++$class->live_object_init_count->{count}
% $class->purge_object_index_every == 0;
}
return $new;
}
1;