made cdbi-t optional
[dbsrgits/DBIx-Class-Historic.git] / t / cdbi-t / 15-accessor.t
CommitLineData
9bc6db13 1use strict;
2use Test::More;
3
4BEGIN {
289ba852 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 => 53);
9bc6db13 12}
13
14INIT {
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;
20 Actor->has_a(film => 'Film');
21 sub Class::DBI::sheep { ok 0; }
22}
23
24sub Film::mutator_name {
25 my ($class, $col) = @_;
26 return "set_sheep" if lc $col eq "numexplodingsheep";
27 return $col;
28}
29
30sub Film::accessor_name {
31 my ($class, $col) = @_;
32 return "sheep" if lc $col eq "numexplodingsheep";
33 return $col;
34}
35
36sub Actor::accessor_name {
37 my ($class, $col) = @_;
38 return "movie" if lc $col eq "film";
39 return $col;
40}
41
42my $data = {
43 Title => 'Bad Taste',
44 Director => 'Peter Jackson',
45 Rating => 'R',
46};
47
48eval {
49 my $data = $data;
50 $data->{NumExplodingSheep} = 1;
51 ok my $bt = Film->create($data), "Modified accessor - with column name";
52 isa_ok $bt, "Film";
53};
54is $@, '', "No errors";
55
56eval {
57 my $data = $data;
58 $data->{sheep} = 1;
59 ok my $bt = Film->create($data), "Modified accessor - with accessor";
60 isa_ok $bt, "Film";
61};
62is $@, '', "No errors";
63
64eval {
65 my @film = Film->search({ sheep => 1 });
66 is @film, 2, "Can search with modified accessor";
67};
68
69{
70
71 eval {
72 local $data->{set_sheep} = 1;
73 ok my $bt = Film->create($data), "Modified mutator - with mutator";
74 isa_ok $bt, "Film";
75 };
76 is $@, '', "No errors";
77
78 eval {
79 local $data->{NumExplodingSheep} = 1;
80 ok my $bt = Film->create($data), "Modified mutator - with column name";
81 isa_ok $bt, "Film";
82 };
83 is $@, '', "No errors";
84
85 eval {
86 local $data->{sheep} = 1;
87 ok my $bt = Film->create($data), "Modified mutator - with accessor";
88 isa_ok $bt, "Film";
89 };
90 is $@, '', "No errors";
91
92}
93
94{
95 my $p_data = {
96 name => 'Peter Jackson',
97 film => 'Bad Taste',
98 };
99 my $bt = Film->create($data);
100 my $ac = Actor->create($p_data);
101
102 eval { my $f = $ac->film };
103 like $@, qr/film/, "no hasa film";
104
105 eval {
106 ok my $f = $ac->movie, "hasa movie";
107 isa_ok $f, "Film";
108 is $f->id, $bt->id, " - Bad Taste";
109 };
110 is $@, '', "No errors";
111
112 {
113 local $data->{Title} = "Another film";
114 my $film = Film->create($data);
115
116 eval { $ac->film($film) };
117 ok $@, $@;
118
119 eval { $ac->movie($film) };
120 ok $@, $@;
121
122 eval {
123 ok $ac->set_film($film), "Set movie through hasa";
124 $ac->update;
125 ok my $f = $ac->movie, "hasa movie";
126 isa_ok $f, "Film";
127 is $f->id, $film->id, " - Another Film";
128 };
129 is $@, '', "No problem";
130 }
131
132}
133
134SKIP: { # have non persistent accessor?
a1373054 135 #skip "Compat layer doesn't handle TEMP columns yet", 11;
9bc6db13 136 Film->columns(TEMP => qw/nonpersistent/);
137 ok(Film->find_column('nonpersistent'), "nonpersistent is a column");
138 ok(!Film->has_real_column('nonpersistent'), " - but it's not real");
139
140 {
141 my $film = Film->create({ Title => "Veronique", nonpersistent => 42 });
142 is $film->title, "Veronique", "Title set OK";
143 is $film->nonpersistent, 42, "As is non persistent value";
144 $film->remove_from_object_index;
145 ok $film = Film->retrieve('Veronique'), "Re-retrieve film";
146 is $film->title, "Veronique", "Title still OK";
147 is $film->nonpersistent, undef, "Non persistent value gone";
148 ok $film->nonpersistent(40), "Can set it";
149 is $film->nonpersistent, 40, "And it's there again";
150 ok $film->update, "Commit the film";
151 is $film->nonpersistent, 40, "And it's still there";
152 }
153}
154
155SKIP: { # was bug with TEMP and no Essential
a1373054 156 #skip "Compat layer doesn't have TEMP columns yet", 5;
9bc6db13 157 is_deeply(
158 Actor->columns('Essential'),
159 Actor->columns('Primary'),
160 "Actor has no specific essential columns"
161 );
162 ok(Actor->find_column('nonpersistent'), "nonpersistent is a column");
163 ok(!Actor->has_real_column('nonpersistent'), " - but it's not real");
164 my $pj = eval { Actor->search(name => "Peter Jackson")->first };
165 is $@, '', "no problems retrieving actors";
166 isa_ok $pj => "Actor";
167}
168
169SKIP: {
a1373054 170 #skip "Compat layer doesn't handle read-only objects yet", 10;
9bc6db13 171 Film->autoupdate(1);
172 my $naked = Film->create({ title => 'Naked' });
173 my $sandl = Film->create({ title => 'Secrets and Lies' });
174
175 my $rating = 1;
176 my $update_failure = sub {
177 my $obj = shift;
178 eval { $obj->rating($rating++) };
179 return $@ =~ /read only/;
180 };
181
182 ok !$update_failure->($naked), "Can update Naked";
183 ok $naked->make_read_only, "Make Naked read only";
184 ok $update_failure->($naked), "Can't update Naked any more";
185 ok !$update_failure->($sandl), "But can still update Secrets and Lies";
186 my $july4 = eval { Film->create({ title => "4 Days in July" }) };
187 isa_ok $july4 => "Film", "And can still create new films";
188
189 ok(Film->make_read_only, "Make all Films read only");
190 ok $update_failure->($naked), "Still can't update Naked";
191 ok $update_failure->($sandl), "And can't update S&L any more";
192 eval { $july4->delete };
193 like $@, qr/read only/, "And can't delete 4 Days in July";
194 my $abigail = eval { Film->create({ title => "Abigail's Party" }) };
195 like $@, qr/read only/, "Or create new films";
196 $SIG{__WARN__} = sub { };
197}