From: Matt S Trout <matthewt@hercule.scsys.co.uk>
Date: Sat, 28 Aug 2010 23:18:25 +0000 (+0100)
Subject: very basic outline
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=54bed31b9005a318c900141e413fb9cd4fd0953d;p=dbsrgits%2FDBIx-Data-Store.git

very basic outline
---

54bed31b9005a318c900141e413fb9cd4fd0953d
diff --git a/lib/DBIx/Data/Store/CRUD.pm b/lib/DBIx/Data/Store/CRUD.pm
new file mode 100644
index 0000000..633ebb3
--- /dev/null
+++ b/lib/DBIx/Data/Store/CRUD.pm
@@ -0,0 +1,36 @@
+package DBIx::Data::Store::CRUD;
+
+use strictures 1;
+
+sub new {
+  my $proto = shift;
+  bless({ %{$_[0]} }, ref($proto)||$proto);
+}
+
+sub _sql { shift->{sql} }
+sub _raw { shift->{raw} }
+
+sub _run {
+  my $self = shift;
+  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);
+}
+
+sub flatten { @{shift->_run('rowset', 'select_all', @_)} }
+
+sub to_stream { shift->_run('rowstream', 'select_all', @_) }
+
+sub clear { shift->_run('row','delete_all',@_) }
+
+sub get { shift->_run('row','select_one',@_) }
+
+sub replace { 
+  my $self = shift;
+  $self->_run('row','update_one', [ @{$_[1]}, @{$_[0]} ]);
+}
+
+sub add { shift->_run('row','insert_one',@_) }
+sub remove { shift->_run('row','delete_one',@_) }
+
+1;
diff --git a/lib/DBIx/Data/Store/Raw.pm b/lib/DBIx/Data/Store/Raw.pm
new file mode 100644
index 0000000..82885a9
--- /dev/null
+++ b/lib/DBIx/Data/Store/Raw.pm
@@ -0,0 +1,53 @@
+package DBIx::Data::Store::Raw;
+
+use strictures 1;
+
+use DBIx::Connector;
+
+sub new {
+  my $proto = shift;
+  bless({ %{$_[0]} }, ref($proto)||$proto);
+}
+
+sub connect {
+  my $class = shift;
+  $class->new({ connect_info => [ @_ ] });
+}
+
+sub connect_info { shift->{connect_info} }
+
+sub _connector { $_[0]->{_connector} ||= $_[0]->_build__connector }
+
+sub _build__connector {
+  DBIx::Connector->new(@{$_[0]->connect_info});
+}
+
+sub run_row { shift->_exec_calling('fetchrow_arrayref', @_) }
+
+sub run_rowset { shift->_exec_calling('fetchall_arrayref', @_) }
+
+sub run_rowstream {
+  shift->_exec_calling(sub {
+    DBIx::Data::Stream::STH->new({ sth => $_[0] })
+  }, @_);
+}
+
+sub _exec_calling {
+  my ($self, $call, @sth_args) = @_;
+  $self->_exec(sub {
+    $self->_sth_for($_[0], @sth_args)->$call
+  });
+}
+
+sub _exec {
+  $_[0]->_connector->run($_[1]);
+}
+
+sub _sth_for {
+  my ($self, $dbh, $sql, $args) = @_;
+  my $sth = $dbh->prepare_cached($sql, {}, 3);
+  $sth->execute(@$args);
+  return $sth;
+}
+
+1;
diff --git a/lib/DBIx/Data/Stream/STH.pm b/lib/DBIx/Data/Stream/STH.pm
new file mode 100644
index 0000000..6a43b99
--- /dev/null
+++ b/lib/DBIx/Data/Stream/STH.pm
@@ -0,0 +1,28 @@
+package DBIx::Data::Stream::STH;
+
+use strictures 1;
+
+sub new {
+  my $proto = shift;
+  bless({ %{$_[0]} }, ref($proto)||$proto);
+}
+
+sub _sth { shift->{sth} }
+
+sub _clear_sth { delete shift->{sth} }
+
+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;
+  }
+  $sth->finish;
+  # prepare_cached might recycle it now we're finished so get rid of it
+  $self->_clear_sth;
+  return;
+}
+
+1;
diff --git a/t/crud.t b/t/crud.t
new file mode 100644
index 0000000..bf762b5
--- /dev/null
+++ b/t/crud.t
@@ -0,0 +1,92 @@
+use strictures 1;
+use Test::More;
+
+use DBIx::Data::Store::CRUD;
+use DBIx::Data::Store::Raw;
+
+use DBI;
+use Scalar::Util qw(refaddr);
+
+sub sort_set {
+  sort { $a->{name} cmp $b->{name} } @_
+}
+
+my $dsn = 'dbi:SQLite:tmp.db';
+
+sub setup_dbh {
+  unlink('tmp.db');
+  return DBI->connect($dsn, undef, undef, { RaiseError => 1 })
+}
+
+sub setup_db {
+  my $dbh = setup_dbh;
+  $dbh->do(q{
+    CREATE TABLE names (
+      id INTEGER NOT NULL PRIMARY KEY,
+      name VARCHAR(255) NOT NULL
+    )
+  });
+  #my $pop = $dbh->prepare(q{INSERT INTO person (name) VALUES (?)});
+  #my @names = qw(Joe Jim Bob Pterry);
+  #$pop->execute($_) for @names;
+  #return sort_set do {
+  #  my $id = 0; map +{ id => ++$id, name => $_ }, @names
+  #};
+}
+
+my $db_store = DBIx::Data::Store::Raw->connect($dsn);
+
+sub raw_store { $db_store }
+
+sub make_store {
+  my ($crud) = @_;
+  DBIx::Data::Store::CRUD->new({
+    raw => $db_store,
+    sql => {
+      select_all => 'SELECT id, name FROM names',
+      delete_all => 'DELETE FROM names',
+      select_one => 'SELECT id, name FROM names WHERE id = ?',
+      insert_one => 'INSERT INTO names (name) VALUES (?)',# RETURNING (id)',
+      update_one => 'UPDATE names SET name = ? WHERE id = ?',
+      delete_one => 'DELETE FROM names WHERE id = ?',
+    },
+  });
+}
+
+setup_db;
+
+my $store = make_store;
+
+is_deeply([$store->flatten], [], 'Empty set');
+
+is_deeply($store->add(['Bob']), [1], 'Add record');
+
+is_deeply([$store->flatten], [[1,'Bob']], 'One member');
+
+is_deeply($store->get([1]), [1,'Bob'], 'Retrieve by key');
+
+$store->replace([1],['Robert']);
+
+is_deeply([$store->flatten], [[1,'Robert']], 'Name changed (all)');
+
+is_deeply($store->get([1]), [1,'Robert'], 'Retrieve by key');
+
+$store->add([$_]) for qw(Joe James Jim);
+
+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($store->get([3]),[3,'James'], 'Retrieve by key');
+
+$store->remove([3]);
+
+is_deeply($flatsort->(), [
+  [1,'Robert'],[2,'Joe'],[4,'Jim']
+], 'Three members left');
+
+done_testing;