From: Matt S Trout <matthewt@hercule.scsys.co.uk>
Date: Sun, 10 Jan 2010 20:29:08 +0000 (+0000)
Subject: beginnings of IndexableBy
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=dbsrgits%2FDBIx-Data-Store-old.git;a=commitdiff_plain;h=9f2b6cc851c56588042ad4f1eddeebe8c869ec10

beginnings of IndexableBy
---

diff --git a/lib/DBIx/Data/Collection/Set.pm b/lib/DBIx/Data/Collection/Set.pm
index 1acf096..41b4ab9 100644
--- a/lib/DBIx/Data/Collection/Set.pm
+++ b/lib/DBIx/Data/Collection/Set.pm
@@ -6,7 +6,7 @@ use Data::Perl::Stream::Array;
 
 has _store => (is => 'ro', required => 1, init_arg => 'store');
 
-has _class => (is => 'ro', predicate => '_has_class');
+has _class => (is => 'ro', predicate => '_has_class', init_arg => 'class');
 
 has _set_over => (is => 'ro', required => 1, init_arg => 'set_over');
 
@@ -23,13 +23,15 @@ method _build__member_cache {
   while (my ($raw) = $stream->next) {
     my $obj = do {
       if (my ($obj) = $self->_key_cache_get_raw($raw)) {
-        $obj # can't $self->_merge($obj, $raw) since $obj might have changed
+        # can't just $self->_merge($obj, $raw) since $obj might have changed
+        $self->_refresh($obj, $raw)
       } else {
         $self->_add_to_key_cache($self->_inflate($raw))
       }
     };
     push @cache, $obj;
   }
+  $self->_notify_observers(all_members => \@cache);
   \@cache
 }
 
@@ -86,6 +88,18 @@ method _key_cache_get_id ($id) {
     : ()
 }
 
+## observers
+
+has _observer_callbacks => (
+  is => 'ro', isa => 'ArrayRef', default => sub { [] }
+);
+
+method _notify_observers ($event, $payload) {
+  foreach my $cb (@{$self->_observer_callbacks}) {
+    $self->$cb($event, $payload);
+  }
+}
+
 ## thunking between the store representation and the set representation
 #
 # _inflate is raw data -> final repr
@@ -109,6 +123,14 @@ method _merge ($obj, $raw) {
   $obj
 }
 
+method _refresh ($obj, $raw) {
+  # if $obj has been changed but not flushed we'd destroy data doing
+  # a blind merge - but if $obj has change tracking of some sort then
+  # we -could- do something safely, so this method exists to be mangled
+  # by subclasses
+  $obj
+}
+
 method _deflate_spec ($spec) {
   $spec
 }
@@ -166,6 +188,7 @@ method _get_from_store ($raw) {
 method add ($new) {
   $self->_add_to_store($new);
   $self->_add_to_caches($new);
+  $self->_notify_observers(add => $new);
   $new
 }
 
@@ -186,6 +209,7 @@ method _add_to_caches ($new) {
 method remove ($old) {
   $self->_remove_from_store($old);
   $self->_remove_from_caches($old);
+  $self->_notify_observers(remove => $old);
   $old
 }
 
diff --git a/lib/DBIx/Data/Collection/Set/IndexableBy.pm b/lib/DBIx/Data/Collection/Set/IndexableBy.pm
new file mode 100644
index 0000000..63e4901
--- /dev/null
+++ b/lib/DBIx/Data/Collection/Set/IndexableBy.pm
@@ -0,0 +1,24 @@
+package DBIx::Data::Collection::Set::IndexableBy;
+
+use Moose;
+use Method::Signatures::Simple;
+
+extends 'DBIx::Data::Collection::Set';
+
+has _indexed_by => (is => 'ro', default => sub { {} });
+
+has _indexable_by => (is => 'ro', required => 1, init_arg => 'indexable_by');
+
+method indexed_by ($by) {
+  if (my $cached = $self->_indexed_by->{$by}) {
+    return $cached
+  }
+  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->_indexed_by->{$by} = $new
+}
+
+__PACKAGE__->meta->make_immutable;
+
+1;
diff --git a/t/01basic_collection.t b/t/01basic_collection.t
index 9fded99..e9fb8e1 100644
--- a/t/01basic_collection.t
+++ b/t/01basic_collection.t
@@ -12,13 +12,11 @@ use warnings FATAL => 'all';
 
 my $dsn = 'dbi:SQLite:tmp.db';
 
-my @expect;
-
 sub sort_set {
   sort { $a->{name} cmp $b->{name} } @_
 }
 
-{
+sub setup_db {
   unlink('tmp.db');
   my $dbh = DBI->connect($dsn);
   $dbh->do(q{
@@ -30,111 +28,127 @@ sub sort_set {
   my $pop = $dbh->prepare(q{INSERT INTO person (name) VALUES (?)});
   my @names = qw(Joe Jim Bob Pterry);
   $pop->execute($_) for @names;
-  @expect = sort_set do {
+  return sort_set do {
     my $id = 0; map +{ id => ++$id, name => $_ }, @names
   };
 }
 
+my $db_store = DBIx::Data::Store->connect($dsn);
+
+sub make_store {
+  my ($crud) = @_;
+  DBIx::Data::Store::CRUD->new(
+    raw_store => $db_store,
+    select_sql => q{SELECT id, name FROM person},
+    select_column_order => [ qw(id name) ],
+    %$crud
+  );
+}
+
 sub make_set {
-  my ($set, $crud) = @_;
-  DBIx::Data::Collection::Set->new(
+  my ($set, $crud, $class) = @_;
+  ($class || 'DBIx::Data::Collection::Set')->new(
     set_over => [ 'id' ],
-    store => DBIx::Data::Store::CRUD->new(
-      raw_store => DBIx::Data::Store->connect($dsn),
-      select_sql => q{SELECT id, name FROM person},
-      select_column_order => [ qw(id name) ],
-      %$crud,
-    ),
+    store => make_store($crud),
     %$set
   );
 }
 
-my $set = make_set;
+sub run_tests {
 
-is_deeply([ sort_set $set->flatten ], \@expect, 'Basic data out ok (flatten)');
+  my @expect = setup_db;
 
-{
-  my $stream = $set->as_stream;
+  my $set = make_set;
 
-  my @got; while (my ($next) = $stream->next) { push @got, $next }
+  is_deeply([ sort_set $set->flatten ], \@expect, 'Basic data out ok (flatten)');
 
-  is_deeply([ sort_set @got ], \@expect, 'Basic data out ok (stream)');
-}
+  {
+    my $stream = $set->as_stream;
 
-$set = make_set { class => 'Spoon' };
+    my @got; while (my ($next) = $stream->next) { push @got, $next }
 
-is_deeply(
-  [ sort_set $set->flatten ],
-  [ map { bless({ %$_ }, 'Spoon') } @expect ],
-  'Basic data with class out ok'
-);
+    is_deeply([ sort_set @got ], \@expect, 'Basic data out ok (stream)');
+  }
 
-$set = make_set {}, {
-  insert_sql => q{INSERT INTO person (name) VALUES (?) },
-  insert_argument_order => [ 'name' ],
-  insert_command_constructor => sub {
-    require DBIx::Data::Store::Command::Insert::LastInsertId;
-    my $self = shift;
-    DBIx::Data::Store::Command::Insert::LastInsertId->new(
-      id_column => 'id',
-      raw_store => $self->raw_store,
-      insert_call_command => $self->raw_store->new_call_command(@_)
-    );
-  },
-  delete_sql => q{DELETE FROM person WHERE id = ?},
-  delete_argument_order => [ 'id' ],
-};
+  $set = make_set { class => 'Spoon' };
 
-my $doug = $set->add({ name => 'Doug' });
+  is_deeply(
+    [ sort_set $set->flatten ],
+    [ map { bless({ %$_ }, 'Spoon') } @expect ],
+    'Basic data with class out ok'
+  );
 
-ok($doug->{id}, 'id filled out in new row');
+  $set = make_set {}, {
+    insert_sql => q{INSERT INTO person (name) VALUES (?) },
+    insert_argument_order => [ 'name' ],
+    insert_command_constructor => sub {
+      require DBIx::Data::Store::Command::Insert::LastInsertId;
+      my $self = shift;
+      DBIx::Data::Store::Command::Insert::LastInsertId->new(
+        id_column => 'id',
+        raw_store => $self->raw_store,
+        insert_call_command => $self->raw_store->new_call_command(@_)
+      );
+    },
+    delete_sql => q{DELETE FROM person WHERE id = ?},
+    delete_argument_order => [ 'id' ],
+  };
 
-my ($set_doug) = grep $_->{name} eq 'Doug', $set->flatten;
+  my $doug = $set->add({ name => 'Doug' });
 
-ok($set_doug, 'new row exists in flatten');
+  ok($doug->{id}, 'id filled out in new row');
 
-cmp_ok(refaddr($doug), '==', refaddr($set_doug), 'Same hashref returned');
+  my ($set_doug) = grep $_->{name} eq 'Doug', $set->flatten;
 
-$set->remove($doug);
+  ok($set_doug, 'new row exists in flatten');
 
-is_deeply([ sort_set $set->flatten ], \@expect, 'new row gone after remove');
+  cmp_ok(refaddr($doug), '==', refaddr($set_doug), 'Same hashref returned');
 
-$set = make_set;
+  $set->remove($doug);
 
-is_deeply([ sort_set $set->flatten ], \@expect, 'new row still gone on reload');
+  is_deeply([ sort_set $set->flatten ], \@expect, 'new row gone after remove');
 
-$set = make_set {}, {
-  update_sql => q{UPDATE person SET name = ? WHERE id = ?},
-  update_argument_order => [ qw(name id) ]
-};
+  $set = make_set;
 
-my ($pterry) = grep $_->{name} eq 'Pterry', $set->flatten;
+  is_deeply([ sort_set $set->flatten ], \@expect, 'new row still gone on reload');
 
-$pterry->{name} = 'Sir Pterry'; # http://xrl.us/bgse8s
+  $set = make_set {}, {
+    update_sql => q{UPDATE person SET name = ? WHERE id = ?},
+    update_argument_order => [ qw(name id) ]
+  };
+
+  my ($pterry) = grep $_->{name} eq 'Pterry', $set->flatten;
 
-$set->_update_in_store($pterry);
+  $pterry->{name} = 'Sir Pterry'; # http://xrl.us/bgse8s
 
-$set = make_set;
+  $set->_update_in_store($pterry);
 
-my ($fresh_pterry) = grep $_->{name} =~ /Pterry/, $set->flatten;
+  $set = make_set;
 
-is($fresh_pterry->{name}, 'Sir Pterry', 'Update persisted correctly');
+  my ($fresh_pterry) = grep $_->{name} =~ /Pterry/, $set->flatten;
 
-$set = make_set {}, {
-  select_single_sql => q{SELECT id, name FROM person WHERE id = ?},
-  select_single_argument_order => [ qw(id) ],
-};
+  is($fresh_pterry->{name}, 'Sir Pterry', 'Update persisted correctly');
+
+  $set = make_set {}, {
+    select_single_sql => q{SELECT id, name FROM person WHERE id = ?},
+    select_single_argument_order => [ qw(id) ],
+  };
 
-my $pterry_id = (grep $_->{name} eq 'Pterry', @expect)[0]->{id};
+  my $pterry_id = (grep $_->{name} eq 'Pterry', @expect)[0]->{id};
 
-$pterry = $set->get({ id => $pterry_id });
+  $pterry = $set->get({ id => $pterry_id });
 
-is($pterry->{name}, 'Sir Pterry', 'Pterry retrieved by id');
+  is($pterry->{name}, 'Sir Pterry', 'Pterry retrieved by id');
 
-ok(!defined($set->get({ id => -1 })), 'undef on missing id');
+  ok(!defined($set->get({ id => -1 })), 'undef on missing id');
 
-$pterry->{name} = 'Pterry';
+  $pterry->{name} = 'Pterry';
+
+  is_deeply([ sort_set $set->flatten ], \@expect, 'Basic data after fetch by id');
+
+  done_testing;
+}
 
-is_deeply([ sort_set $set->flatten ], \@expect, 'Basic data after fetch by id');
+run_tests unless caller;
 
-done_testing;
+1;
diff --git a/t/02indexed_by.t b/t/02indexed_by.t
new file mode 100644
index 0000000..5b82cec
--- /dev/null
+++ b/t/02indexed_by.t
@@ -0,0 +1,46 @@
+use strict;
+use warnings FATAL => 'all';
+use Test::More;
+use DBIx::Data::Collection::Set::IndexableBy;
+
+BEGIN {
+  package BasicCollection;
+  require 't/01basic_collection.t'
+}
+
+sub setup_db { BasicCollection::setup_db @_ }
+
+sub make_store { BasicCollection::make_store @_ }
+
+sub make_set {
+  BasicCollection::make_set({
+      indexable_by => {
+        name => {
+          set_over => [ 'name' ],
+          store => make_store({
+            select_single_sql => q{SELECT id, name FROM person WHERE name = ?},
+            select_single_argument_order => [ qw(name) ],
+          }),
+        },
+      },
+    },
+    {
+      select_single_sql => q{SELECT id, name FROM person WHERE id = ?},
+      select_single_argument_order => [ qw(id) ],
+    },
+    'DBIx::Data::Collection::Set::IndexableBy'
+  )
+}
+
+
+sub run_tests {
+  my @expect = setup_db;
+  my $set = make_set;
+  use Devel::Dwarn;
+  Dwarn $set->get({ id => 1 });
+  my $by_name = $set->indexed_by('name');
+  Dwarn $by_name->get({ name => 'Pterry' });
+  done_testing;
+}
+
+run_tests unless caller;