From: Matt S Trout <matthewt@hercule.scsys.co.uk>
Date: Sun, 29 Aug 2010 03:51:56 +0000 (+0100)
Subject: add basic inflation wrapper and simple inflator
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=dbsrgits%2FDBIx-Data-Store.git;a=commitdiff_plain;h=34b924ec9d5b4be02d6d7de4cfa36a41e212a6b6

add basic inflation wrapper and simple inflator
---

diff --git a/lib/DBIx/Data/Collection/Set/Wrapper/Inflate.pm b/lib/DBIx/Data/Collection/Set/Wrapper/Inflate.pm
new file mode 100644
index 0000000..0330181
--- /dev/null
+++ b/lib/DBIx/Data/Collection/Set/Wrapper/Inflate.pm
@@ -0,0 +1,63 @@
+package DBIx::Data::Collection::Set::Wrapper::Inflate;
+
+use strictures 1;
+
+sub new {
+  my $proto = shift;
+  bless({ %{$_[0]} }, ref($proto)||$proto);
+}
+
+sub _inflator { shift->{inflator} }
+sub _inner { shift->{inner} }
+
+sub flatten {
+  my ($self) = @_;
+  map $self->_inflator->inflate($_), $self->_inner->flatten;
+}
+
+sub to_stream {
+  my ($self) = @_;
+  my $inflator = $self->_inflator;
+  DBIx::Data::Stream::Mapped->new({
+    inner => $self->_inner->to_stream,
+    mapper => sub { $inflator->inflate($_) }
+  });
+}
+
+sub clear { shift->_inner->clear }
+
+sub get {
+  my ($self, $spec) = @_;
+  my $inflator = $self->_inflator;
+  $inflator->inflate(
+    $self->_inner->get(
+      $inflator->deflate_spec($spec)
+    )
+  );
+}
+
+sub replace {
+  my ($self, $spec, $body) = @_;
+  my $inflator = $self->_inflator;
+  $self->_inner->replace(
+    $inflator->deflate_spec($spec),
+    $inflator->deflate_body($body),
+  );
+}
+
+sub add {
+  my ($self, $body) = @_;
+  my $inflator = $self->_inflator;
+  $inflator->inflate(
+    $self->_inner->add(
+      $inflator->deflate_body($body)
+    )
+  );
+}
+
+sub remove {
+  my ($self, $spec) = @_;
+  $self->_inner->remove($self->_inflator->deflate_spec($spec));
+}
+
+1;
diff --git a/lib/DBIx/Data/Store/Inflator/Simple.pm b/lib/DBIx/Data/Store/Inflator/Simple.pm
new file mode 100644
index 0000000..c39aa1a
--- /dev/null
+++ b/lib/DBIx/Data/Store/Inflator/Simple.pm
@@ -0,0 +1,31 @@
+package DBIx::Data::Store::Inflator::Simple;
+
+use strictures 1;
+
+sub new {
+  my $proto = shift;
+  bless({ %{$_[0]} }, ref($proto)||$proto);
+}
+
+sub _class { shift->{class} }
+sub _spec_columns { shift->{spec_columns} }
+sub _body_columns { shift->{body_columns} }
+sub _all_columns { shift->{all_columns} }
+
+sub inflate {
+  my ($self, $raw) = @_;
+  my %new; @new{@{$self->_all_columns}} = @$raw;
+  bless(\%new, $self->_class);
+}
+
+sub deflate_spec {
+  my ($self, $spec) = @_;
+  [ @{$spec}{@{$self->_spec_columns}} ];
+}
+
+sub deflate_body {
+  my ($self, $spec) = @_;
+  [ @{$spec}{@{$self->_body_columns}} ];
+}
+
+1;
diff --git a/lib/DBIx/Data/Stream/Mapped.pm b/lib/DBIx/Data/Stream/Mapped.pm
new file mode 100644
index 0000000..0e2e77b
--- /dev/null
+++ b/lib/DBIx/Data/Stream/Mapped.pm
@@ -0,0 +1,29 @@
+package DBIx::Data::Stream::Mapped;
+
+use strictures 1;
+
+sub new {
+  my $proto = shift;
+  bless({ %{$_[0]} }, ref($proto)||$proto);
+}
+
+sub _inner { shift->{inner} }
+sub _clear_inner { delete shift->{inner} }
+sub _mapper { shift->{mapper} }
+
+sub next {
+  return unless my $inner = (my $self = shift)->_inner;
+  # If we were aiming for a "true" perl-like map then we should
+  # elegantly handle the case where the map function returns 0 events
+  # and the case where it returns >1 - if you're reading this comment
+  # because you wanted it to do that, now would be the time to fix it :)
+  my $mapper = $self->_mapper;
+  if (my ($next) = $inner->next) {
+    local $_ = $next;
+    return $mapper->($next);
+  }
+  $self->_clear_inner;
+  return
+}
+
+1;
diff --git a/t/crud.t b/t/crud.t
index 71214c1..d01eca2 100644
--- a/t/crud.t
+++ b/t/crud.t
@@ -49,7 +49,7 @@ sub make_store {
       insert_one => sub {
         my ($store, undef, $dbh, $args) = @_;
         $store->_sth_for($dbh, 'INSERT INTO names (name) VALUES (?)', $args);
-        [ $dbh->last_insert_id(undef,undef,undef,undef) ];
+        [ $dbh->last_insert_id(undef,undef,undef,undef), @$args ];
       },
       update_one => 'UPDATE names SET name = ? WHERE id = ?',
       delete_one => 'DELETE FROM names WHERE id = ?',
@@ -57,40 +57,44 @@ sub make_store {
   });
 }
 
-setup_db;
+sub run_tests {
+  setup_db;
 
-my $store = make_store;
+  my $store = make_store;
 
-is_deeply([$store->flatten], [], 'Empty set');
+  is_deeply([$store->flatten], [], 'Empty set');
 
-is_deeply($store->add(['Bob']), [1], 'Add record');
+  is_deeply($store->add(['Bob']), [1,'Bob'], 'Add record');
 
-is_deeply([$store->flatten], [[1,'Bob']], 'One member');
+  is_deeply([$store->flatten], [[1,'Bob']], 'One member');
 
-is_deeply($store->get([1]), [1,'Bob'], 'Retrieve by key');
+  is_deeply($store->get([1]), [1,'Bob'], 'Retrieve by key');
 
-$store->replace([1],['Robert']);
+  $store->replace([1],['Robert']);
 
-is_deeply([$store->flatten], [[1,'Robert']], 'Name changed (all)');
+  is_deeply([$store->flatten], [[1,'Robert']], 'Name changed (all)');
 
-is_deeply($store->get([1]), [1,'Robert'], 'Retrieve by key');
+  is_deeply($store->get([1]), [1,'Robert'], 'Retrieve by key');
 
-$store->add([$_]) for qw(Joe James Jim);
+  $store->add([$_]) for qw(Joe James Jim);
 
-my $flatsort = sub {
-  [ sort { $a->[0] <=> $b->[0] } $store->flatten ]
-};
+  my $flatsort = sub {
+    [ sort { $a->[0] <=> $b->[0] } $store->flatten ]
+  };
 
-is_deeply($flatsort->(), [
-  [1,'Robert'],[2,'Joe'],[3,'James'],[4,'Jim']
-], 'Four members');
+  is_deeply($flatsort->(), [
+    [1,'Robert'],[2,'Joe'],[3,'James'],[4,'Jim']
+  ], 'Four members');
 
-is_deeply($store->get([3]),[3,'James'], 'Retrieve by key');
+  is_deeply($store->get([3]),[3,'James'], 'Retrieve by key');
 
-$store->remove([3]);
+  $store->remove([3]);
 
-is_deeply($flatsort->(), [
-  [1,'Robert'],[2,'Joe'],[4,'Jim']
-], 'Three members left');
+  is_deeply($flatsort->(), [
+    [1,'Robert'],[2,'Joe'],[4,'Jim']
+  ], 'Three members left');
 
-done_testing;
+  done_testing;
+}
+
+run_tests unless caller;
diff --git a/t/crud_wrapped.t b/t/crud_wrapped.t
new file mode 100644
index 0000000..db617f5
--- /dev/null
+++ b/t/crud_wrapped.t
@@ -0,0 +1,65 @@
+use strictures 1;
+use Test::More;
+use DBIx::Data::Store::Inflator::Simple;
+use DBIx::Data::Collection::Set::Wrapper::Inflate;
+
+BEGIN { require 't/crud.t' }
+
+{ package My::Name; sub id { shift->{id} } sub name { shift->{name} } }
+
+sub mkobj { bless({ id => $_[0][0], name => $_[0][1] }, 'My::Name') }
+
+sub run_tests_crud_wrapped {
+  setup_db;
+
+  my $unwrapped = make_store;
+  my $store = DBIx::Data::Collection::Set::Wrapper::Inflate->new({
+    inner => $unwrapped,
+    inflator => DBIx::Data::Store::Inflator::Simple->new({
+      spec_columns => [ 'id' ], body_columns => [ 'name' ],
+      all_columns => [ 'id', 'name' ], class => 'My::Name'
+    })
+  });
+
+  my $bob = mkobj([1,'Bob']);
+
+  is_deeply([$store->flatten], [], 'Empty set');
+
+  is_deeply($store->add({ name => 'Bob' }), $bob, 'Add record');
+
+  is_deeply([$store->flatten], [$bob], 'One member');
+
+  is_deeply($store->get({ id => 1 }), $bob, 'Retrieve by key');
+
+  $bob = mkobj([1,'Robert']);
+
+  $store->replace($bob,$bob);
+
+  is_deeply([$store->flatten], [$bob], 'Name changed (all)');
+
+  is_deeply($store->get({ id => 1 }), $bob, 'Retrieve by key');
+
+  $store->add({ name => $_ }) for qw(Joe James Jim);
+
+  my $flatsort = sub {
+    [ sort { $a->id <=> $b->id } $store->flatten ]
+  };
+
+  is_deeply($flatsort->(), [
+    map mkobj($_), [1,'Robert'],[2,'Joe'],[3,'James'],[4,'Jim']
+  ], 'Four members');
+
+  my $james = mkobj([3,'James']);
+
+  is_deeply($store->get({ id => 3 }), $james, 'Retrieve by key');
+
+  $store->remove($james);
+
+  is_deeply($flatsort->(), [
+    map mkobj($_), [1,'Robert'],[2,'Joe'],[4,'Jim']
+  ], 'Three members left');
+
+  done_testing;
+}
+
+run_tests_crud_wrapped unless caller;