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