yannk / perl-data-objectdriver

Data::ObjectDriver is Six Apart's Perl ORM

This URL has Read+Write access

perl-data-objectdriver / t / 02-moose.t
raw normal view history
47e2225f » yannk 2009-04-02 Tests I really care for my ... 1 # $Id: 01-col-inheritance.t 989 2005-09-23 19:58:01Z btrott $
2
3 use strict;
4
5 use lib 't/lib';
6 use lib 't/lib/moose';
7 require 't/lib/db-common.pl';
8
699ca57f » yannk 2009-04-03 This is just a preliminary ... 9 #$Data::ObjectDriver::DEBUG=1;
47e2225f » yannk 2009-04-02 Tests I really care for my ... 10 use Test::More;
11 use Test::Exception;
12
13 BEGIN {
14 unless (eval { require DBD::SQLite }) {
15 plan skip_all => 'Tests require DBD::SQLite';
16 }
17 unless (eval { require Cache::Memory }) {
18 plan skip_all => 'Tests require Cache::Memory';
19 }
20 }
21
22 plan tests => 64;
23
24 use Wine;
25 use Recipe;
26 use Ingredient;
27
28 setup_dbs({
29 global => [ qw( wines recipes ingredients) ],
30 });
31
32 # method installation
33 {
34 my $w = Wine->new;
35 ok $w->name("name");
610820d7 » yannk 2009-04-06 Very ugly but works now, th... 36 ok $w->is_changed('name');
47e2225f » yannk 2009-04-02 Tests I really care for my ... 37 dies_ok { $w->inexistent("hell") } "dies on setting inexistent column : 'inexistent()'";
38 }
39
40 # refresh
41 {
42 my $old ='Cul de Veau à la Sauge'; # tastes good !
43 my $new ='At first my tests ran on Recipe, sorry (Yann)';
44 my $w1 = Wine->new;
45 $w1->name($old);
46 ok $w1->save;
47 my $id = $w1->id;
48
49 my $w2 = Wine->lookup($id);
50 $w2->name($new);
51 $w2->save;
52 cmp_ok $w1->name, 'eq', $old, "Old name not updated...";
53 cmp_ok $w2->name, 'eq', $new, "... but new name is set";
54
55 $w1->refresh;
56
57 cmp_ok $w1->name, 'eq', $new, "Refreshed";
58 is $w1->remove, 1, 'Remove correct number of rows';
59 is $w2->remove, '0E0', 'Remove correct number of rows';
60 }
61
62 # Constructor testing
63 {
64 my $w = Wine->new(name=>'Mouton Rothschild', rating=> 4);
65
66 ok ($w, 'constructed a new Wine');
67 is ($w->name, 'Mouton Rothschild', 'name constructor');
68 is ($w->rating, 4, 'rating constructor');
69 }
70
71 # lookup with hash (single pk)
72 {
73 my $w = Wine->new;
74 $w->name("Veuve Cliquot");
75 $w->save;
76 my $id = $w->id;
77 undef $w;
78
79 # lookup test
80 lives_ok { $w = Wine->lookup({ id => $id })} "Alive !";
81 cmp_ok $w->name, 'eq', 'Veuve Cliquot', "simple data test";
82
83 ok $w;
84 is $w->remove, 1, 'Remove correct number of rows';
85 }
86
87 ## lookup_multi give a sorted result set
88 {
89
90 my @ids;
91 for (1 .. 14) {
92 my $w = Wine->new(name => "wine-$_");
93 $w->save;
94 push @ids, $w->id;
95 }
96 if (eval { require List::Util }) {
97 @ids = List::Util::shuffle @ids;
98 } else {
99 @ids = reverse @ids;
100 }
101 my @got = map { $_->id } @{ Wine->lookup_multi(\@ids) };
102 is_deeply \@got, \@ids, "Sorted result set";
103 }
104
105 # lookups with hash (multiple pk)
106 {
107 my $r = Recipe->new;
108 $r->title("Good one");
109 ok $r->save;
110 my $rid = $r->recipe_id;
111 ok $rid;
112
113 my $i = Ingredient->new;
114 $i->recipe_id($rid);
115 $i->quantity(1);
116 $i->name('Chouchenn');
117 ok $i->save;
118 my $id = $i->id;
119 undef $i;
120
121 # lookup test
122 dies_ok { $i = Ingredient->lookup({ id => $id, quantity => 1 })} "Use Search !";
123 lives_ok { $i = Ingredient->lookup({ id => $id, recipe_id => $rid })} "Alive";
124 cmp_ok $i->name, 'eq', 'Chouchenn', "simple data test";
125
126 # lookup_multi with hash (multiple pk)
127 lives_ok { $i = Ingredient->lookup_multi(
128 [{ id => $id, recipe_id => $rid }])
129 } "Alive";
130 is scalar @$i, 1;
131
132 # add a second ingredient
133 my $i2 = Ingredient->new(
134 recipe_id => $rid,
135 quantity => 1,
136 name => 'honey',
137 );
138 $i2->save;
139 my $id2 = $i2->id;
140 lives_ok { $i = Ingredient->lookup_multi(
141 [{ id => $id, recipe_id => $rid }, { id => $id2, recipe_id => $rid } ])
142 } "Alive";
143 is scalar @$i, 2;
144
145 is $r->remove, 1, 'Remove correct number of rows';
146 is $i->[0]->remove, 1, 'Remove correct number or rows';
147 is $i->[1]->remove, 1, 'Remove correct number or rows';
148 }
149
150
151 # replace
152 {
153 my $r = Recipe->new;
154 $r->title("to replace");
155 ok $r->replace;
156 ok(my $rid = $r->recipe_id);
157 my $r2 = Recipe->new;
158 $r2->recipe_id($rid);
159 $r2->title('new title');
160 ok $r2->replace;
161
162 ## check
163 $r = Recipe->lookup($rid);
164 is $r->title, 'new title';
165
166 $r2 = Recipe->new;
167 $r2->recipe_id($rid);
168 ok $r2->replace;
169
170 ## check
171 $r = Recipe->lookup($rid);
172 is $r->title, undef;
173 }
174
175 # let's test atomicity of replace
176 {
177 my $r = Recipe->new;
178 $r->title("to replace");
179 $r->insert;
180
181 ## too long title:
182 # Oh! right it's a feature :(
183 # http://www.sqlite.org/faq.html#q3
184 #$r->title(join '', ("0123456789" x 6));
185 #dies_ok { $r->replace };
186 #$r->refresh;
187 my $id = $r->recipe_id;
188 $r->title('replaced');
610820d7 » yannk 2009-04-06 Very ugly but works now, th... 189 dies_ok { $r->recipe_id("lamer") };
47e2225f » yannk 2009-04-02 Tests I really care for my ... 190 $r = Recipe->lookup($id);
191 ok $r;
192 is $r->title, "to replace";
193
194 # emulate a driver which doesn't support REPLACE INTO
195 {
196 no warnings 'redefine';
197 local *Data::ObjectDriver::Driver::DBD::SQLite::can_replace = sub { 0 };
198 $r->title('replaced');
610820d7 » yannk 2009-04-06 Very ugly but works now, th... 199 dies_ok { $r->recipe_id("lamer") };
47e2225f » yannk 2009-04-02 Tests I really care for my ... 200 $r = Recipe->lookup($id);
201 ok $r;
202 is $r->title, "to replace";
203 # emulate a driver which doesn't support REPLACE INTO
204 }
205 }
206
207 # is_changed interface
208 {
209 my $w = Wine->new;
210 $w->name("Veuve Cliquot");
211 $w->save;
212 ok ! $w->is_changed;
213 $w->name("veuve champenoise");
214 ok $w->is_changed;
215 ok $w->is_changed('name');
216 ok ! $w->is_changed('content');
217 }
218
219 # Remove counts
220 {
221 # Clear out the wine table
222 ok (Wine->remove(), 'delete all from Wine table');
223
224 is (Wine->remove({name=>'moooo'}), 0E0, 'No rows deleted');
225 my @bad_wines = qw(Thunderbird MadDog Franzia);
226 foreach my $name (@bad_wines) {
227 my $w = Wine->new;
228 $w->name($name);
229 ok $w->save, "Saving bad_wine $name";
230 }
231 is (Wine->remove(), scalar(@bad_wines), 'removing all bad wine');
232
233 # Do it again with direct remove from the DB
234 foreach my $name (@bad_wines) {
235 my $w = Wine->new;
236 $w->name($name);
237 ok $w->save, "Saving bad_wine $name";
238 }
239 # note sqlite is stupid and doesn't return the number of affected rows
240 is (Wine->remove({}, { nofetch => 1 }), '0E0', 'removing all bad wine');
241 }
242
243 # different utilities
244 {
245 my $w1 = Wine->new;
246 $w1->name("Chateau la pompe");
247 $w1->insert;
248
249 my $w3 = Wine->new;
250 $w3->name("different");
251 $w3->insert;
252
253 my $w2 = Wine->lookup($w1->id);
254 ok $w1->is_same($w1);
255 ok $w2->is_same($w1);
256 ok $w1->is_same($w2);
257 ok !$w1->is_same($w3);
258 ok !$w3->is_same($w2);
259
260 like $w1->pk_str, qr/\d+/;
261 }
262
263 # Test the new flag for persistent store insertion
264 {
265 my $w = Wine->new(name => 'flag test', rating=> 4);
266 ok !$w->object_is_stored, "this object needs to be saved!";
267 $w->save;
268 ok $w->object_is_stored, "this object is no saved";
269 my $w2 = Wine->lookup( $w->id );
270 ok $w2->object_is_stored, "an object fetched from the database is by definition NOT ephemeral";
271 }
272
273 sub DESTROY { teardown_dbs(qw( global )); }
274