Commit | Line | Data |
c0329273 |
1 | BEGIN { do "./t/lib/ANFANG.pm" or die ( $@ || $! ) } |
83eef562 |
2 | use DBIx::Class::Optional::Dependencies -skip_all_without => 'cdbicompat'; |
3 | |
9bc6db13 |
4 | use strict; |
4a233f30 |
5 | use warnings; |
83eef562 |
6 | |
9bc6db13 |
7 | use Test::More; |
7e5a0e7c |
8 | use Test::Exception; |
9 | use DBIx::Class::_Util 'sigwarn_silencer'; |
9bc6db13 |
10 | |
50891152 |
11 | use lib 't/cdbi/testlib'; |
9bc6db13 |
12 | use Film; |
13 | use Director; |
14 | @YA::Film::ISA = 'Film'; |
15 | |
16 | Film->create_test_film; |
17 | |
18 | ok my $btaste = Film->retrieve('Bad Taste'), "We have Bad Taste"; |
19 | ok my $pj = $btaste->Director, "Bad taste has a director"; |
20 | ok !ref($pj), ' ... which is not an object'; |
21 | |
22 | ok(Film->has_a('Director' => 'Director'), "Link Director table"); |
23 | ok( |
6a3bf251 |
24 | Director->create({ |
25 | Name => 'Peter Jackson', |
26 | Birthday => -300000000, |
27 | IsInsane => 1 |
28 | } |
29 | ), |
30 | 'create Director' |
9bc6db13 |
31 | ); |
32 | |
33 | { |
6a3bf251 |
34 | ok $btaste = Film->retrieve('Bad Taste'), "Reretrieve Bad Taste"; |
35 | ok $pj = $btaste->Director, "Bad taste now hasa() director"; |
36 | isa_ok $pj => 'Director'; |
37 | { |
38 | no warnings qw(redefine once); |
39 | local *Ima::DBI::st::execute = |
40 | sub { ::fail("Shouldn't need to query db"); }; |
41 | is $pj->id, 'Peter Jackson', 'ID already stored'; |
42 | } |
43 | ok $pj->IsInsane, "But we know he's insane"; |
9bc6db13 |
44 | } |
45 | |
46 | # Oh no! Its Peter Jacksons even twin, Skippy! Born one minute after him. |
47 | my $sj = Director->create({ |
6a3bf251 |
48 | Name => 'Skippy Jackson', |
49 | Birthday => (-300000000 + 60), |
50 | IsInsane => 1, |
51 | }); |
9bc6db13 |
52 | |
53 | { |
7e5a0e7c |
54 | throws_ok { $btaste->Director($btaste) } |
55 | qr/isn't a Director/, "Can't set film as director"; |
6a3bf251 |
56 | is $btaste->Director->id, $pj->id, "PJ still the director"; |
9bc6db13 |
57 | |
6a3bf251 |
58 | # drop from cache so that next retrieve() is from db |
59 | $btaste->remove_from_object_index; |
9bc6db13 |
60 | } |
61 | |
62 | { # Still inflated after update |
6a3bf251 |
63 | my $btaste = Film->retrieve('Bad Taste'); |
64 | isa_ok $btaste->Director, "Director"; |
65 | $btaste->numexplodingsheep(17); |
66 | $btaste->update; |
67 | isa_ok $btaste->Director, "Director"; |
68 | |
69 | $btaste->Director('Someone Else'); |
70 | $btaste->update; |
71 | isa_ok $btaste->Director, "Director"; |
72 | is $btaste->Director->id, "Someone Else", "Can change director"; |
9bc6db13 |
73 | } |
74 | |
75 | is $sj->id, 'Skippy Jackson', 'Create new director - Skippy'; |
76 | Film->has_a('CoDirector' => 'Director'); |
77 | { |
7e5a0e7c |
78 | lives_ok { $btaste->CoDirector("Skippy Jackson") }; |
6a3bf251 |
79 | isa_ok $btaste->CoDirector, "Director"; |
80 | is $btaste->CoDirector->id, $sj->id, "To skippy"; |
9bc6db13 |
81 | } |
82 | |
83 | $btaste->CoDirector($sj); |
84 | $btaste->update; |
85 | is($btaste->CoDirector->Name, 'Skippy Jackson', 'He co-directed'); |
86 | is( |
6a3bf251 |
87 | $btaste->Director->Name, |
88 | 'Peter Jackson', |
89 | "Didnt interfere with each other" |
9bc6db13 |
90 | ); |
91 | |
92 | { # Inheriting hasa |
6a3bf251 |
93 | my $btaste = YA::Film->retrieve('Bad Taste'); |
94 | is(ref($btaste->Director), 'Director', 'inheriting hasa()'); |
95 | is(ref($btaste->CoDirector), 'Director', 'inheriting hasa()'); |
96 | is($btaste->CoDirector->Name, 'Skippy Jackson', ' ... correctly'); |
9bc6db13 |
97 | } |
98 | |
99 | { |
6a3bf251 |
100 | $sj = Director->retrieve('Skippy Jackson'); |
101 | $pj = Director->retrieve('Peter Jackson'); |
102 | |
103 | my $fail; |
7e5a0e7c |
104 | throws_ok { |
105 | local $SIG{__WARN__} = sigwarn_silencer( qr/\Qusually should inherit from the related ResultClass ('Director')/ ); |
6a3bf251 |
106 | $fail = YA::Film->create({ |
107 | Title => 'Tastes Bad', |
108 | Director => $sj, |
109 | codirector => $btaste, |
110 | Rating => 'R', |
111 | NumExplodingSheep => 23 |
112 | }); |
7e5a0e7c |
113 | } qr/isn't a Director/, "Can't have film as codirector"; |
6a3bf251 |
114 | is $fail, undef, "We didn't get anything"; |
115 | |
116 | my $tastes_bad = YA::Film->create({ |
117 | Title => 'Tastes Bad', |
118 | Director => $sj, |
119 | codirector => $pj, |
120 | Rating => 'R', |
121 | NumExplodingSheep => 23 |
122 | }); |
123 | is($tastes_bad->Director->Name, 'Skippy Jackson', 'Director'); |
124 | is( |
125 | $tastes_bad->_director_accessor->Name, |
126 | 'Skippy Jackson', |
127 | 'director_accessor' |
128 | ); |
129 | is($tastes_bad->codirector->Name, 'Peter Jackson', 'codirector'); |
130 | is( |
131 | $tastes_bad->_codirector_accessor->Name, |
132 | 'Peter Jackson', |
133 | 'codirector_accessor' |
134 | ); |
9bc6db13 |
135 | } |
136 | |
137 | SKIP: { |
138 | skip "Non-standard CDBI relationships not supported by compat", 9; |
6a3bf251 |
139 | { |
140 | |
141 | YA::Film->add_relationship_type(has_a => "YA::HasA"); |
142 | |
143 | package YA::HasA; |
144 | #use base 'Class::DBI::Relationship::HasA'; |
145 | |
146 | sub _inflator { |
147 | my $self = shift; |
148 | my $col = $self->accessor; |
149 | my $super = $self->SUPER::_inflator($col); |
150 | |
151 | return $super |
152 | unless $col eq $self->class->find_column('Director'); |
153 | |
154 | return sub { |
155 | my $self = shift; |
156 | $self->_attribute_store($col, 'Ghostly Peter') |
157 | if $self->_attribute_exists($col) |
158 | and not defined $self->_attrs($col); |
159 | return &$super($self); |
160 | }; |
161 | } |
162 | } |
163 | { |
164 | |
165 | package Rating; |
166 | |
167 | sub new { |
168 | my ($class, $mpaa, @details) = @_; |
169 | bless { |
170 | MPAA => $mpaa, |
171 | WHY => "@details" |
172 | }, $class; |
173 | } |
174 | sub mpaa { shift->{MPAA}; } |
175 | sub why { shift->{WHY}; } |
176 | } |
177 | local *Director::mapme = sub { |
178 | my ($class, $val) = @_; |
179 | $val =~ s/Skippy/Peter/; |
180 | $val; |
181 | }; |
182 | no warnings 'once'; |
183 | local *Director::sanity_check = sub { $_[0]->IsInsane ? undef: $_[0] }; |
184 | YA::Film->has_a( |
185 | director => 'Director', |
186 | inflate => 'mapme', |
187 | deflate => 'sanity_check' |
188 | ); |
189 | YA::Film->has_a( |
190 | rating => 'Rating', |
191 | inflate => sub { |
192 | my ($val, $parent) = @_; |
193 | my $sheep = $parent->find_column('NumexplodingSheep'); |
194 | if ($parent->_attrs($sheep) || 0 > 20) { |
195 | return new Rating 'NC17', 'Graphic ovine violence'; |
196 | } else { |
197 | return new Rating $val, 'Just because'; |
198 | } |
199 | }, |
200 | deflate => sub { |
201 | shift->mpaa; |
202 | }); |
203 | |
204 | my $tbad = YA::Film->retrieve('Tastes Bad'); |
205 | |
206 | isa_ok $tbad->Director, 'Director'; |
207 | is $tbad->Director->Name, 'Peter Jackson', 'Director shuffle'; |
208 | $tbad->Director('Skippy Jackson'); |
209 | $tbad->update; |
210 | is $tbad->Director, 'Ghostly Peter', 'Sanity checked'; |
211 | |
212 | isa_ok $tbad->Rating, 'Rating'; |
213 | is $tbad->Rating->mpaa, 'NC17', 'Rating bumped'; |
214 | $tbad->Rating(new Rating 'NS17', 'Shaken sheep'); |
215 | no warnings 'redefine'; |
216 | local *Director::mapme = sub { |
217 | my ($class, $obj) = @_; |
218 | $obj->isa('Film') ? $obj->Director : $obj; |
219 | }; |
220 | |
221 | $pj->IsInsane(0); |
222 | $pj->update; # Hush warnings |
223 | |
224 | ok $tbad->Director($btaste), 'Cross-class mapping'; |
225 | is $tbad->Director, 'Peter Jackson', 'Yields PJ'; |
226 | $tbad->update; |
227 | |
228 | $tbad = Film->retrieve('Tastes Bad'); |
229 | ok !ref($tbad->Rating), 'Unmagical rating'; |
230 | is $tbad->Rating, 'NS17', 'but prior change stuck'; |
9bc6db13 |
231 | } |
232 | |
233 | { # Broken has_a declaration |
7e5a0e7c |
234 | throws_ok{ Film->has_a(driector => "Director") } |
235 | qr/No such column driector/, |
236 | "Sensible error from has_a with incorrect column" |
237 | ; |
9bc6db13 |
238 | } |
d9bd5195 |
239 | |
240 | done_testing; |