use strict;
use warnings;
-use 5.6.1;
+use 5.008001;
use Storable ();
-use Digest::SHA1 ();
+use Digest::SHA ();
+use Carp::Clan qw/^DBIx::Class/;
use vars qw($VERSION);
-$VERSION = '1.000001';
+$VERSION = '1.001004';
sub new {
my $class = shift;
sub _build_cache_key {
my ($class, $storage, $args, $attrs) = @_;
- return Digest::SHA1::sha1_hex(Storable::nfreeze([ $args, $attrs ]));
+ # compose the query and bind values, like as_query(),
+ # so the cache key is only affected by what the database sees
+ # and not any other cruft in $attrs
+ my $ref = $storage->_select_args_to_query(@{$args}[0..2], $attrs);
+
+ my $conn;
+ if (! ($conn = $storage->_dbh) ) {
+ my $connect_info = $storage->_dbi_connect_info;
+ if (! ref($connect_info->[0]) ) {
+ $conn = { Name => $connect_info->[0], Username => $connect_info->[1] };
+ } else {
+ carp "Invoking connector coderef $connect_info->[0] in order to obtain cache-lookup information";
+ $conn = $connect_info->[0]->();
+ }
+ }
+
+ return $class->_build_cache_key_hash([ $ref, $conn->{Name}, $conn->{Username} || '' ]);
+}
+
+sub _build_cache_key_hash {
+ my ($class, $key_data) = @_;
+ local $Storable::canonical = 1;
+ return Digest::SHA::sha1_hex(Storable::nfreeze( $key_data ));
}
sub _fill_data {
my $cache = $self->{cache_object};
my $key = $self->{cache_key};
return $cache->get($key) || do {
- my $data = [ $self->{inner}->all ];
+ my $data = $self->_fill_data_fetch_all();
$cache->set($key, $data, $self->{cache_for});
$data;
};
}
+sub _fill_data_fetch_all {
+ my ($self) = @_;
+ return [ $self->{inner}->all ];
+}
+
sub clear_cache {
my ($self) = @_;
$self->{cache_object}->remove($self->{cache_key});