5 eval "use DBIx::Class::CDBICompat;";
7 plan (skip_all => 'Class::Trigger and DBIx::ContextualFetch required');
10 eval "use DBD::SQLite";
11 plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 75);
15 #local $SIG{__WARN__} =
16 #sub { like $_[0], qr/clashes with built-in method/, $_[0] };
22 Actor->has_a(film => 'Film');
23 Film->has_a(director => 'Director');
25 sub Class::DBI::sheep { ok 0; }
28 sub Film::mutator_name {
29 my ($class, $col) = @_;
30 return "set_sheep" if lc $col eq "numexplodingsheep";
34 sub Film::accessor_name {
35 my ($class, $col) = @_;
36 return "sheep" if lc $col eq "numexplodingsheep";
40 sub Actor::accessor_name_for {
41 my ($class, $col) = @_;
42 return "movie" if lc $col eq "film";
46 # This is a class with accessor_name_for() but no corresponding mutator_name_for()
47 sub Director::accessor_name_for {
48 my($class, $col) = @_;
49 return "nutty_as_a_fruitcake" if lc $col eq "isinsane";
55 Director => 'Peter Jackson',
60 my $data = { %$data };
61 $data->{NumExplodingSheep} = 1;
62 ok my $bt = Film->create($data), "Modified accessor - with column name";
64 is $bt->sheep, 1, 'sheep bursting violently';
66 is $@, '', "No errors";
69 my $data = { %$data };
71 ok my $bt = Film->create($data), "Modified accessor - with accessor";
73 is $bt->sheep, 2, 'sheep bursting violently';
75 is $@, '', "No errors";
78 my $data = { %$data };
79 $data->{NumExplodingSheep} = 1;
80 ok my $bt = Film->find_or_create($data),
81 "find_or_create Modified accessor - find with column name";
83 is $bt->sheep, 1, 'sheep bursting violently';
85 is $@, '', "No errors";
88 my $data = { %$data };
90 ok my $bt = Film->find_or_create($data),
91 "find_or_create Modified accessor - find with accessor";
93 is $bt->sheep, 1, 'sheep bursting violently';
95 is $@, '', "No errors";
98 my $data = { %$data };
99 $data->{NumExplodingSheep} = 3;
100 ok my $bt = Film->find_or_create($data),
101 "find_or_create Modified accessor - create with column name";
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";
113 is $bt->sheep, 4, 'sheep bursting violently';
115 is $@, '', "No errors";
118 my @film = Film->search({ sheep => 1 });
119 is @film, 2, "Can search with modified accessor";
121 is $@, '', "No errors";
126 local $data->{set_sheep} = 1;
127 ok my $bt = Film->create($data), "Modified mutator - with mutator";
130 is $@, '', "No errors";
133 local $data->{NumExplodingSheep} = 1;
134 ok my $bt = Film->create($data), "Modified mutator - with column name";
137 is $@, '', "No errors";
140 local $data->{sheep} = 1;
141 ok my $bt = Film->create($data), "Modified mutator - with accessor";
144 is $@, '', "No errors";
150 name => 'Peter Jackson',
153 my $bt = Film->create($data);
154 my $ac = Actor->create($p_data);
156 ok !eval { my $f = $ac->film; 1 };
157 like $@, qr/film/, "no hasa film";
160 local $SIG{__WARN__} = sub {
161 warn @_ unless $_[0] =~ /Query returned more than one row/;
163 ok my $f = $ac->movie, "hasa movie";
165 is $f->id, $bt->id, " - Bad Taste";
167 is $@, '', "No errors";
170 local $data->{Title} = "Another film";
171 my $film = Film->create($data);
173 eval { $ac->film($film) };
176 eval { $ac->movie($film) };
180 ok $ac->set_film($film), "Set movie through hasa";
182 ok my $f = $ac->movie, "hasa movie";
184 is $f->id, $film->id, " - Another Film";
186 is $@, '', "No problem";
192 # Make sure a class with an accessor_name() method has a similar mutator.
194 my $aki = Director->create({
195 name => "Aki Kaurismaki",
198 $aki->nutty_as_a_fruitcake(1);
199 is $aki->nutty_as_a_fruitcake, 1,
200 "a custom accessor without a custom mutator is setable";
205 Film->columns(TEMP => qw/nonpersistent/);
206 ok(Film->find_column('nonpersistent'), "nonpersistent is a column");
207 ok(!Film->has_real_column('nonpersistent'), " - but it's not real");
210 my $film = Film->create({ Title => "Veronique", nonpersistent => 42 });
211 is $film->title, "Veronique", "Title set OK";
212 is $film->nonpersistent, 42, "As is non persistent value";
213 $film->remove_from_object_index;
214 ok $film = Film->retrieve('Veronique'), "Re-retrieve film";
215 is $film->title, "Veronique", "Title still OK";
216 is $film->nonpersistent, undef, "Non persistent value gone";
217 ok $film->nonpersistent(40), "Can set it";
218 is $film->nonpersistent, 40, "And it's there again";
219 ok $film->update, "Commit the film";
220 is $film->nonpersistent, 40, "And it's still there";
226 [Actor->columns('Essential')],
227 [Actor->columns('Primary')],
228 "Actor has no specific essential columns"
230 ok(Actor->find_column('nonpersistent'), "nonpersistent is a column");
231 ok(!Actor->has_real_column('nonpersistent'), " - but it's not real");
232 my $pj = eval { Actor->search(name => "Peter Jackson")->first };
233 is $@, '', "no problems retrieving actors";
234 isa_ok $pj => "Actor";
239 my $naked = Film->create({ title => 'Naked' });
240 my $sandl = Film->create({ title => 'Secrets and Lies' });
243 my $update_failure = sub {
245 eval { $obj->rating($rating++) };
246 return $@ =~ /read only/;
249 ok !$update_failure->($naked), "Can update Naked";
250 ok $naked->make_read_only, "Make Naked read only";
251 ok $update_failure->($naked), "Can't update Naked any more";
252 ok !$update_failure->($sandl), "But can still update Secrets and Lies";
253 my $july4 = eval { Film->create({ title => "4 Days in July" }) };
254 isa_ok $july4 => "Film", "And can still create new films";
256 ok(Film->make_read_only, "Make all Films read only");
257 ok $update_failure->($naked), "Still can't update Naked";
258 ok $update_failure->($sandl), "And can't update S&L any more";
259 eval { $july4->delete };
260 like $@, qr/read only/, "And can't delete 4 Days in July";
261 my $abigail = eval { Film->create({ title => "Abigail's Party" }) };
262 like $@, qr/read only/, "Or create new films";
264 $sandl->discard_changes;