Commit | Line | Data |
c0329273 |
1 | BEGIN { do "./t/lib/ANFANG.pm" or die ( $@ || $! ) } |
2 | |
33dd4e80 |
3 | use strict; |
af2d42c0 |
4 | use warnings; |
33dd4e80 |
5 | |
04ec3909 |
6 | use Test::More; |
fe8cee09 |
7 | use Test::Exception; |
d0cefd99 |
8 | use Test::Warn; |
c0329273 |
9 | |
33dd4e80 |
10 | use DBICTest; |
11 | |
12 | my $schema = DBICTest->init_schema(); |
13 | |
f8a464e5 |
14 | lives_ok ( sub { |
c45f4e10 |
15 | my $cd = $schema->resultset('CD')->create({ |
8273e845 |
16 | artist => { |
17 | name => 'Fred Bloggs' |
04ec3909 |
18 | }, |
19 | title => 'Some CD', |
20 | year => 1996 |
21 | }); |
22 | |
c45f4e10 |
23 | isa_ok($cd, 'DBICTest::CD', 'Created CD object'); |
24 | isa_ok($cd->artist, 'DBICTest::Artist', 'Created related Artist'); |
25 | is($cd->artist->name, 'Fred Bloggs', 'Artist created correctly'); |
f8a464e5 |
26 | }, 'simple create + parent (the stuff $rs belongs_to) ok'); |
c45f4e10 |
27 | |
f8a464e5 |
28 | lives_ok ( sub { |
c45f4e10 |
29 | my $bm_rs = $schema->resultset('Bookmark'); |
30 | my $bookmark = $bm_rs->create({ |
31 | link => { |
32 | id => 66, |
33 | }, |
34 | }); |
35 | |
36 | isa_ok($bookmark, 'DBICTest::Bookmark', 'Created Bookrmark object'); |
37 | isa_ok($bookmark->link, 'DBICTest::Link', 'Created related Link'); |
38 | is ( |
39 | $bm_rs->search ( |
40 | { 'link.title' => $bookmark->link->title }, |
41 | { join => 'link' }, |
42 | )->count, |
43 | 1, |
44 | 'Bookmark and link made it to the DB', |
45 | ); |
f8a464e5 |
46 | }, 'simple create where the child and parent have no values, except for an explicit parent pk ok'); |
04ec3909 |
47 | |
f8a464e5 |
48 | lives_ok ( sub { |
ab4b097b |
49 | my $artist = $schema->resultset('Artist')->first; |
50 | my $cd = $artist->create_related (cds => { |
51 | title => 'Music to code by', |
52 | year => 2007, |
53 | tags => [ |
54 | { 'tag' => 'rock' }, |
55 | ], |
56 | }); |
04ec3909 |
57 | |
ab4b097b |
58 | isa_ok($cd, 'DBICTest::CD', 'Created CD'); |
59 | is($cd->title, 'Music to code by', 'CD created correctly'); |
60 | is($cd->tags->count, 1, 'One tag created for CD'); |
61 | is($cd->tags->first->tag, 'rock', 'Tag created correctly'); |
04ec3909 |
62 | |
f8a464e5 |
63 | }, 'create over > 1 levels of has_many create (A => { has_many => { B => has_many => C } } )'); |
04ec3909 |
64 | |
fe8cee09 |
65 | throws_ok ( |
66 | sub { |
67 | # Create via update - add a new CD <--- THIS SHOULD HAVE NEVER WORKED! |
68 | $schema->resultset('Artist')->first->update({ |
69 | cds => [ |
70 | { title => 'Yet another CD', |
71 | year => 2006, |
72 | }, |
73 | ], |
74 | }); |
75 | }, |
9c042209 |
76 | qr/Recursive update is not supported over relationships of type 'multi'/, |
fe8cee09 |
77 | 'create via update of multi relationships throws an exception' |
78 | ); |
79 | |
f8a464e5 |
80 | lives_ok ( sub { |
ab4b097b |
81 | my $artist = $schema->resultset('Artist')->first; |
82 | my $c2p = $schema->resultset('CD_to_Producer')->create ({ |
83 | cd => { |
84 | artist => $artist, |
85 | title => 'Bad investment', |
86 | year => 2008, |
87 | tracks => [ |
1ceafb0c |
88 | { title => 'Just buy' }, |
89 | { title => 'Why did we do it' }, |
90 | { title => 'Burn baby burn' }, |
ab4b097b |
91 | ], |
92 | }, |
93 | producer => { |
94 | name => 'Lehman Bros.', |
95 | }, |
96 | }); |
97 | |
98 | isa_ok ($c2p, 'DBICTest::CD_to_Producer', 'Linker object created'); |
99 | my $prod = $schema->resultset ('Producer')->find ({ name => 'Lehman Bros.' }); |
100 | isa_ok ($prod, 'DBICTest::Producer', 'Producer row found'); |
101 | is ($prod->cds->count, 1, 'Producer has one production'); |
102 | my $cd = $prod->cds->first; |
103 | is ($cd->title, 'Bad investment', 'CD created correctly'); |
104 | is ($cd->tracks->count, 3, 'CD has 3 tracks'); |
f8a464e5 |
105 | }, 'Create m2m while originating in the linker table'); |
ab4b097b |
106 | |
9c1d9e6e |
107 | |
f8a464e5 |
108 | #CD -> has_many -> Tracks -> might have -> Single -> has_many -> Tracks |
109 | # \ |
110 | # \-> has_many \ |
111 | # --> CD2Producer |
112 | # /-> has_many / |
113 | # / |
114 | # Producer |
115 | lives_ok ( sub { |
fb88ca2c |
116 | my $artist = $schema->resultset('Artist')->find(1); |
51f30f72 |
117 | my $cd = $schema->resultset('CD')->create ({ |
118 | artist => $artist, |
119 | title => 'Music to code by at night', |
120 | year => 2008, |
121 | tracks => [ |
122 | { |
51f30f72 |
123 | title => 'Off by one again', |
124 | }, |
125 | { |
51f30f72 |
126 | title => 'The dereferencer', |
127 | cd_single => { |
128 | artist => $artist, |
129 | year => 2008, |
130 | title => 'Was that a null (Single)', |
131 | tracks => [ |
1ceafb0c |
132 | { title => 'The dereferencer' }, |
133 | { title => 'The dereferencer II' }, |
51f30f72 |
134 | ], |
135 | cd_to_producer => [ |
136 | { |
137 | producer => { |
138 | name => 'K&R', |
139 | } |
43483f30 |
140 | }, |
141 | { |
142 | producer => { |
143 | name => 'Don Knuth', |
144 | } |
145 | }, |
51f30f72 |
146 | ] |
147 | }, |
148 | }, |
149 | ], |
150 | }); |
151 | |
152 | isa_ok ($cd, 'DBICTest::CD', 'Main CD object created'); |
153 | is ($cd->title, 'Music to code by at night', 'Correct CD title'); |
154 | is ($cd->tracks->count, 2, 'Two tracks on main CD'); |
155 | |
fb88ca2c |
156 | my ($t1, $t2) = sort { $a->id <=> $b->id } $cd->tracks->all; |
51f30f72 |
157 | is ($t1->title, 'Off by one again', 'Correct 1st track name'); |
158 | is ($t1->cd_single, undef, 'No single for 1st track'); |
159 | is ($t2->title, 'The dereferencer', 'Correct 2nd track name'); |
160 | isa_ok ($t2->cd_single, 'DBICTest::CD', 'Created a single for 2nd track'); |
161 | |
162 | my $single = $t2->cd_single; |
163 | is ($single->tracks->count, 2, 'Two tracks on single CD'); |
164 | is ($single->tracks->find ({ position => 1})->title, 'The dereferencer', 'Correct 1st track title'); |
165 | is ($single->tracks->find ({ position => 2})->title, 'The dereferencer II', 'Correct 2nd track title'); |
166 | |
43483f30 |
167 | is ($single->cd_to_producer->count, 2, 'Two producers created for the single cd'); |
168 | is_deeply ( |
169 | [ sort map { $_->producer->name } ($single->cd_to_producer->all) ], |
170 | ['Don Knuth', 'K&R'], |
171 | 'Producers named correctly', |
172 | ); |
f8a464e5 |
173 | }, 'Create over > 1 levels of might_have with multiple has_many and multiple m2m but starting at a has_many level'); |
174 | |
175 | #Track -> might have -> Single -> has_many -> Tracks |
176 | # \ |
177 | # \-> has_many \ |
178 | # --> CD2Producer |
179 | # /-> has_many / |
180 | # / |
181 | # Producer |
182 | lives_ok ( sub { |
43483f30 |
183 | my $cd = $schema->resultset('CD')->first; |
184 | my $track = $schema->resultset('Track')->create ({ |
185 | cd => $cd, |
43483f30 |
186 | title => 'Multicreate rocks', |
187 | cd_single => { |
188 | artist => $cd->artist, |
189 | year => 2008, |
190 | title => 'Disemboweling MultiCreate', |
191 | tracks => [ |
1ceafb0c |
192 | { title => 'Why does mst write this way' }, |
193 | { title => 'Chainsaw celebration' }, |
194 | { title => 'Purl cleans up' }, |
43483f30 |
195 | ], |
196 | cd_to_producer => [ |
197 | { |
198 | producer => { |
199 | name => 'mst', |
200 | } |
201 | }, |
202 | { |
203 | producer => { |
204 | name => 'castaway', |
205 | } |
206 | }, |
207 | { |
208 | producer => { |
209 | name => 'theorbtwo', |
210 | } |
211 | }, |
212 | ] |
213 | }, |
214 | }); |
215 | |
216 | isa_ok ($track, 'DBICTest::Track', 'Main Track object created'); |
217 | is ($track->title, 'Multicreate rocks', 'Correct Track title'); |
218 | |
219 | my $single = $track->cd_single; |
220 | isa_ok ($single, 'DBICTest::CD', 'Created a single with the track'); |
221 | is ($single->tracks->count, 3, '3 tracks on single CD'); |
222 | is ($single->tracks->find ({ position => 1})->title, 'Why does mst write this way', 'Correct 1st track title'); |
223 | is ($single->tracks->find ({ position => 2})->title, 'Chainsaw celebration', 'Correct 2nd track title'); |
224 | is ($single->tracks->find ({ position => 3})->title, 'Purl cleans up', 'Correct 3rd track title'); |
225 | |
226 | is ($single->cd_to_producer->count, 3, '3 producers created for the single cd'); |
227 | is_deeply ( |
228 | [ sort map { $_->producer->name } ($single->cd_to_producer->all) ], |
229 | ['castaway', 'mst', 'theorbtwo'], |
230 | 'Producers named correctly', |
231 | ); |
f8a464e5 |
232 | }, 'Create over > 1 levels of might_have with multiple has_many and multiple m2m but starting at the might_have directly'); |
51f30f72 |
233 | |
f8a464e5 |
234 | lives_ok ( sub { |
0c9b6ece |
235 | my $artist = $schema->resultset('Artist')->first; |
236 | my $cd = $schema->resultset('CD')->create ({ |
237 | artist => $artist, |
238 | title => 'Music to code by at twilight', |
239 | year => 2008, |
240 | artwork => { |
241 | images => [ |
242 | { name => 'recursive descent' }, |
243 | { name => 'tail packing' }, |
244 | ], |
245 | }, |
246 | }); |
247 | |
248 | isa_ok ($cd, 'DBICTest::CD', 'Main CD object created'); |
249 | is ($cd->title, 'Music to code by at twilight', 'Correct CD title'); |
250 | isa_ok ($cd->artwork, 'DBICTest::Artwork', 'Artwork created'); |
251 | |
252 | # this test might look weird, but it failed at one point, keep it there |
e5b05576 |
253 | my $art_obj = $cd->artwork; |
254 | ok ($art_obj->has_column_loaded ('cd_id'), 'PK/FK present on artwork object'); |
255 | is ($art_obj->images->count, 2, 'Correct artwork image count via the new object'); |
0c9b6ece |
256 | is_deeply ( |
e5b05576 |
257 | [ sort $art_obj->images->get_column ('name')->all ], |
0c9b6ece |
258 | [ 'recursive descent', 'tail packing' ], |
259 | 'Images named correctly in objects', |
260 | ); |
261 | |
0c9b6ece |
262 | my $artwork = $schema->resultset('Artwork')->search ( |
263 | { 'cd.title' => 'Music to code by at twilight' }, |
264 | { join => 'cd' }, |
265 | )->single; |
266 | |
267 | is ($artwork->images->count, 2, 'Correct artwork image count via a new search'); |
268 | |
269 | is_deeply ( |
270 | [ sort $artwork->images->get_column ('name')->all ], |
271 | [ 'recursive descent', 'tail packing' ], |
272 | 'Images named correctly after search', |
273 | ); |
f8a464e5 |
274 | }, 'Test might_have again but with a PK == FK in the middle (obviously not specified)'); |
0c9b6ece |
275 | |
f8a464e5 |
276 | lives_ok ( sub { |
0c9b6ece |
277 | my $cd = $schema->resultset('CD')->first; |
278 | my $track = $schema->resultset ('Track')->create ({ |
279 | cd => $cd, |
0c9b6ece |
280 | title => 'Black', |
281 | lyrics => { |
282 | lyric_versions => [ |
283 | { text => 'The color black' }, |
284 | { text => 'The colour black' }, |
285 | ], |
286 | }, |
287 | }); |
288 | |
289 | isa_ok ($track, 'DBICTest::Track', 'Main track object created'); |
290 | is ($track->title, 'Black', 'Correct track title'); |
291 | isa_ok ($track->lyrics, 'DBICTest::Lyrics', 'Lyrics created'); |
292 | |
293 | # this test might look weird, but it was failing at one point, keep it there |
e5b05576 |
294 | my $lyric_obj = $track->lyrics; |
295 | ok ($lyric_obj->has_column_loaded ('lyric_id'), 'PK present on lyric object'); |
296 | ok ($lyric_obj->has_column_loaded ('track_id'), 'FK present on lyric object'); |
297 | is ($lyric_obj->lyric_versions->count, 2, 'Correct lyric versions count via the new object'); |
0c9b6ece |
298 | is_deeply ( |
e5b05576 |
299 | [ sort $lyric_obj->lyric_versions->get_column ('text')->all ], |
0c9b6ece |
300 | [ 'The color black', 'The colour black' ], |
301 | 'Lyrics text in objects matches', |
302 | ); |
303 | |
304 | |
305 | my $lyric = $schema->resultset('Lyrics')->search ( |
306 | { 'track.title' => 'Black' }, |
307 | { join => 'track' }, |
308 | )->single; |
309 | |
310 | is ($lyric->lyric_versions->count, 2, 'Correct lyric versions count via a new search'); |
311 | |
312 | is_deeply ( |
313 | [ sort $lyric->lyric_versions->get_column ('text')->all ], |
314 | [ 'The color black', 'The colour black' ], |
315 | 'Lyrics text via search matches', |
316 | ); |
f8a464e5 |
317 | }, 'Test might_have again but with just a PK and FK (neither specified) in the mid-table'); |
0c9b6ece |
318 | |
f8a464e5 |
319 | lives_ok ( sub { |
8273e845 |
320 | my $newartist2 = $schema->resultset('Artist')->find_or_create({ |
04ec3909 |
321 | name => 'Fred 3', |
322 | cds => [ |
8273e845 |
323 | { |
04ec3909 |
324 | title => 'Noah Act', |
325 | year => 2007, |
326 | }, |
327 | ], |
328 | }); |
329 | is($newartist2->name, 'Fred 3', 'Created new artist with cds via find_or_create'); |
f8a464e5 |
330 | }, 'Nested find_or_create'); |
04ec3909 |
331 | |
f8a464e5 |
332 | lives_ok ( sub { |
d7f20fdf |
333 | my $artist = $schema->resultset('Artist')->first; |
8273e845 |
334 | |
d7f20fdf |
335 | my $cd_result = $artist->create_related('cds', { |
8273e845 |
336 | |
d7f20fdf |
337 | title => 'TestOneCD1', |
338 | year => 2007, |
339 | tracks => [ |
340 | { title => 'TrackOne' }, |
341 | { title => 'TrackTwo' }, |
342 | ], |
343 | |
344 | }); |
8273e845 |
345 | |
d7f20fdf |
346 | isa_ok( $cd_result, 'DBICTest::CD', "Got Good CD Class"); |
347 | ok( $cd_result->title eq "TestOneCD1", "Got Expected Title"); |
8273e845 |
348 | |
d7f20fdf |
349 | my $tracks = $cd_result->tracks; |
8273e845 |
350 | |
d7f20fdf |
351 | isa_ok( $tracks, 'DBIx::Class::ResultSet', 'Got Expected Tracks ResultSet'); |
8273e845 |
352 | |
d7f20fdf |
353 | foreach my $track ($tracks->all) |
354 | { |
355 | isa_ok( $track, 'DBICTest::Track', 'Got Expected Track Class'); |
356 | } |
f8a464e5 |
357 | }, 'First create_related pass'); |
3d8ee6ab |
358 | |
f8a464e5 |
359 | lives_ok ( sub { |
d7f20fdf |
360 | my $artist = $schema->resultset('Artist')->first; |
8273e845 |
361 | |
d7f20fdf |
362 | my $cd_result = $artist->create_related('cds', { |
8273e845 |
363 | |
d7f20fdf |
364 | title => 'TestOneCD2', |
365 | year => 2007, |
366 | tracks => [ |
367 | { title => 'TrackOne' }, |
368 | { title => 'TrackTwo' }, |
369 | ], |
3d8ee6ab |
370 | |
9c6d6d93 |
371 | liner_notes => { notes => 'I can haz liner notes?' }, |
372 | |
d7f20fdf |
373 | }); |
8273e845 |
374 | |
d7f20fdf |
375 | isa_ok( $cd_result, 'DBICTest::CD', "Got Good CD Class"); |
376 | ok( $cd_result->title eq "TestOneCD2", "Got Expected Title"); |
9c6d6d93 |
377 | ok( $cd_result->notes eq 'I can haz liner notes?', 'Liner notes'); |
8273e845 |
378 | |
d7f20fdf |
379 | my $tracks = $cd_result->tracks; |
8273e845 |
380 | |
d7f20fdf |
381 | isa_ok( $tracks, 'DBIx::Class::ResultSet', "Got Expected Tracks ResultSet"); |
8273e845 |
382 | |
d7f20fdf |
383 | foreach my $track ($tracks->all) |
384 | { |
385 | isa_ok( $track, 'DBICTest::Track', 'Got Expected Track Class'); |
386 | } |
f8a464e5 |
387 | }, 'second create_related with same arguments'); |
e5dddc05 |
388 | |
f8a464e5 |
389 | lives_ok ( sub { |
04ec3909 |
390 | my $cdp = $schema->resultset('CD_to_Producer')->create({ |
391 | cd => { artist => 1, title => 'foo', year => 2000 }, |
392 | producer => { name => 'jorge' } |
393 | }); |
394 | ok($cdp, 'join table record created ok'); |
f8a464e5 |
395 | }, 'create of parents of a record linker table'); |
2bc3c81e |
396 | |
f8a464e5 |
397 | lives_ok ( sub { |
2bc3c81e |
398 | my $kurt_cobain = { name => 'Kurt Cobain' }; |
399 | |
400 | my $in_utero = $schema->resultset('CD')->new({ |
401 | title => 'In Utero', |
402 | year => 1993 |
403 | }); |
404 | |
405 | $kurt_cobain->{cds} = [ $in_utero ]; |
406 | |
d0cefd99 |
407 | warnings_exist { |
408 | $schema->resultset('Artist')->populate([ $kurt_cobain ]); |
409 | } qr/\QFast-path populate() with supplied related objects is not possible/; |
410 | |
2bc3c81e |
411 | |
65d35121 |
412 | my $artist = $schema->resultset('Artist')->find({name => 'Kurt Cobain'}); |
2bc3c81e |
413 | |
65d35121 |
414 | is($artist->name, 'Kurt Cobain', 'Artist insertion ok'); |
415 | is($artist->cds && $artist->cds->first && $artist->cds->first->title, |
d7f20fdf |
416 | 'In Utero', 'CD insertion ok'); |
f8a464e5 |
417 | }, 'populate'); |
e02b9964 |
418 | |
f847f84d |
419 | ## Create foreign key col obj including PK |
420 | ## See test 20 in 66relationships.t |
f8a464e5 |
421 | lives_ok ( sub { |
8273e845 |
422 | my $new_cd_hashref = { |
423 | cdid => 27, |
424 | title => 'Boogie Woogie', |
425 | year => '2007', |
04ec3909 |
426 | artist => { artistid => 17, name => 'king luke' } |
427 | }; |
e02b9964 |
428 | |
04ec3909 |
429 | my $cd = $schema->resultset("CD")->find(1); |
f10ac17d |
430 | |
04ec3909 |
431 | is($cd->artist->id, 1, 'rel okay'); |
f10ac17d |
432 | |
04ec3909 |
433 | my $new_cd = $schema->resultset("CD")->create($new_cd_hashref); |
434 | is($new_cd->artist->id, 17, 'new id retained okay'); |
f8a464e5 |
435 | }, 'Create foreign key col obj including PK'); |
6ede9177 |
436 | |
f8a464e5 |
437 | lives_ok ( sub { |
8273e845 |
438 | $schema->resultset("CD")->create({ |
439 | cdid => 28, |
440 | title => 'Boogie Wiggle', |
441 | year => '2007', |
38c03c20 |
442 | artist => { artistid => 18, name => 'larry' } |
6ede9177 |
443 | }); |
f8a464e5 |
444 | }, 'new cd created without clash on related artist'); |
38c03c20 |
445 | |
f8a464e5 |
446 | throws_ok ( sub { |
370f2ba2 |
447 | my $t = $schema->resultset("Track")->new({ cd => { artist => undef } }); |
448 | #$t->cd($t->new_related('cd', { artist => undef } ) ); |
449 | #$t->{_rel_in_storage} = 0; |
f10ac17d |
450 | $t->insert; |
ed5550d3 |
451 | }, qr/DBI Exception.+(?x: |
452 | \QNOT NULL constraint failed: cd.artist\E |
453 | | |
454 | \Qcd.artist may not be NULL\E |
455 | )/s, "Exception propogated properly"); |
bbbf67eb |
456 | |
f8a464e5 |
457 | lives_ok ( sub { |
04ec3909 |
458 | $schema->resultset('CD')->create ({ |
459 | artist => { |
460 | name => 'larry', # should already exist |
461 | }, |
76b8cf98 |
462 | title => 'Warble Marble', |
463 | year => '2009', |
464 | cd_to_producer => [ |
04ec3909 |
465 | { producer => { name => 'Cowboy Neal' } }, |
76b8cf98 |
466 | ], |
04ec3909 |
467 | }); |
76b8cf98 |
468 | |
04ec3909 |
469 | my $m2m_cd = $schema->resultset('CD')->search ({ title => 'Warble Marble'}); |
470 | is ($m2m_cd->count, 1, 'One CD row created via M2M create'); |
471 | is ($m2m_cd->first->producers->count, 1, 'CD row created with one producer'); |
472 | is ($m2m_cd->first->producers->first->name, 'Cowboy Neal', 'Correct producer row created'); |
f8a464e5 |
473 | }, 'Test multi create over many_to_many'); |
76b8cf98 |
474 | |
d0cefd99 |
475 | done_testing; |