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