use DBIx::Data::Store::CRUD;
use DBIx::Data::Collection::Set;
use DBI;
+use Scalar::Util qw(refaddr);
+
+use Devel::Dwarn;
use strict;
use warnings FATAL => 'all';
-my $dsn = 'dbi:SQLite:tmp.db';
-
-my @expect;
-
sub sort_set {
sort { $a->{name} cmp $b->{name} } @_
}
-{
+my $dsn = 'dbi:SQLite:tmp.db';
+
+sub setup_dbh {
unlink('tmp.db');
- my $dbh = DBI->connect($dsn);
+ return DBI->connect($dsn)
+}
+
+sub setup_db {
+ my $dbh = setup_dbh;
$dbh->do(q{
CREATE TABLE person (
id INTEGER NOT NULL PRIMARY KEY,
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 raw_store { $db_store }
+
+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' };
-
-is_deeply(
- [ sort_set $set->flatten ],
- [ map { bless({ %$_ }, 'Spoon') } @expect ],
- 'Basic data with class out ok'
-);
-
-$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(@_)
- );
+ my @got; while (my ($next) = $stream->next) { push @got, $next }
+
+ is_deeply([ sort_set @got ], \@expect, 'Basic data out ok (stream)');
}
-};
-my $doug = $set->add({ name => 'Doug' });
+ $set = make_set { class => 'Spoon' };
-use Devel::Dwarn;
+ is_deeply(
+ [ sort_set $set->flatten ],
+ [ map { bless({ %$_ }, 'Spoon') } @expect ],
+ 'Basic data with class out ok'
+ );
+
+ $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_single_sql => q{DELETE FROM person WHERE id = ?},
+ delete_single_argument_order => [ 'id' ],
+ };
+
+ my $doug = $set->add({ name => 'Doug' });
+
+ ok($doug->{id}, 'id filled out in new row');
+
+ my ($set_doug) = grep $_->{name} eq 'Doug', $set->flatten;
+
+ ok($set_doug, 'new row exists in flatten');
+
+ cmp_ok(refaddr($doug), '==', refaddr($set_doug), 'Same hashref returned');
+
+ $set->remove($doug);
+
+ is_deeply([ sort_set $set->flatten ], \@expect, 'new row gone after remove');
+
+ $set = make_set;
+
+ is_deeply([ sort_set $set->flatten ], \@expect, 'new row still gone on reload');
+
+ $set = make_set {}, {
+ update_single_sql => q{UPDATE person SET name = ? WHERE id = ?},
+ update_single_argument_order => [ qw(name id) ]
+ };
+
+ my ($pterry) = grep $_->{name} eq 'Pterry', $set->flatten;
+
+ $pterry->{name} = 'Sir Pterry'; # http://xrl.us/bgse8s
+
+ $set->_update_in_store($pterry);
+
+ $set = make_set;
+
+ my ($fresh_pterry) = grep $_->{name} =~ /Pterry/, $set->flatten;
+
+ 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};
+
+ $pterry = $set->get({ id => $pterry_id });
+
+ is($pterry->{name}, 'Sir Pterry', 'Pterry retrieved by id');
+
+ ok(!defined($set->get({ id => -1 })), 'undef on missing id');
+
+ $pterry->{name} = 'Pterry';
+
+ is_deeply([ sort_set $set->flatten ], \@expect, 'Basic data after fetch by id');
+
+ done_testing;
+}
-Dwarn $doug;
+run_tests unless caller;
-done_testing;
+1;