streamlined db connection disambiguation, per Tim Bunce

[dbsrgits/DBIx-Class-Cursor-Cached.git] / lib / DBIx / Class / Cursor / Cached.pm

diff --git a/lib/DBIx/Class/Cursor/Cached.pm b/lib/DBIx/Class/Cursor/Cached.pm
index 6197958..b9a9ec6 100644 (file)
--- a/lib/DBIx/Class/Cursor/Cached.pm
+++ b/lib/DBIx/Class/Cursor/Cached.pm
@@ -5,10 +5,11 @@ use warnings;
 use 5.6.1;
 use Storable ();
 use Digest::SHA1 ();
+use Carp::Clan qw/^DBIx::Class/;
 
 use vars qw($VERSION);
 
-$VERSION = '0.999001_01';
+$VERSION = '1.000001';
 
 sub new {
   my $class = shift;
@@ -34,7 +35,7 @@ sub new {
 
 sub next {
   my ($self) = @_;
-  return @{($self->{data} ||= $self->_fill_data)->{$self->{pos}++}||[]};
+  return @{($self->{data} ||= $self->_fill_data)->[$self->{pos}++]||[]};
 }
 
 sub all {
@@ -48,7 +49,25 @@ sub reset {
 
 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]->();
+    }
+  }
+  
+  local $Storable::canonical = 1;
+  return Digest::SHA1::sha1_hex(Storable::nfreeze( [ $ref, $conn->{Name}, $conn->{Username} || '' ] ));
+
 }
 
 sub _fill_data {
@@ -68,6 +87,8 @@ sub clear_cache {
   delete $self->{data};
 }
 
+sub cache_key { shift->{cache_key} }
+
 1;
 
 =head1 NAME