1use strict;
2use Test::More;
3
4BEGIN {
5	eval "use DBD::SQLite";
6	plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 41);
7}
8
9use lib 't/testlib';
10use Film;
11use Director;
12@YA::Film::ISA = 'Film';
13
14Film->create_test_film;
15
16ok my $btaste = Film->retrieve('Bad Taste'), "We have Bad Taste";
17ok my $pj = $btaste->Director, "Bad taste has a director";
18ok !ref($pj), ' ... which is not an object';
19
20ok(Film->has_a('director' => 'Director'), "Link Director table");
21ok(
22	Director->insert(
23		{
24			Name     => 'Peter Jackson',
25			Birthday => -300000000,
26			IsInsane => 1
27		}
28	),
29	'insert Director'
30);
31
32{
33	ok $btaste = Film->retrieve('Bad Taste'), "Reretrieve Bad Taste";
34	ok $pj = $btaste->Director, "Bad taste now hasa() director";
35	isa_ok $pj => 'Director';
36	{
37		no warnings 'redefine';
38		no warnings 'once';
39		local *Ima::DBI::st::execute =
40			sub { ::fail("Shouldn't need to query db"); };
41		is $pj->id, 'Peter Jackson', 'ID already stored';
42	}
43	ok $pj->IsInsane, "But we know he's insane";
44}
45
46# Oh no!  Its Peter Jacksons even twin, Skippy!  Born one minute after him.
47my $sj = Director->insert(
48	{
49		Name     => 'Skippy Jackson',
50		Birthday => (-300000000 + 60),
51		IsInsane => 1,
52	}
53);
54
55{
56	eval { $btaste->Director($btaste) };
57	like $@, qr/is not a Director/, "Can't set film as director";
58	is $btaste->Director->id, $pj->id, "PJ still the director";
59
60	# drop from cache so that next retrieve() is from db
61	$btaste->remove_from_object_index;
62}
63
64{    # Still inflated after update
65	my $btaste = Film->retrieve('Bad Taste');
66	isa_ok $btaste->Director, "Director";
67	$btaste->numexplodingsheep(17);
68	$btaste->update;
69	isa_ok $btaste->Director, "Director";
70
71	$btaste->Director('Someone Else');
72	$btaste->update;
73	isa_ok $btaste->Director, "Director";
74	is $btaste->Director->id, "Someone Else", "Can change director";
75}
76
77is $sj->id, 'Skippy Jackson', 'Create new director - Skippy';
78Film->has_a('codirector' => 'Director');
79{
80	eval { $btaste->CoDirector("Skippy Jackson") };
81	is $@, "", "Auto inflates";
82	isa_ok $btaste->CoDirector, "Director";
83	is $btaste->CoDirector->id, $sj->id, "To skippy";
84}
85
86$btaste->CoDirector($sj);
87$btaste->update;
88is($btaste->CoDirector->Name, 'Skippy Jackson', 'He co-directed');
89is(
90	$btaste->Director->Name,
91	'Peter Jackson',
92	"Didnt interfere with each other"
93);
94
95{    # Inheriting hasa
96	my $btaste = YA::Film->retrieve('Bad Taste');
97	is(ref($btaste->Director),    'Director',       'inheriting hasa()');
98	is(ref($btaste->CoDirector),  'Director',       'inheriting hasa()');
99	is($btaste->CoDirector->Name, 'Skippy Jackson', ' ... correctly');
100}
101
102{
103	$sj = Director->retrieve('Skippy Jackson');
104	$pj = Director->retrieve('Peter Jackson');
105
106	my $fail;
107	eval {
108		$fail = YA::Film->insert(
109			{
110				Title             => 'Tastes Bad',
111				Director          => $sj,
112				codirector        => $btaste,
113				Rating            => 'R',
114				NumExplodingSheep => 23
115			}
116		);
117	};
118	ok $@,    "Can't have film as codirector: $@";
119	is $fail, undef, "We didn't get anything";
120
121	my $tastes_bad = YA::Film->insert(
122		{
123			Title             => 'Tastes Bad',
124			Director          => $sj,
125			codirector        => $pj,
126			Rating            => 'R',
127			NumExplodingSheep => 23
128		}
129	);
130	is($tastes_bad->Director->Name, 'Skippy Jackson', 'Director');
131	is(
132		$tastes_bad->_director_accessor->Name,
133		'Skippy Jackson',
134		'director_accessor'
135	);
136	is($tastes_bad->codirector->Name, 'Peter Jackson', 'codirector');
137	is(
138		$tastes_bad->_codirector_accessor->Name,
139		'Peter Jackson',
140		'codirector_accessor'
141	);
142}
143
144{
145	{
146
147		YA::Film->add_relationship_type(has_a => "YA::HasA");
148
149		package YA::HasA;
150		use base 'Class::DBI::Relationship::HasA';
151
152		sub _inflator {
153			my $self  = shift;
154			my $col   = $self->accessor;
155			my $super = $self->SUPER::_inflator($col);
156
157			return $super
158				unless $col eq $self->class->find_column('Director');
159
160			return sub {
161				my $self = shift;
162				$self->_attribute_store($col, 'Ghostly Peter')
163					if $self->_attribute_exists($col)
164					and not defined $self->_attrs($col);
165				return &$super($self);
166			};
167		}
168	}
169	{
170
171		package Rating;
172
173		sub new {
174			my ($class, $mpaa, @details) = @_;
175			bless {
176				MPAA => $mpaa,
177				WHY  => "@details"
178			}, $class;
179		}
180		sub mpaa { shift->{MPAA}; }
181		sub why  { shift->{WHY}; }
182	}
183	local *Director::mapme = sub {
184		my ($class, $val) = @_;
185		$val =~ s/Skippy/Peter/;
186		$val;
187	};
188	no warnings 'once';
189	local *Director::sanity_check = sub { $_[0]->IsInsane ? undef: $_[0] };
190	YA::Film->has_a(
191		director => 'Director',
192		inflate  => 'mapme',
193		deflate  => 'sanity_check'
194	);
195	YA::Film->has_a(
196		rating  => 'Rating',
197		inflate => sub {
198			my ($val, $parent) = @_;
199			my $sheep = $parent->find_column('NumexplodingSheep');
200			if ($parent->_attrs($sheep) || 0 > 20) {
201				return new Rating 'NC17', 'Graphic ovine violence';
202			} else {
203				return new Rating $val, 'Just because';
204			}
205		},
206		deflate => sub {
207			shift->mpaa;
208		}
209	);
210
211	my $tbad = YA::Film->retrieve('Tastes Bad');
212
213	isa_ok $tbad->Director, 'Director';
214	is $tbad->Director->Name, 'Peter Jackson', 'Director shuffle';
215	$tbad->Director('Skippy Jackson');
216	$tbad->update;
217	is $tbad->Director, 'Ghostly Peter', 'Sanity checked';
218
219	isa_ok $tbad->Rating, 'Rating';
220	is $tbad->Rating->mpaa, 'NC17', 'Rating bumped';
221	$tbad->Rating(new Rating 'NS17', 'Shaken sheep');
222	no warnings 'redefine';
223	local *Director::mapme = sub {
224		my ($class, $obj) = @_;
225		$obj->isa('Film') ? $obj->Director : $obj;
226	};
227
228	$pj->IsInsane(0);
229	$pj->update;    # Hush warnings
230
231	ok $tbad->Director($btaste), 'Cross-class mapping';
232	is $tbad->Director, 'Peter Jackson', 'Yields PJ';
233	$tbad->update;
234
235	$tbad = Film->retrieve('Tastes Bad');
236	ok !ref($tbad->Rating), 'Unmagical rating';
237	is $tbad->Rating, 'NS17', 'but prior change stuck';
238}
239
240{                 # Broken has_a declaration
241	eval { Film->has_a(driector => "Director") };
242	like $@, qr/driector/,
243		"Sensible error from has_a with incorrect column: $@";
244}
245