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