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