Add strict/warnings test, adjust all offenders (wow, that was a lot)
[dbsrgits/DBIx-Class-Historic.git] / t / cdbi / 15-accessor.t
1 use strict;
2 use warnings;
3 use Test::More;
4
5 INIT {
6     #local $SIG{__WARN__} =
7         #sub { like $_[0], qr/clashes with built-in method/, $_[0] };
8     use lib 't/cdbi/testlib';
9     require Film;
10     require Actor;
11     require Director;
12
13     Actor->has_a(film => 'Film');
14     Film->has_a(director => 'Director');
15
16     sub Class::DBI::sheep { ok 0; }
17 }
18
19 # Install the deprecation warning intercept here for the rest of the 08 dev cycle
20 local $SIG{__WARN__} = sub {
21   warn @_ unless (DBIx::Class->VERSION < 0.09 and $_[0] =~ /Query returned more than one row/);
22 };
23
24 sub Film::mutator_name {
25     my ($class, $col) = @_;
26     return "set_sheep" if lc $col eq "numexplodingsheep";
27     return $col;
28 }
29
30 sub Film::accessor_name {
31     my ($class, $col) = @_;
32     return "sheep" if lc $col eq "numexplodingsheep";
33     return $col;
34 }
35
36 sub Actor::accessor_name_for {
37     my ($class, $col) = @_;
38     return "movie" if lc $col eq "film";
39     return $col;
40 }
41
42 # This is a class with accessor_name_for() but no corresponding mutator_name_for()
43 sub Director::accessor_name_for {
44     my($class, $col) = @_;
45     return "nutty_as_a_fruitcake" if lc $col eq "isinsane";
46     return $col;
47 }
48
49 my $data = {
50     Title    => 'Bad Taste',
51     Director => 'Peter Jackson',
52     Rating   => 'R',
53 };
54
55 eval {
56     my $data = { %$data };
57     $data->{NumExplodingSheep} = 1;
58     ok my $bt = Film->create($data), "Modified accessor - with column name";
59     isa_ok $bt, "Film";
60     is $bt->sheep, 1, 'sheep bursting violently';
61 };
62 is $@, '', "No errors";
63
64 eval {
65     my $data = { %$data };
66     $data->{sheep} = 2;
67     ok my $bt = Film->create($data), "Modified accessor - with accessor";
68     isa_ok $bt, "Film";
69     is $bt->sheep, 2, 'sheep bursting violently';
70 };
71 is $@, '', "No errors";
72
73 eval {
74     my $data = { %$data };
75     $data->{NumExplodingSheep} = 1;
76     ok my $bt = Film->find_or_create($data),
77     "find_or_create Modified accessor - find with column name";
78     isa_ok $bt, "Film";
79     is $bt->sheep, 1, 'sheep bursting violently';
80 };
81 is $@, '', "No errors";
82
83 eval {
84     my $data = { %$data };
85     $data->{sheep} = 1;
86     ok my $bt = Film->find_or_create($data),
87     "find_or_create Modified accessor - find with accessor";
88     isa_ok $bt, "Film";
89     is $bt->sheep, 1, 'sheep bursting violently';
90 };
91 is $@, '', "No errors";
92
93 eval {
94     my $data = { %$data };
95     $data->{NumExplodingSheep} = 3;
96     ok my $bt = Film->find_or_create($data),
97     "find_or_create Modified accessor - create with column name";
98     isa_ok $bt, "Film";
99
100     local $TODO = 'TODOifying failing tests, waiting for Schwern';
101     is $bt->sheep, 3, 'sheep bursting violently';
102 };
103 is $@, '', "No errors";
104
105 eval {
106     my $data = { %$data };
107     $data->{sheep} = 4;
108     ok my $bt = Film->find_or_create($data),
109     "find_or_create Modified accessor - create with accessor";
110     isa_ok $bt, "Film";
111
112     local $TODO = 'TODOifying failing tests, waiting for Schwern';
113     is $bt->sheep, 4, 'sheep bursting violently';
114 };
115 is $@, '', "No errors";
116
117 eval {
118     my @film = Film->search({ sheep => 1 });
119     is @film, 2, "Can search with modified accessor";
120 };
121 {
122   local $TODO = 'TODOifying failing tests, waiting for Schwern';
123   is $@, '', "No errors";
124 }
125
126 {
127
128     eval {
129         local $data->{set_sheep} = 1;
130         ok my $bt = Film->create($data), "Modified mutator - with mutator";
131         isa_ok $bt, "Film";
132     };
133     is $@, '', "No errors";
134
135     eval {
136         local $data->{NumExplodingSheep} = 1;
137         ok my $bt = Film->create($data), "Modified mutator - with column name";
138         isa_ok $bt, "Film";
139     };
140     is $@, '', "No errors";
141
142     eval {
143         local $data->{sheep} = 1;
144         ok my $bt = Film->create($data), "Modified mutator - with accessor";
145         isa_ok $bt, "Film";
146     };
147     is $@, '', "No errors";
148
149 }
150
151 {
152     my $p_data = {
153         name => 'Peter Jackson',
154         film => 'Bad Taste',
155     };
156     my $bt = Film->create($data);
157     my $ac = Actor->create($p_data);
158
159     ok !eval { my $f = $ac->film; 1 };
160     like $@, qr/film/, "no hasa film";
161
162     eval {
163         ok my $f = $ac->movie, "hasa movie";
164         isa_ok $f, "Film";
165         is $f->id, $bt->id, " - Bad Taste";
166     };
167     is $@, '', "No errors";
168
169     {
170         local $data->{Title} = "Another film";
171         my $film = Film->create($data);
172
173         eval { $ac->film($film) };
174         ok $@, $@;
175
176         eval { $ac->movie($film) };
177         ok $@, $@;
178
179         eval {
180             ok $ac->set_film($film), "Set movie through hasa";
181             $ac->update;
182             ok my $f = $ac->movie, "hasa movie";
183             isa_ok $f, "Film";
184             is $f->id, $film->id, " - Another Film";
185         };
186         is $@, '', "No problem";
187     }
188
189 }
190
191
192 # Make sure a class with an accessor_name() method has a similar mutator.
193 {
194     my $aki = Director->create({
195         name     => "Aki Kaurismaki",
196     });
197
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";
201     $aki->update;
202 }
203
204 {
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");
208
209     {
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";
221     }
222 }
223
224 {
225     is_deeply(
226         [Actor->columns('Essential')],
227         [Actor->columns('Primary')],
228         "Actor has no specific essential columns"
229     );
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";
235 }
236
237 {
238     Film->autoupdate(1);
239     my $naked = Film->create({ title => 'Naked' });
240     my $sandl = Film->create({ title => 'Secrets and Lies' });
241
242     my $rating = 1;
243     my $update_failure = sub {
244         my $obj = shift;
245         eval { $obj->rating($rating++) };
246         return $@ =~ /read only/;
247     };
248
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";
255
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";
263
264     $_->discard_changes for ($naked, $sandl);
265 }
266
267 done_testing;