5 eval "use DBD::SQLite";
6 plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 41);
12 @YA::Film::ISA = 'Film';
14 Film->create_test_film;
16 ok my $btaste = Film->retrieve('Bad Taste'), "We have Bad Taste";
17 ok my $pj = $btaste->Director, "Bad taste has a director";
18 ok !ref($pj), ' ... which is not an object';
20 ok(Film->has_a('Director' => 'Director'), "Link Director table");
23 Name => 'Peter Jackson',
24 Birthday => -300000000,
32 ok $btaste = Film->retrieve('Bad Taste'), "Reretrieve Bad Taste";
33 ok $pj = $btaste->Director, "Bad taste now hasa() director";
34 isa_ok $pj => 'Director';
36 no warnings 'redefine';
37 local *Ima::DBI::st::execute =
38 sub { ::fail("Shouldn't need to query db"); };
39 is $pj->id, 'Peter Jackson', 'ID already stored';
41 ok $pj->IsInsane, "But we know he's insane";
44 # Oh no! Its Peter Jacksons even twin, Skippy! Born one minute after him.
45 my $sj = Director->create({
46 Name => 'Skippy Jackson',
47 Birthday => (-300000000 + 60),
52 eval { $btaste->Director($btaste) };
53 like $@, qr/Director/, "Can't set film as director";
54 is $btaste->Director->id, $pj->id, "PJ still the director";
56 # drop from cache so that next retrieve() is from db
57 $btaste->remove_from_object_index;
60 { # Still inflated after update
61 my $btaste = Film->retrieve('Bad Taste');
62 isa_ok $btaste->Director, "Director";
63 $btaste->numexplodingsheep(17);
65 isa_ok $btaste->Director, "Director";
67 $btaste->Director('Someone Else');
69 isa_ok $btaste->Director, "Director";
70 is $btaste->Director->id, "Someone Else", "Can change director";
73 is $sj->id, 'Skippy Jackson', 'Create new director - Skippy';
74 Film->has_a('CoDirector' => 'Director');
76 eval { $btaste->CoDirector("Skippy Jackson") };
77 is $@, "", "Auto inflates";
78 isa_ok $btaste->CoDirector, "Director";
79 is $btaste->CoDirector->id, $sj->id, "To skippy";
82 $btaste->CoDirector($sj);
84 is($btaste->CoDirector->Name, 'Skippy Jackson', 'He co-directed');
86 $btaste->Director->Name,
88 "Didnt interfere with each other"
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');
99 $sj = Director->retrieve('Skippy Jackson');
100 $pj = Director->retrieve('Peter Jackson');
104 $fail = YA::Film->create({
105 Title => 'Tastes Bad',
107 codirector => $btaste,
109 NumExplodingSheep => 23
112 ok $@, "Can't have film as codirector: $@";
113 is $fail, undef, "We didn't get anything";
115 my $tastes_bad = YA::Film->create({
116 Title => 'Tastes Bad',
120 NumExplodingSheep => 23
122 is($tastes_bad->Director->Name, 'Skippy Jackson', 'Director');
124 $tastes_bad->_director_accessor->Name,
128 is($tastes_bad->codirector->Name, 'Peter Jackson', 'codirector');
130 $tastes_bad->_codirector_accessor->Name,
132 'codirector_accessor'
137 skip "Non-standard CDBI relationships not supported by compat", 9;
140 YA::Film->add_relationship_type(has_a => "YA::HasA");
143 use base 'Class::DBI::Relationship::HasA';
147 my $col = $self->accessor;
148 my $super = $self->SUPER::_inflator($col);
151 unless $col eq $self->class->find_column('Director');
155 $self->_attribute_store($col, 'Ghostly Peter')
156 if $self->_attribute_exists($col)
157 and not defined $self->_attrs($col);
158 return &$super($self);
167 my ($class, $mpaa, @details) = @_;
173 sub mpaa { shift->{MPAA}; }
174 sub why { shift->{WHY}; }
176 local *Director::mapme = sub {
177 my ($class, $val) = @_;
178 $val =~ s/Skippy/Peter/;
182 local *Director::sanity_check = sub { $_[0]->IsInsane ? undef: $_[0] };
184 director => 'Director',
186 deflate => 'sanity_check'
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';
196 return new Rating $val, 'Just because';
203 my $tbad = YA::Film->retrieve('Tastes Bad');
205 isa_ok $tbad->Director, 'Director';
206 is $tbad->Director->Name, 'Peter Jackson', 'Director shuffle';
207 $tbad->Director('Skippy Jackson');
209 is $tbad->Director, 'Ghostly Peter', 'Sanity checked';
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;
221 $pj->update; # Hush warnings
223 ok $tbad->Director($btaste), 'Cross-class mapping';
224 is $tbad->Director, 'Peter Jackson', 'Yields PJ';
227 $tbad = Film->retrieve('Tastes Bad');
228 ok !ref($tbad->Rating), 'Unmagical rating';
229 is $tbad->Rating, 'NS17', 'but prior change stuck';
232 { # Broken has_a declaration
233 eval { Film->has_a(driector => "Director") };
234 like $@, qr/driector/, "Sensible error from has_a with incorrect column: $@";