Final round of detabify
[dbsrgits/DBIx-Class-Historic.git] / t / cdbi / 15-accessor.t
1 use strict;
2 use Test::More;
3
4 BEGIN {
5     eval "use DBIx::Class::CDBICompat;";
6     if ($@) {
7         plan (skip_all => 'Class::Trigger and DBIx::ContextualFetch required');
8         next;
9     }
10     eval "use DBD::SQLite";
11     plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 75);
12 }
13
14 INIT {
15     #local $SIG{__WARN__} =
16         #sub { like $_[0], qr/clashes with built-in method/, $_[0] };
17     use lib 't/cdbi/testlib';
18     require Film;
19     require Actor;
20     require Director;
21
22     Actor->has_a(film => 'Film');
23     Film->has_a(director => 'Director');
24
25     sub Class::DBI::sheep { ok 0; }
26 }
27
28 # Install the deprecation warning intercept here for the rest of the 08 dev cycle
29 local $SIG{__WARN__} = sub {
30   warn @_ unless (DBIx::Class->VERSION < 0.09 and $_[0] =~ /Query returned more than one row/);
31 };
32
33 sub Film::mutator_name {
34     my ($class, $col) = @_;
35     return "set_sheep" if lc $col eq "numexplodingsheep";
36     return $col;
37 }
38
39 sub Film::accessor_name {
40     my ($class, $col) = @_;
41     return "sheep" if lc $col eq "numexplodingsheep";
42     return $col;
43 }
44
45 sub Actor::accessor_name_for {
46     my ($class, $col) = @_;
47     return "movie" if lc $col eq "film";
48     return $col;
49 }
50
51 # This is a class with accessor_name_for() but no corresponding mutator_name_for()
52 sub Director::accessor_name_for {
53     my($class, $col) = @_;
54     return "nutty_as_a_fruitcake" if lc $col eq "isinsane";
55     return $col;
56 }
57
58 my $data = {
59     Title    => 'Bad Taste',
60     Director => 'Peter Jackson',
61     Rating   => 'R',
62 };
63
64 eval {
65     my $data = { %$data };
66     $data->{NumExplodingSheep} = 1;
67     ok my $bt = Film->create($data), "Modified accessor - with column name";
68     isa_ok $bt, "Film";
69     is $bt->sheep, 1, 'sheep bursting violently';
70 };
71 is $@, '', "No errors";
72
73 eval {
74     my $data = { %$data };
75     $data->{sheep} = 2;
76     ok my $bt = Film->create($data), "Modified accessor - with accessor";
77     isa_ok $bt, "Film";
78     is $bt->sheep, 2, 'sheep bursting violently';
79 };
80 is $@, '', "No errors";
81
82 eval {
83     my $data = { %$data };
84     $data->{NumExplodingSheep} = 1;
85     ok my $bt = Film->find_or_create($data),
86     "find_or_create Modified accessor - find with column name";
87     isa_ok $bt, "Film";
88     is $bt->sheep, 1, 'sheep bursting violently';
89 };
90 is $@, '', "No errors";
91
92 eval {
93     my $data = { %$data };
94     $data->{sheep} = 1;
95     ok my $bt = Film->find_or_create($data),
96     "find_or_create Modified accessor - find with accessor";
97     isa_ok $bt, "Film";
98     is $bt->sheep, 1, 'sheep bursting violently';
99 };
100 is $@, '', "No errors";
101
102 TODO: { local $TODO = 'TODOifying failing tests, waiting for Schwern'; ok (1, 'remove me');
103 eval {
104     my $data = { %$data };
105     $data->{NumExplodingSheep} = 3;
106     ok my $bt = Film->find_or_create($data),
107     "find_or_create Modified accessor - create with column name";
108     isa_ok $bt, "Film";
109     is $bt->sheep, 3, 'sheep bursting violently';
110 };
111 is $@, '', "No errors";
112
113 eval {
114     my $data = { %$data };
115     $data->{sheep} = 4;
116     ok my $bt = Film->find_or_create($data),
117     "find_or_create Modified accessor - create with accessor";
118     isa_ok $bt, "Film";
119     is $bt->sheep, 4, 'sheep bursting violently';
120 };
121 is $@, '', "No errors";
122
123 eval {
124     my @film = Film->search({ sheep => 1 });
125     is @film, 2, "Can search with modified accessor";
126 };
127 is $@, '', "No errors";
128
129 }
130
131 {
132
133     eval {
134         local $data->{set_sheep} = 1;
135         ok my $bt = Film->create($data), "Modified mutator - with mutator";
136         isa_ok $bt, "Film";
137     };
138     is $@, '', "No errors";
139
140     eval {
141         local $data->{NumExplodingSheep} = 1;
142         ok my $bt = Film->create($data), "Modified mutator - with column name";
143         isa_ok $bt, "Film";
144     };
145     is $@, '', "No errors";
146
147     eval {
148         local $data->{sheep} = 1;
149         ok my $bt = Film->create($data), "Modified mutator - with accessor";
150         isa_ok $bt, "Film";
151     };
152     is $@, '', "No errors";
153
154 }
155
156 {
157     my $p_data = {
158         name => 'Peter Jackson',
159         film => 'Bad Taste',
160     };
161     my $bt = Film->create($data);
162     my $ac = Actor->create($p_data);
163
164     ok !eval { my $f = $ac->film; 1 };
165     like $@, qr/film/, "no hasa film";
166
167     eval {
168         ok my $f = $ac->movie, "hasa movie";
169         isa_ok $f, "Film";
170         is $f->id, $bt->id, " - Bad Taste";
171     };
172     is $@, '', "No errors";
173
174     {
175         local $data->{Title} = "Another film";
176         my $film = Film->create($data);
177
178         eval { $ac->film($film) };
179         ok $@, $@;
180
181         eval { $ac->movie($film) };
182         ok $@, $@;
183
184         eval {
185             ok $ac->set_film($film), "Set movie through hasa";
186             $ac->update;
187             ok my $f = $ac->movie, "hasa movie";
188             isa_ok $f, "Film";
189             is $f->id, $film->id, " - Another Film";
190         };
191         is $@, '', "No problem";
192     }
193
194 }
195
196
197 # Make sure a class with an accessor_name() method has a similar mutator.
198 {
199     my $aki = Director->create({
200         name     => "Aki Kaurismaki",
201     });
202
203     $aki->nutty_as_a_fruitcake(1);
204     is $aki->nutty_as_a_fruitcake, 1,
205         "a custom accessor without a custom mutator is setable";
206     $aki->update;
207 }
208
209 {
210     Film->columns(TEMP => qw/nonpersistent/);
211     ok(Film->find_column('nonpersistent'), "nonpersistent is a column");
212     ok(!Film->has_real_column('nonpersistent'), " - but it's not real");
213
214     {
215         my $film = Film->create({ Title => "Veronique", nonpersistent => 42 });
216         is $film->title,         "Veronique", "Title set OK";
217         is $film->nonpersistent, 42,          "As is non persistent value";
218         $film->remove_from_object_index;
219         ok $film = Film->retrieve('Veronique'), "Re-retrieve film";
220         is $film->title, "Veronique", "Title still OK";
221         is $film->nonpersistent, undef, "Non persistent value gone";
222         ok $film->nonpersistent(40), "Can set it";
223         is $film->nonpersistent, 40, "And it's there again";
224         ok $film->update, "Commit the film";
225         is $film->nonpersistent, 40, "And it's still there";
226     }
227 }
228
229 {
230     is_deeply(
231         [Actor->columns('Essential')],
232         [Actor->columns('Primary')],
233         "Actor has no specific essential columns"
234     );
235     ok(Actor->find_column('nonpersistent'), "nonpersistent is a column");
236     ok(!Actor->has_real_column('nonpersistent'), " - but it's not real");
237     my $pj = eval { Actor->search(name => "Peter Jackson")->first };
238     is $@, '', "no problems retrieving actors";
239     isa_ok $pj => "Actor";
240 }
241
242 {
243     Film->autoupdate(1);
244     my $naked = Film->create({ title => 'Naked' });
245     my $sandl = Film->create({ title => 'Secrets and Lies' });
246
247     my $rating = 1;
248     my $update_failure = sub {
249         my $obj = shift;
250         eval { $obj->rating($rating++) };
251         return $@ =~ /read only/;
252     };
253
254     ok !$update_failure->($naked), "Can update Naked";
255     ok $naked->make_read_only, "Make Naked read only";
256     ok $update_failure->($naked), "Can't update Naked any more";
257     ok !$update_failure->($sandl), "But can still update Secrets and Lies";
258     my $july4 = eval { Film->create({ title => "4 Days in July" }) };
259     isa_ok $july4 => "Film", "And can still create new films";
260
261     ok(Film->make_read_only, "Make all Films read only");
262     ok $update_failure->($naked), "Still can't update Naked";
263     ok $update_failure->($sandl), "And can't update S&L any more";
264     eval { $july4->delete };
265     like $@, qr/read only/, "And can't delete 4 Days in July";
266     my $abigail = eval { Film->create({ title => "Abigail's Party" }) };
267     like $@, qr/read only/, "Or create new films";
268
269     $_->discard_changes for ($naked, $sandl);
270 }