Commit | Line | Data |
65b76960 |
1 | use Test::More; |
2 | use DBIx::Data::Store; |
3 | use DBIx::Data::Store::CRUD; |
4 | use DBIx::Data::Collection::Set; |
65b76960 |
5 | use DBI; |
de9534fa |
6 | use Scalar::Util qw(refaddr); |
7 | |
8 | use Devel::Dwarn; |
65b76960 |
9 | |
1e948dd4 |
10 | use strict; |
11 | use warnings FATAL => 'all'; |
12 | |
d8eb0a3f |
13 | sub sort_set { |
14 | sort { $a->{name} cmp $b->{name} } @_ |
15 | } |
16 | |
32746a09 |
17 | my $dsn = 'dbi:SQLite:tmp.db'; |
18 | |
19 | sub setup_dbh { |
65b76960 |
20 | unlink('tmp.db'); |
32746a09 |
21 | return DBI->connect($dsn) |
22 | } |
23 | |
24 | sub setup_db { |
25 | my $dbh = setup_dbh; |
65b76960 |
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; |
9f2b6cc8 |
35 | return sort_set do { |
d8eb0a3f |
36 | my $id = 0; map +{ id => ++$id, name => $_ }, @names |
37 | }; |
65b76960 |
38 | } |
39 | |
9f2b6cc8 |
40 | my $db_store = DBIx::Data::Store->connect($dsn); |
41 | |
32746a09 |
42 | sub raw_store { $db_store } |
43 | |
9f2b6cc8 |
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 | |
65b76960 |
54 | sub make_set { |
9f2b6cc8 |
55 | my ($set, $crud, $class) = @_; |
56 | ($class || 'DBIx::Data::Collection::Set')->new( |
3a2e7c1c |
57 | set_over => [ 'id' ], |
9f2b6cc8 |
58 | store => make_store($crud), |
1e948dd4 |
59 | %$set |
65b76960 |
60 | ); |
61 | } |
62 | |
9f2b6cc8 |
63 | sub run_tests { |
65b76960 |
64 | |
9f2b6cc8 |
65 | my @expect = setup_db; |
65b76960 |
66 | |
9f2b6cc8 |
67 | my $set = make_set; |
65b76960 |
68 | |
9f2b6cc8 |
69 | is_deeply([ sort_set $set->flatten ], \@expect, 'Basic data out ok (flatten)'); |
65b76960 |
70 | |
9f2b6cc8 |
71 | { |
72 | my $stream = $set->as_stream; |
65b76960 |
73 | |
9f2b6cc8 |
74 | my @got; while (my ($next) = $stream->next) { push @got, $next } |
1e948dd4 |
75 | |
9f2b6cc8 |
76 | is_deeply([ sort_set @got ], \@expect, 'Basic data out ok (stream)'); |
77 | } |
1e948dd4 |
78 | |
9f2b6cc8 |
79 | $set = make_set { class => 'Spoon' }; |
3a2e7c1c |
80 | |
9f2b6cc8 |
81 | is_deeply( |
82 | [ sort_set $set->flatten ], |
83 | [ map { bless({ %$_ }, 'Spoon') } @expect ], |
84 | 'Basic data with class out ok' |
85 | ); |
3a2e7c1c |
86 | |
9f2b6cc8 |
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 | }, |
a1e15ee1 |
99 | delete_single_sql => q{DELETE FROM person WHERE id = ?}, |
100 | delete_single_argument_order => [ 'id' ], |
9f2b6cc8 |
101 | }; |
de9534fa |
102 | |
9f2b6cc8 |
103 | my $doug = $set->add({ name => 'Doug' }); |
de9534fa |
104 | |
9f2b6cc8 |
105 | ok($doug->{id}, 'id filled out in new row'); |
3a2e7c1c |
106 | |
9f2b6cc8 |
107 | my ($set_doug) = grep $_->{name} eq 'Doug', $set->flatten; |
3a2e7c1c |
108 | |
9f2b6cc8 |
109 | ok($set_doug, 'new row exists in flatten'); |
c51eabc5 |
110 | |
9f2b6cc8 |
111 | cmp_ok(refaddr($doug), '==', refaddr($set_doug), 'Same hashref returned'); |
c51eabc5 |
112 | |
9f2b6cc8 |
113 | $set->remove($doug); |
c51eabc5 |
114 | |
9f2b6cc8 |
115 | is_deeply([ sort_set $set->flatten ], \@expect, 'new row gone after remove'); |
c51eabc5 |
116 | |
9f2b6cc8 |
117 | $set = make_set; |
48d91d77 |
118 | |
9f2b6cc8 |
119 | is_deeply([ sort_set $set->flatten ], \@expect, 'new row still gone on reload'); |
48d91d77 |
120 | |
9f2b6cc8 |
121 | $set = make_set {}, { |
a1e15ee1 |
122 | update_single_sql => q{UPDATE person SET name = ? WHERE id = ?}, |
123 | update_single_argument_order => [ qw(name id) ] |
9f2b6cc8 |
124 | }; |
125 | |
126 | my ($pterry) = grep $_->{name} eq 'Pterry', $set->flatten; |
48d91d77 |
127 | |
9f2b6cc8 |
128 | $pterry->{name} = 'Sir Pterry'; # http://xrl.us/bgse8s |
48d91d77 |
129 | |
9f2b6cc8 |
130 | $set->_update_in_store($pterry); |
48d91d77 |
131 | |
9f2b6cc8 |
132 | $set = make_set; |
48d91d77 |
133 | |
9f2b6cc8 |
134 | my ($fresh_pterry) = grep $_->{name} =~ /Pterry/, $set->flatten; |
48d91d77 |
135 | |
9f2b6cc8 |
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 | }; |
e49bd861 |
142 | |
9f2b6cc8 |
143 | my $pterry_id = (grep $_->{name} eq 'Pterry', @expect)[0]->{id}; |
e49bd861 |
144 | |
9f2b6cc8 |
145 | $pterry = $set->get({ id => $pterry_id }); |
e49bd861 |
146 | |
9f2b6cc8 |
147 | is($pterry->{name}, 'Sir Pterry', 'Pterry retrieved by id'); |
e49bd861 |
148 | |
9f2b6cc8 |
149 | ok(!defined($set->get({ id => -1 })), 'undef on missing id'); |
e49bd861 |
150 | |
9f2b6cc8 |
151 | $pterry->{name} = 'Pterry'; |
152 | |
153 | is_deeply([ sort_set $set->flatten ], \@expect, 'Basic data after fetch by id'); |
154 | |
155 | done_testing; |
156 | } |
b1c3fd5d |
157 | |
9f2b6cc8 |
158 | run_tests unless caller; |
b1c3fd5d |
159 | |
9f2b6cc8 |
160 | 1; |