-package DBIx::Class::CDBICompat::LiveObjectIndex;
+package # hide from PAUSE
+ DBIx::Class::CDBICompat::LiveObjectIndex;
use strict;
use warnings;
__PACKAGE__->mk_classdata('live_object_index' => { });
__PACKAGE__->mk_classdata('live_object_init_count' => { });
+# Caching is on by default, but a classic CDBI hack to turn it off is to
+# set this variable false.
+$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;
+}
+
# Ripped from Class::DBI 0.999, all credit due to Tony Bowden for this code,
# all blame due to me for whatever bugs I introduced porting it.
delete @$live{ keys %$live };
}
+
# And now the fragments to tie it in to DBIx::Class::Table
sub insert {
my ($self, @rest) = @_;
$self->next::method(@rest);
- # Because the insert will die() if it can't insert into the db (or should)
- # we can be sure the object *was* inserted if we got this far. In which
- # case, given primary keys are unique and ID only returns a
- # value if the object has all its primary keys, we can be sure there
- # isn't a real one in the object index already because such a record
- # cannot have existed without the insert failing.
+
+ return $self if $self->nocache;
+
+ # Because the insert will die() if it can't insert into the db (or should)
+ # we can be sure the object *was* inserted if we got this far. In which
+ # case, given primary keys are unique and ID only returns a
+ # value if the object has all its primary keys, we can be sure there
+ # isn't a real one in the object index already because such a record
+ # cannot have existed without the insert failing.
if (my $key = $self->ID) {
my $live = $self->live_object_index;
weaken($live->{$key} = $self);
if ++$self->live_object_init_count->{count}
% $self->purge_object_index_every == 0;
}
- #use Data::Dumper; warn Dumper($self);
+
return $self;
}
sub inflate_result {
my ($class, @rest) = @_;
my $new = $class->next::method(@rest);
+
+ return $new if $new->nocache;
+
if (my $key = $new->ID) {
#warn "Key $key";
my $live = $class->live_object_index;
return $new;
}
-sub discard_changes {
- my ($self) = @_;
- if (my $key = $self->ID) {
- $self->remove_from_object_index;
- my $ret = $self->next::method;
- $self->live_object_index->{$key} = $self if $self->in_storage;
- return $ret;
- } else {
- return $self->next::method;
- }
-}
-
1;