t/dbix-data-set/01basic_collection.t

   1 use Test::More;
   2 use DBIx::Data::Store;
   3 use DBIx::Data::Store::CRUD;
   4 use DBIx::Data::Collection::Set;
   5 use DBI;
   6 use Scalar::Util qw(refaddr);
   7
   8 use Devel::Dwarn;
   9
  10 use strict;
  11 use warnings FATAL => 'all';
  12
  13 sub sort_set {
  14   sort { $a->{name} cmp $b->{name} } @_
  15 }
  16
  17 my $dsn = 'dbi:SQLite:tmp.db';
  18
  19 sub setup_dbh {
  20   unlink('tmp.db');
  21   return DBI->connect($dsn)
  22 }
  23
  24 sub setup_db {
  25   my $dbh = setup_dbh;
  26   $dbh->do(q{
  27     CREATE TABLE person (
  28       id INTEGER NOT NULL PRIMARY KEY,
  29       name VARCHAR(255) NOT NULL
  30     )
  31   });
  32   my $pop = $dbh->prepare(q{INSERT INTO person (name) VALUES (?)});
  33   my @names = qw(Joe Jim Bob Pterry);
  34   $pop->execute($_) for @names;
  35   return sort_set do {
  36     my $id = 0; map +{ id => ++$id, name => $_ }, @names
  37   };
  38 }
  39
  40 my $db_store = DBIx::Data::Store->connect($dsn);
  41
  42 sub raw_store { $db_store }
  43
  44 sub make_store {
  45   my ($crud) = @_;
  46   DBIx::Data::Store::CRUD->new(
  47     raw_store => $db_store,
  48     select_sql => q{SELECT id, name FROM person},
  49     select_column_order => [ qw(id name) ],
  50     %$crud
  51   );
  52 }
  53
  54 sub make_set {
  55   my ($set, $crud, $class) = @_;
  56   ($class || 'DBIx::Data::Collection::Set')->new(
  57     set_over => [ 'id' ],
  58     store => make_store($crud),
  59     %$set
  60   );
  61 }
  62
  63 sub run_tests {
  64
  65   my @expect = setup_db;
  66
  67   my $set = make_set;
  68
  69   is_deeply([ sort_set $set->flatten ], \@expect, 'Basic data out ok (flatten)');
  70
  71   {
  72     my $stream = $set->as_stream;
  73
  74     my @got; while (my ($next) = $stream->next) { push @got, $next }
  75
  76     is_deeply([ sort_set @got ], \@expect, 'Basic data out ok (stream)');
  77   }
  78
  79   $set = make_set { class => 'Spoon' };
  80
  81   is_deeply(
  82     [ sort_set $set->flatten ],
  83     [ map { bless({ %$_ }, 'Spoon') } @expect ],
  84     'Basic data with class out ok'
  85   );
  86
  87   $set = make_set {}, {
  88     insert_sql => q{INSERT INTO person (name) VALUES (?) },
  89     insert_argument_order => [ 'name' ],
  90     insert_command_constructor => sub {
  91       require DBIx::Data::Store::Command::Insert::LastInsertId;
  92       my $self = shift;
  93       DBIx::Data::Store::Command::Insert::LastInsertId->new(
  94         id_column => 'id',
  95         raw_store => $self->raw_store,
  96         insert_call_command => $self->raw_store->new_call_command(@_)
  97       );
  98     },
  99     delete_single_sql => q{DELETE FROM person WHERE id = ?},
 100     delete_single_argument_order => [ 'id' ],
 101   };
 102
 103   my $doug = $set->add({ name => 'Doug' });
 104
 105   ok($doug->{id}, 'id filled out in new row');
 106
 107   my ($set_doug) = grep $_->{name} eq 'Doug', $set->flatten;
 108
 109   ok($set_doug, 'new row exists in flatten');
 110
 111   cmp_ok(refaddr($doug), '==', refaddr($set_doug), 'Same hashref returned');
 112
 113   $set->remove($doug);
 114
 115   is_deeply([ sort_set $set->flatten ], \@expect, 'new row gone after remove');
 116
 117   $set = make_set;
 118
 119   is_deeply([ sort_set $set->flatten ], \@expect, 'new row still gone on reload');
 120
 121   $set = make_set {}, {
 122     update_single_sql => q{UPDATE person SET name = ? WHERE id = ?},
 123     update_single_argument_order => [ qw(name id) ]
 124   };
 125
 126   my ($pterry) = grep $_->{name} eq 'Pterry', $set->flatten;
 127
 128   $pterry->{name} = 'Sir Pterry'; # http://xrl.us/bgse8s
 129
 130   $set->_update_in_store($pterry);
 131
 132   $set = make_set;
 133
 134   my ($fresh_pterry) = grep $_->{name} =~ /Pterry/, $set->flatten;
 135
 136   is($fresh_pterry->{name}, 'Sir Pterry', 'Update persisted correctly');
 137
 138   $set = make_set {}, {
 139     select_single_sql => q{SELECT id, name FROM person WHERE id = ?},
 140     select_single_argument_order => [ qw(id) ],
 141   };
 142
 143   my $pterry_id = (grep $_->{name} eq 'Pterry', @expect)[0]->{id};
 144
 145   $pterry = $set->get({ id => $pterry_id });
 146
 147   is($pterry->{name}, 'Sir Pterry', 'Pterry retrieved by id');
 148
 149   ok(!defined($set->get({ id => -1 })), 'undef on missing id');
 150
 151   $pterry->{name} = 'Pterry';
 152
 153   is_deeply([ sort_set $set->flatten ], \@expect, 'Basic data after fetch by id');
 154
 155   done_testing;
 156 }
 157
 158 run_tests unless caller;
 159
 160 1;