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