indexed by

diff --git a/lib/DBIx/Data/Collection/Set.pm b/lib/DBIx/Data/Collection/Set.pm
index 41b4ab9..2672dd4 100644 (file)
--- a/lib/DBIx/Data/Collection/Set.pm
+++ b/lib/DBIx/Data/Collection/Set.pm
@@ -3,6 +3,7 @@ package DBIx::Data::Collection::Set;
 use Moose;
 use Method::Signatures::Simple;
 use Data::Perl::Stream::Array;
+use Scalar::Util qw(weaken refaddr);
 
 has _store => (is => 'ro', required => 1, init_arg => 'store');
 
@@ -13,8 +14,9 @@ has _set_over => (is => 'ro', required => 1, init_arg => 'set_over');
 ## member cache (all members)
 
 has _member_cache => (
-  is => 'rw', lazy_build => 1,
+  is => 'ro', lazy_build => 1,
   predicate => '_member_cache_built',
+  writer => '_set_member_cache',
 );
 
 method _build__member_cache {
@@ -88,16 +90,48 @@ method _key_cache_get_id ($id) {
     : ()
 }
 
+method _all_key_cache_members {
+  values %{$self->_key_cache}
+}
+
 ## observers
 
 has _observer_callbacks => (
-  is => 'ro', isa => 'ArrayRef', default => sub { [] }
+  is => 'ro', default => sub { {} },
 );
 
 method _notify_observers ($event, $payload) {
-  foreach my $cb (@{$self->_observer_callbacks}) {
-    $self->$cb($event, $payload);
+  my $oc = $self->_observer_callbacks;
+  foreach my $refaddr (keys %$oc) {
+    my ($obj, $cb) = @{$oc->{$refaddr}};
+    unless (defined $obj) { # weak ref was garbage collected
+      delete $oc->{$refaddr};
+      next;
+    }
+    $obj->$cb($self, $event, $payload);
   }
+  $payload
+}
+
+method _register_observer ($obj, $cb) {
+  my $entry = [ $obj, $cb ];
+  weaken($entry->[0]);
+  $self->_observer_callbacks->{refaddr($obj)} = $entry;
+  return
+}
+
+method _setup_observation_of ($other) {
+  $other->_register_observer($self, method ($from, $event, $payload) {
+    if ($event eq 'add' or $event eq 'get') {
+      $self->_add_to_caches($payload);
+    } elsif ($event eq 'remove') {
+      $self->_remove_from_caches($payload);
+    } elsif ($event eq 'all_members') {
+      # separate arrayref since future add will trigger push()
+      $self->_set_member_cache([ @$payload ]);
+    }
+  });
+  return
 }
 
 ## thunking between the store representation and the set representation
@@ -174,7 +208,9 @@ method get ($spec) {
     return $got
   }
   if (my ($raw) = $self->_get_from_store($self->_deflate_spec($spec))) {
-    return $self->_add_to_key_cache($self->_inflate($raw))
+    return $self->_notify_observers(
+      get => $self->_add_to_key_cache($self->_inflate($raw))
+    );
   }
   return undef # we aren't handling cache misses here yet
 }

diff --git a/lib/DBIx/Data/Collection/Set/IndexableBy.pm b/lib/DBIx/Data/Collection/Set/IndexableBy.pm
index 63e4901..dd90193 100644 (file)
--- a/lib/DBIx/Data/Collection/Set/IndexableBy.pm
+++ b/lib/DBIx/Data/Collection/Set/IndexableBy.pm
@@ -16,9 +16,17 @@ method indexed_by ($by) {
   my $index_spec = $self->_indexable_by->{$by};
   die "${self} not indexable by ${by}" unless $index_spec;
   my $new = DBIx::Data::Collection::Set->new($index_spec);
+  $self->_connect_caches($new);
   $self->_indexed_by->{$by} = $new
 }
 
+method _connect_caches ($new) {
+  $new->_set_member_cache($self->_member_cache) if $self->_member_cache_built;
+  $new->_add_to_caches($_) for $self->_all_key_cache_members;
+  $new->_setup_observation_of($self);
+  $self->_setup_observation_of($new);
+}
+
 __PACKAGE__->meta->make_immutable;
 
 1;

diff --git a/t/02indexed_by.t b/t/02indexed_by.t
index 5b82cec..e300532 100644 (file)
--- a/t/02indexed_by.t
+++ b/t/02indexed_by.t
@@ -12,6 +12,8 @@ sub setup_db { BasicCollection::setup_db @_ }
 
 sub make_store { BasicCollection::make_store @_ }
 
+sub sort_set { BasicCollection::sort_set @_ }
+
 sub make_set {
   BasicCollection::make_set({
       indexable_by => {
@@ -35,11 +37,40 @@ sub make_set {
 
 sub run_tests {
   my @expect = setup_db;
-  my $set = make_set;
+  my $by_id = make_set;
   use Devel::Dwarn;
-  Dwarn $set->get({ id => 1 });
-  my $by_name = $set->indexed_by('name');
-  Dwarn $by_name->get({ name => 'Pterry' });
+  my $id_1 = $by_id->get({ id => 1 });
+  my $by_name = $by_id->indexed_by('name');
+  ok(scalar($by_name->_key_cache_get_object($id_1), 'key cache transfer'));
+  cmp_ok(
+    $id_1, '==', $by_name->get({ name => $id_1->{name} }),
+    'get returns same object'
+  );
+  my $name_pterry = $by_name->get({ name => 'Pterry' });
+  ok(
+    scalar($by_id->_key_cache_get_object($name_pterry)),
+    'key cache reverse transfer'
+  );
+  cmp_ok(
+    $name_pterry, '==', $by_id->get({ id => $name_pterry->{id} }),
+    'get returns same object'
+  );
+  ok(
+    !$by_id->_member_cache_built && !$by_name->_member_cache_built,
+    'No caches yet'
+  );
+  is_deeply(
+    [ sort_set $by_id->flatten ], \@expect,
+    'flatten set',
+  );
+  ok(
+    $by_id->_member_cache_built && $by_name->_member_cache_built,
+    'Both caches filled'
+  );
+  ok(
+    $by_id->_member_cache != $by_name->_member_cache,
+    'Caches are separate arrayrefs'
+  );
   done_testing;
 }