1 BEGIN { do "./t/lib/ANFANG.pm" or die ( $@ || $! ) }
2 use DBIx::Class::Optional::Dependencies -skip_all_without => 'cdbicompat';
9 use lib 't/cdbi/testlib';
15 Actor->has_a(film => 'Film');
16 Film->has_a(director => 'Director');
18 sub Class::DBI::sheep { ok 0; }
21 # Install the deprecation warning intercept here for the rest of the 08 dev cycle
22 local $SIG{__WARN__} = sub {
23 warn @_ unless (DBIx::Class->VERSION < 0.09 and $_[0] =~ /Query returned more than one row/);
26 sub Film::mutator_name {
27 my ($class, $col) = @_;
28 return "set_sheep" if lc $col eq "numexplodingsheep";
32 sub Film::accessor_name {
33 my ($class, $col) = @_;
34 return "sheep" if lc $col eq "numexplodingsheep";
38 sub Actor::accessor_name_for {
39 my ($class, $col) = @_;
40 return "movie" if lc $col eq "film";
44 # This is a class with accessor_name_for() but no corresponding mutator_name_for()
45 sub Director::accessor_name_for {
46 my($class, $col) = @_;
47 return "nutty_as_a_fruitcake" if lc $col eq "isinsane";
53 Director => 'Peter Jackson',
58 my $data = { %$data };
59 $data->{NumExplodingSheep} = 1;
60 ok my $bt = Film->create($data), "Modified accessor - with column name";
62 is $bt->sheep, 1, 'sheep bursting violently';
64 is $@, '', "No errors";
67 my $data = { %$data };
69 ok my $bt = Film->create($data), "Modified accessor - with accessor";
71 is $bt->sheep, 2, 'sheep bursting violently';
73 is $@, '', "No errors";
76 my $data = { %$data };
77 $data->{NumExplodingSheep} = 1;
78 ok my $bt = Film->find_or_create($data),
79 "find_or_create Modified accessor - find with column name";
81 is $bt->sheep, 1, 'sheep bursting violently';
83 is $@, '', "No errors";
86 my $data = { %$data };
88 ok my $bt = Film->find_or_create($data),
89 "find_or_create Modified accessor - find with accessor";
91 is $bt->sheep, 1, 'sheep bursting violently';
93 is $@, '', "No errors";
96 my $data = { %$data };
97 $data->{NumExplodingSheep} = 3;
98 ok my $bt = Film->find_or_create($data),
99 "find_or_create Modified accessor - create with column name";
102 local $TODO = 'TODOifying failing tests, waiting for Schwern';
103 is $bt->sheep, 3, 'sheep bursting violently';
105 is $@, '', "No errors";
108 my $data = { %$data };
110 ok my $bt = Film->find_or_create($data),
111 "find_or_create Modified accessor - create with accessor";
114 local $TODO = 'TODOifying failing tests, waiting for Schwern';
115 is $bt->sheep, 4, 'sheep bursting violently';
117 is $@, '', "No errors";
120 my @film = Film->search({ sheep => 1 });
121 is @film, 2, "Can search with modified accessor";
124 local $TODO = 'TODOifying failing tests, waiting for Schwern';
125 is $@, '', "No errors";
131 local $data->{set_sheep} = 1;
132 ok my $bt = Film->create($data), "Modified mutator - with mutator";
135 is $@, '', "No errors";
138 local $data->{NumExplodingSheep} = 1;
139 ok my $bt = Film->create($data), "Modified mutator - with column name";
142 is $@, '', "No errors";
145 local $data->{sheep} = 1;
146 ok my $bt = Film->create($data), "Modified mutator - with accessor";
149 is $@, '', "No errors";
155 name => 'Peter Jackson',
158 my $bt = Film->create($data);
159 my $ac = Actor->create($p_data);
161 ok !eval { my $f = $ac->film; 1 };
162 like $@, qr/film/, "no hasa film";
165 ok my $f = $ac->movie, "hasa movie";
167 is $f->id, $bt->id, " - Bad Taste";
169 is $@, '', "No errors";
172 local $data->{Title} = "Another film";
173 my $film = Film->create($data);
175 eval { $ac->film($film) };
178 eval { $ac->movie($film) };
182 ok $ac->set_film($film), "Set movie through hasa";
184 ok my $f = $ac->movie, "hasa movie";
186 is $f->id, $film->id, " - Another Film";
188 is $@, '', "No problem";
194 # Make sure a class with an accessor_name() method has a similar mutator.
196 my $aki = Director->create({
197 name => "Aki Kaurismaki",
200 $aki->nutty_as_a_fruitcake(1);
201 is $aki->nutty_as_a_fruitcake, 1,
202 "a custom accessor without a custom mutator is setable";
207 Film->columns(TEMP => qw/nonpersistent/);
208 ok(Film->find_column('nonpersistent'), "nonpersistent is a column");
209 ok(!Film->has_real_column('nonpersistent'), " - but it's not real");
212 my $film = Film->create({ Title => "Veronique", nonpersistent => 42 });
213 is $film->title, "Veronique", "Title set OK";
214 is $film->nonpersistent, 42, "As is non persistent value";
215 $film->remove_from_object_index;
216 ok $film = Film->retrieve('Veronique'), "Re-retrieve film";
217 is $film->title, "Veronique", "Title still OK";
218 is $film->nonpersistent, undef, "Non persistent value gone";
219 ok $film->nonpersistent(40), "Can set it";
220 is $film->nonpersistent, 40, "And it's there again";
221 ok $film->update, "Commit the film";
222 is $film->nonpersistent, 40, "And it's still there";
228 [Actor->columns('Essential')],
229 [Actor->columns('Primary')],
230 "Actor has no specific essential columns"
232 ok(Actor->find_column('nonpersistent'), "nonpersistent is a column");
233 ok(!Actor->has_real_column('nonpersistent'), " - but it's not real");
234 my $pj = eval { Actor->search(name => "Peter Jackson")->first };
235 is $@, '', "no problems retrieving actors";
236 isa_ok $pj => "Actor";
241 my $naked = Film->create({ title => 'Naked' });
242 my $sandl = Film->create({ title => 'Secrets and Lies' });
245 my $update_failure = sub {
247 eval { $obj->rating($rating++) };
248 return $@ =~ /read only/;
251 ok !$update_failure->($naked), "Can update Naked";
252 ok $naked->make_read_only, "Make Naked read only";
253 ok $update_failure->($naked), "Can't update Naked any more";
254 ok !$update_failure->($sandl), "But can still update Secrets and Lies";
255 my $july4 = eval { Film->create({ title => "4 Days in July" }) };
256 isa_ok $july4 => "Film", "And can still create new films";
258 ok(Film->make_read_only, "Make all Films read only");
259 ok $update_failure->($naked), "Still can't update Naked";
260 ok $update_failure->($sandl), "And can't update S&L any more";
261 eval { $july4->delete };
262 like $@, qr/read only/, "And can't delete 4 Days in July";
263 my $abigail = eval { Film->create({ title => "Abigail's Party" }) };
264 like $@, qr/read only/, "Or create new films";
266 $_->discard_changes for ($naked, $sandl);