Commit | Line | Data |
cc9d96d0 |
1 | use strict; |
2 | use warnings; |
3 | |
4 | use Test::More; |
5 | use Test::Exception; |
6 | use lib qw(t/lib); |
7 | use DBICTest; |
8 | |
9 | sub mc_diag { diag (@_) if $ENV{DBIC_MULTICREATE_DEBUG} }; |
10 | |
83896879 |
11 | plan tests => 30; |
cc9d96d0 |
12 | |
13 | my $schema = DBICTest->init_schema(); |
14 | |
15 | mc_diag (<<'DG'); |
16 | * Test a multilevel might-have/has_one with a PK == FK in the mid-table |
17 | |
18 | CD -> might have -> Artwork |
19 | \- has_one -/ \ |
20 | \ |
21 | \-> has_many \ |
22 | --> Artwork_to_Artist |
23 | /-> has_many / |
24 | / |
25 | Artist |
26 | DG |
27 | |
28 | my $rels = { |
29 | has_one => 'mandatory_artwork', |
30 | might_have => 'artwork', |
31 | }; |
32 | |
9c3018b6 |
33 | for my $type (qw/has_one might_have/) { |
34 | |
35 | lives_ok (sub { |
cc9d96d0 |
36 | |
9c3018b6 |
37 | my $rel = $rels->{$type}; |
38 | my $cd_title = "Simple test $type cd"; |
39 | |
40 | my $cd = $schema->resultset('CD')->create ({ |
41 | artist => 1, |
42 | title => $cd_title, |
43 | year => 2008, |
44 | $rel => {}, |
45 | }); |
46 | |
47 | isa_ok ($cd, 'DBICTest::CD', 'Main CD object created'); |
48 | is ($cd->title, $cd_title, 'Correct CD title'); |
49 | |
50 | isa_ok ($cd->$rel, 'DBICTest::Artwork', 'Related artwork present'); |
51 | ok ($cd->$rel->in_storage, 'And in storage'); |
52 | |
53 | }, "Simple $type creation"); |
54 | } |
55 | |
56 | my $artist_rs = $schema->resultset('Artist'); |
cc9d96d0 |
57 | for my $type (qw/has_one might_have/) { |
58 | |
59 | my $rel = $rels->{$type}; |
60 | |
61 | my $cd_title = "Test $type cd"; |
62 | my $artist_names = [ map { "Artist via $type $_" } (1, 2) ]; |
63 | |
64 | my $someartist = $artist_rs->next; |
65 | |
66 | lives_ok (sub { |
67 | my $cd = $schema->resultset('CD')->create ({ |
68 | artist => $someartist, |
69 | title => $cd_title, |
70 | year => 2008, |
71 | $rel => { |
72 | artwork_to_artist => [ map { |
73 | { artist => { name => $_ } } |
74 | } (@$artist_names) |
75 | ] |
76 | }, |
77 | }); |
78 | |
79 | |
80 | isa_ok ($cd, 'DBICTest::CD', 'Main CD object created'); |
81 | is ($cd->title, $cd_title, 'Correct CD title'); |
82 | |
83 | my $art_obj = $cd->$rel; |
84 | ok ($art_obj->has_column_loaded ('cd_id'), 'PK/FK present on artwork object'); |
85 | is ($art_obj->artists->count, 2, 'Correct artwork creator count via the new object'); |
86 | is_deeply ( |
87 | [ sort $art_obj->artists->get_column ('name')->all ], |
88 | $artist_names, |
89 | 'Artists named correctly when queried via object', |
90 | ); |
91 | |
92 | my $artwork = $schema->resultset('Artwork')->search ( |
93 | { 'cd.title' => $cd_title }, |
94 | { join => 'cd' }, |
95 | )->single; |
96 | is ($artwork->artists->count, 2, 'Correct artwork creator count via a new search'); |
97 | is_deeply ( |
98 | [ sort $artwork->artists->get_column ('name')->all ], |
99 | $artist_names, |
100 | 'Artists named correctly queried via a new search', |
101 | ); |
102 | }, "multilevel $type with a PK == FK in the $type/has_many table ok"); |
103 | } |
104 | |
83896879 |
105 | |
106 | mc_diag (<<'DG'); |
107 | * Try a diamond multicreate |
108 | |
109 | Artist -> has_many -> Artwork_to_Artist -> belongs_to |
110 | / |
111 | belongs_to <- CD <- belongs_to <- Artwork <-/ |
112 | \ |
113 | \-> Artist2 |
114 | |
115 | DG |
116 | |
117 | lives_ok (sub { |
118 | $schema->resultset ('Artist')->create ({ |
119 | name => 'The wooled wolf', |
120 | artwork_to_artist => [{ |
121 | artwork => { |
122 | cd => { |
123 | title => 'Wool explosive', |
124 | year => 1999, |
125 | artist => { name => 'The black exploding sheep' }, |
126 | } |
127 | } |
128 | }], |
129 | }); |
130 | |
131 | my $art2 = $schema->resultset ('Artist')->find ({ name => 'The black exploding sheep' }); |
132 | ok ($art2, 'Second artist exists'); |
133 | |
134 | my $cd = $art2->cds->single; |
135 | is ($cd->title, 'Wool explosive', 'correctly created CD'); |
136 | |
137 | is_deeply ( |
138 | [ $cd->artwork->artists->get_column ('name')->all ], |
139 | [ 'The wooled wolf' ], |
140 | 'Artist correctly attached to artwork', |
141 | ); |
142 | |
143 | }, 'Diamond chain creation ok'); |
144 | |