bugfixes, tweaks, map support
Matt S Trout [Sun, 29 Aug 2010 13:06:33 +0000 (14:06 +0100)]
lib/DBIx/Data/Collection/Set/Mapped.pm [new file with mode: 0644]
lib/DBIx/Data/Collection/Set/Wrapper/Inflate.pm
lib/DBIx/Data/Store/CRUD.pm
lib/DBIx/Data/Stream/STH.pm
t/crud_wrapped.t

diff --git a/lib/DBIx/Data/Collection/Set/Mapped.pm b/lib/DBIx/Data/Collection/Set/Mapped.pm
new file mode 100644 (file)
index 0000000..7f2eb89
--- /dev/null
@@ -0,0 +1,43 @@
+package DBIx::Data::Collection::Set::Mapped;
+
+use strictures 1;
+
+use DBIx::Data::Stream::Mapped;
+
+sub new {
+  my $proto = shift;
+  bless({ %{$_[0]} }, ref($proto)||$proto);
+}
+
+sub _inner { shift->{inner} }
+sub _mapper { shift->{mapper} }
+
+sub flatten {
+  my ($self) = @_;
+  map $self->_do_map($_), $self->_inner->flatten;
+}
+
+sub to_stream {
+  my ($self) = @_;
+  my $mapper = $self->_mapper;
+  DBIx::Data::Stream::Mapped->new({
+    inner => $self->_inner->to_stream,
+    mapper => $self->_mapper
+  });
+}
+
+sub get {
+  my ($self, $spec) = @_;
+  if (my $got = $self->_inner->get($spec)) {
+    return $self->_do_map($got);
+  }
+  return undef;
+}
+
+sub _do_map {
+  my ($self, $to_map) = @_;
+  local $_ = $to_map;
+  $self->_mapper->($to_map);
+}
+
+1;
index 0330181..b4d0b43 100644 (file)
@@ -29,11 +29,10 @@ sub clear { shift->_inner->clear }
 sub get {
   my ($self, $spec) = @_;
   my $inflator = $self->_inflator;
-  $inflator->inflate(
-    $self->_inner->get(
-      $inflator->deflate_spec($spec)
-    )
-  );
+  if (my $got = $self->_inner->get($inflator->deflate_spec($spec))) {
+    return $inflator->inflate($got);
+  }
+  return undef;
 }
 
 sub replace {
@@ -60,4 +59,11 @@ sub remove {
   $self->_inner->remove($self->_inflator->deflate_spec($spec));
 }
 
+sub map {
+  require DBIx::Data::Collection::Set::Mapped;
+  DBIx::Data::Collection::Set::Mapped->new({
+    inner => $_[0], mapper => $_[1]
+  });
+}
+
 1;
index 633ebb3..143ed79 100644 (file)
@@ -2,6 +2,8 @@ package DBIx::Data::Store::CRUD;
 
 use strictures 1;
 
+use DBIx::Data::Stream::STH;
+
 sub new {
   my $proto = shift;
   bless({ %{$_[0]} }, ref($proto)||$proto);
@@ -9,12 +11,16 @@ sub new {
 
 sub _sql { shift->{sql} }
 sub _raw { shift->{raw} }
+sub _append_args { shift->{append_args} }
 
 sub _run {
   my $self = shift;
-  my ($run_type, $sql_type, @args) = @_;
+  my ($run_type, $sql_type, $args) = @_;
   my $sql = $self->_sql->{$sql_type}||die "No such sql type ${sql_type}";
-  $self->_raw->${\"run_${run_type}"}($sql, @args);
+  if (my $append = $self->_append_args) {
+    $args = [ @{$args||[]}, @$append ];
+  }
+  $self->_raw->${\"run_${run_type}"}($sql, $args);
 }
 
 sub flatten { @{shift->_run('rowset', 'select_all', @_)} }
index 6a43b99..c87a8d8 100644 (file)
@@ -15,9 +15,8 @@ sub next {
   my $sth = (my $self = shift)->_sth;
   return unless $sth;
   # {Active} only means that there *may* be more results to fetch
-  if ($sth->{Active} and my @next = $self->sth->fetchrow_array) {
-    my %next; @next{@{$self->_column_order}} = @next;
-    return \%next;
+  if ($sth->{Active} and my @next = $sth->fetchrow_array) {
+    return [ @next ];
   }
   $sth->finish;
   # prepare_cached might recycle it now we're finished so get rid of it
index db617f5..b8be740 100644 (file)
@@ -59,6 +59,8 @@ sub run_tests_crud_wrapped {
     map mkobj($_), [1,'Robert'],[2,'Joe'],[4,'Jim']
   ], 'Three members left');
 
+  is_deeply([$store->get({ id => 3 })], [undef], 'Retrieve nonexistent');
+
   done_testing;
 }