1 BEGIN { do "./t/lib/ANFANG.pm" or die ( $@ || $! ) }
2 use DBIx::Class::Optional::Dependencies -skip_all_without => 'cdbicompat';
9 use DBIx::Class::_Util 'sigwarn_silencer';
11 use lib 't/cdbi/testlib';
14 @YA::Film::ISA = 'Film';
16 Film->create_test_film;
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';
22 ok(Film->has_a('Director' => 'Director'), "Link Director table");
25 Name => 'Peter Jackson',
26 Birthday => -300000000,
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';
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';
43 ok $pj->IsInsane, "But we know he's insane";
46 # Oh no! Its Peter Jacksons even twin, Skippy! Born one minute after him.
47 my $sj = Director->create({
48 Name => 'Skippy Jackson',
49 Birthday => (-300000000 + 60),
54 throws_ok { $btaste->Director($btaste) }
55 qr/isn't a Director/, "Can't set film as director";
56 is $btaste->Director->id, $pj->id, "PJ still the director";
58 # drop from cache so that next retrieve() is from db
59 $btaste->remove_from_object_index;
62 { # Still inflated after update
63 my $btaste = Film->retrieve('Bad Taste');
64 isa_ok $btaste->Director, "Director";
65 $btaste->numexplodingsheep(17);
67 isa_ok $btaste->Director, "Director";
69 $btaste->Director('Someone Else');
71 isa_ok $btaste->Director, "Director";
72 is $btaste->Director->id, "Someone Else", "Can change director";
75 is $sj->id, 'Skippy Jackson', 'Create new director - Skippy';
76 Film->has_a('CoDirector' => 'Director');
78 lives_ok { $btaste->CoDirector("Skippy Jackson") };
79 isa_ok $btaste->CoDirector, "Director";
80 is $btaste->CoDirector->id, $sj->id, "To skippy";
83 $btaste->CoDirector($sj);
85 is($btaste->CoDirector->Name, 'Skippy Jackson', 'He co-directed');
87 $btaste->Director->Name,
89 "Didnt interfere with each other"
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');
100 $sj = Director->retrieve('Skippy Jackson');
101 $pj = Director->retrieve('Peter Jackson');
105 local $SIG{__WARN__} = sigwarn_silencer( qr/\Qusually should inherit from the related ResultClass ('Director')/ );
106 $fail = YA::Film->create({
107 Title => 'Tastes Bad',
109 codirector => $btaste,
111 NumExplodingSheep => 23
113 } qr/is not a column on related source 'Director'/, "Can't have film as codirector";
114 is $fail, undef, "We didn't get anything";
116 my $tastes_bad = YA::Film->create({
117 Title => 'Tastes Bad',
121 NumExplodingSheep => 23
123 is($tastes_bad->Director->Name, 'Skippy Jackson', 'Director');
125 $tastes_bad->_director_accessor->Name,
129 is($tastes_bad->codirector->Name, 'Peter Jackson', 'codirector');
131 $tastes_bad->_codirector_accessor->Name,
133 'codirector_accessor'
138 skip "Non-standard CDBI relationships not supported by compat", 9;
141 YA::Film->add_relationship_type(has_a => "YA::HasA");
144 #use base 'Class::DBI::Relationship::HasA';
148 my $col = $self->accessor;
149 my $super = $self->SUPER::_inflator($col);
152 unless $col eq $self->class->find_column('Director');
156 $self->_attribute_store($col, 'Ghostly Peter')
157 if $self->_attribute_exists($col)
158 and not defined $self->_attrs($col);
159 return &$super($self);
168 my ($class, $mpaa, @details) = @_;
174 sub mpaa { shift->{MPAA}; }
175 sub why { shift->{WHY}; }
177 local *Director::mapme = sub {
178 my ($class, $val) = @_;
179 $val =~ s/Skippy/Peter/;
183 local *Director::sanity_check = sub { $_[0]->IsInsane ? undef: $_[0] };
185 director => 'Director',
187 deflate => 'sanity_check'
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';
197 return new Rating $val, 'Just because';
204 my $tbad = YA::Film->retrieve('Tastes Bad');
206 isa_ok $tbad->Director, 'Director';
207 is $tbad->Director->Name, 'Peter Jackson', 'Director shuffle';
208 $tbad->Director('Skippy Jackson');
210 is $tbad->Director, 'Ghostly Peter', 'Sanity checked';
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;
222 $pj->update; # Hush warnings
224 ok $tbad->Director($btaste), 'Cross-class mapping';
225 is $tbad->Director, 'Peter Jackson', 'Yields PJ';
228 $tbad = Film->retrieve('Tastes Bad');
229 ok !ref($tbad->Rating), 'Unmagical rating';
230 is $tbad->Rating, 'NS17', 'but prior change stuck';
233 { # Broken has_a declaration
234 throws_ok{ Film->has_a(driector => "Director") }
235 qr/No such column driector/,
236 "Sensible error from has_a with incorrect column"