5 eval "use DBD::SQLite";
6 plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 53);
10 #local $SIG{__WARN__} =
11 #sub { like $_[0], qr/clashes with built-in method/, $_[0] };
15 Actor->has_a(film => 'Film');
16 sub Class::DBI::sheep { ok 0; }
19 sub Film::mutator_name {
20 my ($class, $col) = @_;
21 return "set_sheep" if lc $col eq "numexplodingsheep";
25 sub Film::accessor_name {
26 my ($class, $col) = @_;
27 return "sheep" if lc $col eq "numexplodingsheep";
31 sub Actor::accessor_name {
32 my ($class, $col) = @_;
33 return "movie" if lc $col eq "film";
39 Director => 'Peter Jackson',
45 $data->{NumExplodingSheep} = 1;
46 ok my $bt = Film->create($data), "Modified accessor - with column name";
49 is $@, '', "No errors";
54 ok my $bt = Film->create($data), "Modified accessor - with accessor";
57 is $@, '', "No errors";
60 my @film = Film->search({ sheep => 1 });
61 is @film, 2, "Can search with modified accessor";
67 local $data->{set_sheep} = 1;
68 ok my $bt = Film->create($data), "Modified mutator - with mutator";
71 is $@, '', "No errors";
74 local $data->{NumExplodingSheep} = 1;
75 ok my $bt = Film->create($data), "Modified mutator - with column name";
78 is $@, '', "No errors";
81 local $data->{sheep} = 1;
82 ok my $bt = Film->create($data), "Modified mutator - with accessor";
85 is $@, '', "No errors";
91 name => 'Peter Jackson',
94 my $bt = Film->create($data);
95 my $ac = Actor->create($p_data);
97 eval { my $f = $ac->film };
98 like $@, qr/film/, "no hasa film";
101 ok my $f = $ac->movie, "hasa movie";
103 is $f->id, $bt->id, " - Bad Taste";
105 is $@, '', "No errors";
108 local $data->{Title} = "Another film";
109 my $film = Film->create($data);
111 eval { $ac->film($film) };
114 eval { $ac->movie($film) };
118 ok $ac->set_film($film), "Set movie through hasa";
120 ok my $f = $ac->movie, "hasa movie";
122 is $f->id, $film->id, " - Another Film";
124 is $@, '', "No problem";
129 SKIP: { # have non persistent accessor?
130 #skip "Compat layer doesn't handle TEMP columns yet", 11;
131 Film->columns(TEMP => qw/nonpersistent/);
132 ok(Film->find_column('nonpersistent'), "nonpersistent is a column");
133 ok(!Film->has_real_column('nonpersistent'), " - but it's not real");
136 my $film = Film->create({ Title => "Veronique", nonpersistent => 42 });
137 is $film->title, "Veronique", "Title set OK";
138 is $film->nonpersistent, 42, "As is non persistent value";
139 $film->remove_from_object_index;
140 ok $film = Film->retrieve('Veronique'), "Re-retrieve film";
141 is $film->title, "Veronique", "Title still OK";
142 is $film->nonpersistent, undef, "Non persistent value gone";
143 ok $film->nonpersistent(40), "Can set it";
144 is $film->nonpersistent, 40, "And it's there again";
145 ok $film->update, "Commit the film";
146 is $film->nonpersistent, 40, "And it's still there";
150 SKIP: { # was bug with TEMP and no Essential
151 #skip "Compat layer doesn't have TEMP columns yet", 5;
153 Actor->columns('Essential'),
154 Actor->columns('Primary'),
155 "Actor has no specific essential columns"
157 ok(Actor->find_column('nonpersistent'), "nonpersistent is a column");
158 ok(!Actor->has_real_column('nonpersistent'), " - but it's not real");
159 my $pj = eval { Actor->search(name => "Peter Jackson")->first };
160 is $@, '', "no problems retrieving actors";
161 isa_ok $pj => "Actor";
165 #skip "Compat layer doesn't handle read-only objects yet", 10;
167 my $naked = Film->create({ title => 'Naked' });
168 my $sandl = Film->create({ title => 'Secrets and Lies' });
171 my $update_failure = sub {
173 eval { $obj->rating($rating++) };
174 return $@ =~ /read only/;
177 ok !$update_failure->($naked), "Can update Naked";
178 ok $naked->make_read_only, "Make Naked read only";
179 ok $update_failure->($naked), "Can't update Naked any more";
180 ok !$update_failure->($sandl), "But can still update Secrets and Lies";
181 my $july4 = eval { Film->create({ title => "4 Days in July" }) };
182 isa_ok $july4 => "Film", "And can still create new films";
184 ok(Film->make_read_only, "Make all Films read only");
185 ok $update_failure->($naked), "Still can't update Naked";
186 ok $update_failure->($sandl), "And can't update S&L any more";
187 eval { $july4->delete };
188 like $@, qr/read only/, "And can't delete 4 Days in July";
189 my $abigail = eval { Film->create({ title => "Abigail's Party" }) };
190 like $@, qr/read only/, "Or create new films";
191 $SIG{__WARN__} = sub { };