Merge 'trunk' into 'sqla_1.50_compat'
[dbsrgits/DBIx-Class-Historic.git] / t / cdbi-t / 15-accessor.t
CommitLineData
9bc6db13 1use strict;
2use Test::More;
3
4BEGIN {
134ea846 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";
c73f755d 11 plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 75);
9bc6db13 12}
13
14INIT {
d4519f23 15 #local $SIG{__WARN__} =
16 #sub { like $_[0], qr/clashes with built-in method/, $_[0] };
17 use lib 't/testlib';
18 require Film;
19 require Actor;
48cb8be4 20 require Director;
21
d4519f23 22 Actor->has_a(film => 'Film');
48cb8be4 23 Film->has_a(director => 'Director');
24
d4519f23 25 sub Class::DBI::sheep { ok 0; }
9bc6db13 26}
27
28sub Film::mutator_name {
d4519f23 29 my ($class, $col) = @_;
30 return "set_sheep" if lc $col eq "numexplodingsheep";
31 return $col;
9bc6db13 32}
33
34sub Film::accessor_name {
d4519f23 35 my ($class, $col) = @_;
36 return "sheep" if lc $col eq "numexplodingsheep";
37 return $col;
9bc6db13 38}
39
e60dc79f 40sub Actor::accessor_name_for {
d4519f23 41 my ($class, $col) = @_;
42 return "movie" if lc $col eq "film";
43 return $col;
9bc6db13 44}
45
5e85c671 46# This is a class with accessor_name_for() but no corresponding mutator_name_for()
e60dc79f 47sub Director::accessor_name_for {
48 my($class, $col) = @_;
49 return "nutty_as_a_fruitcake" if lc $col eq "isinsane";
50 return $col;
51}
52
9bc6db13 53my $data = {
d4519f23 54 Title => 'Bad Taste',
55 Director => 'Peter Jackson',
56 Rating => 'R',
9bc6db13 57};
58
59eval {
c73f755d 60 my $data = { %$data };
d4519f23 61 $data->{NumExplodingSheep} = 1;
62 ok my $bt = Film->create($data), "Modified accessor - with column name";
63 isa_ok $bt, "Film";
c73f755d 64 is $bt->sheep, 1, 'sheep bursting violently';
9bc6db13 65};
66is $@, '', "No errors";
67
68eval {
c73f755d 69 my $data = { %$data };
70 $data->{sheep} = 2;
d4519f23 71 ok my $bt = Film->create($data), "Modified accessor - with accessor";
72 isa_ok $bt, "Film";
c73f755d 73 is $bt->sheep, 2, 'sheep bursting violently';
74};
75is $@, '', "No errors";
76
77eval {
78 my $data = { %$data };
79 $data->{NumExplodingSheep} = 1;
80 ok my $bt = Film->find_or_create($data),
81 "find_or_create Modified accessor - find with column name";
82 isa_ok $bt, "Film";
83 is $bt->sheep, 1, 'sheep bursting violently';
84};
85is $@, '', "No errors";
86
87eval {
88 my $data = { %$data };
89 $data->{sheep} = 1;
90 ok my $bt = Film->find_or_create($data),
91 "find_or_create Modified accessor - find with accessor";
92 isa_ok $bt, "Film";
93 is $bt->sheep, 1, 'sheep bursting violently';
94};
95is $@, '', "No errors";
96
1fecf835 97TODO: { local $TODO = 'TODOifying failing tests, waiting for Schwern'; ok (1, 'remove me');
c73f755d 98eval {
99 my $data = { %$data };
100 $data->{NumExplodingSheep} = 3;
101 ok my $bt = Film->find_or_create($data),
102 "find_or_create Modified accessor - create with column name";
103 isa_ok $bt, "Film";
104 is $bt->sheep, 3, 'sheep bursting violently';
105};
106is $@, '', "No errors";
107
108eval {
109 my $data = { %$data };
110 $data->{sheep} = 4;
111 ok my $bt = Film->find_or_create($data),
112 "find_or_create Modified accessor - create with accessor";
113 isa_ok $bt, "Film";
114 is $bt->sheep, 4, 'sheep bursting violently';
9bc6db13 115};
116is $@, '', "No errors";
117
118eval {
d4519f23 119 my @film = Film->search({ sheep => 1 });
120 is @film, 2, "Can search with modified accessor";
9bc6db13 121};
c73f755d 122is $@, '', "No errors";
9bc6db13 123
1fecf835 124}
125
9bc6db13 126{
127
d4519f23 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";
9bc6db13 148
149}
150
151{
d4519f23 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
48cb8be4 159 ok !eval { my $f = $ac->film; 1 };
d4519f23 160 like $@, qr/film/, "no hasa film";
161
162 eval {
dec1bfe0 163 local $SIG{__WARN__} = sub {
164 warn @_ unless $_[0] =~ /Query returned more than one row/;
165 };
d4519f23 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 }
9bc6db13 191
192}
193
e60dc79f 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{
d4519f23 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 }
9bc6db13 225}
226
e60dc79f 227{
d4519f23 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";
9bc6db13 238}
239
e60dc79f 240{
d4519f23 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";
48cb8be4 266
267 $sandl->discard_changes;
9bc6db13 268}