1use strict;
2use Test::More;
3
4BEGIN {
5	eval "use DBD::SQLite";
6	plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 24);
7}
8
9@YA::Film::ISA = 'Film';
10
11local $SIG{__WARN__} = sub { };
12
13INIT {
14	use lib 't/testlib';
15	use Film;
16	use Director;
17}
18
19Film->create_test_film;
20ok(my $btaste = Film->retrieve('Bad Taste'), "We have Bad Taste");
21ok(my $pj = $btaste->Director, "Bad taste hasa() director");
22ok(!ref($pj), ' ... which is not an object');
23
24ok(Film->has_a('Director' => 'Director'), "Link Director table");
25ok(
26	Director->insert(
27		{
28			Name     => 'Peter Jackson',
29			Birthday => -300000000,
30			IsInsane => 1
31		}
32	),
33	'insert Director'
34);
35
36$btaste = Film->retrieve('Bad Taste');
37
38ok($pj = $btaste->Director, "Bad taste now hasa() director");
39isa_ok($pj => 'Director');
40is($pj->id, 'Peter Jackson', ' ... and is the correct director');
41
42# Oh no!  Its Peter Jacksons even twin, Skippy!  Born one minute after him.
43my $sj = Director->insert(
44	{
45		Name     => 'Skippy Jackson',
46		Birthday => (-300000000 + 60),
47		IsInsane => 1,
48	}
49);
50
51is($sj->id, 'Skippy Jackson', 'We have a new director');
52
53Film->has_a(CoDirector => 'Director');
54
55$btaste->CoDirector($sj);
56$btaste->update;
57is($btaste->CoDirector->Name, 'Skippy Jackson', 'He co-directed');
58is(
59	$btaste->Director->Name,
60	'Peter Jackson',
61	"Didnt interfere with each other"
62);
63
64{    # Ensure search can take an object
65	my @films = Film->search(Director => $pj);
66	is @films, 1, "1 Film directed by $pj";
67	is $films[0]->id, "Bad Taste", "Bad Taste";
68}
69
70inheriting_hasa();
71
72{
73
74	# Skippy directs a film and Peter helps!
75	$sj = Director->retrieve('Skippy Jackson');
76	$pj = Director->retrieve('Peter Jackson');
77
78	fail_with_bad_object($sj, $btaste);
79	taste_bad($sj, $pj);
80}
81
82sub inheriting_hasa {
83	my $btaste = YA::Film->retrieve('Bad Taste');
84	is(ref($btaste->Director),    'Director',       'inheriting hasa()');
85	is(ref($btaste->CoDirector),  'Director',       'inheriting hasa()');
86	is($btaste->CoDirector->Name, 'Skippy Jackson', ' ... correctly');
87}
88
89sub taste_bad {
90	my ($dir, $codir) = @_;
91	my $tastes_bad = YA::Film->insert(
92		{
93			Title             => 'Tastes Bad',
94			Director          => $dir,
95			CoDirector        => $codir,
96			Rating            => 'R',
97			NumExplodingSheep => 23
98		}
99	);
100	is($tastes_bad->_Director_accessor, 'Skippy Jackson', 'Director_accessor');
101	is($tastes_bad->Director->Name,     'Skippy Jackson', 'Director');
102	is($tastes_bad->CoDirector->Name,   'Peter Jackson',  'CoDirector');
103	is(
104		$tastes_bad->_CoDirector_accessor,
105		'Peter Jackson',
106		'CoDirector_accessor'
107	);
108}
109
110sub fail_with_bad_object {
111	my ($dir, $codir) = @_;
112	eval {
113		YA::Film->insert(
114			{
115				Title             => 'Tastes Bad',
116				Director          => $dir,
117				CoDirector        => $codir,
118				Rating            => 'R',
119				NumExplodingSheep => 23
120			}
121		);
122	};
123	ok $@, $@;
124}
125
126package Foo;
127use base 'CDBase';
128__PACKAGE__->table('foo');
129__PACKAGE__->columns('All' => qw/ id fav /);
130
131# fav is a film
132__PACKAGE__->db_Main->do(
133	qq{
134     CREATE TABLE foo (
135	     id        INTEGER,
136	     fav       VARCHAR(255)
137     )
138}
139);
140
141package Bar;
142use base 'CDBase';
143__PACKAGE__->table('bar');
144__PACKAGE__->columns('All' => qw/ id fav /);
145
146# fav is a foo
147__PACKAGE__->db_Main->do(
148	qq{
149     CREATE TABLE bar (
150	     id        INTEGER,
151	     fav       INTEGER
152     )
153}
154);
155
156package main;
157Foo->has_a("fav" => "Film");
158Bar->has_a("fav" => "Foo");
159my $foo = Foo->insert({ id => 6, fav => 'Bad Taste' });
160my $bar = Bar->insert({ id => 2, fav => 6 });
161isa_ok($bar->fav, "Foo");
162isa_ok($foo->fav, "Film");
163
164{
165	my $foo;
166	Foo->add_trigger(after_create => sub { $foo = shift->fav });
167	my $gwh = Foo->insert({ id => 93, fav => 'Good Will Hunting' });
168	isa_ok $foo, "Film", "Object in after_create trigger";
169}
170
171__END__
172# TODO: breaks t/10
173# http://lists.digitalcraftsmen.net/pipermail/classdbi/2005-November/000610.html 
174# test has_a() on primary keys
175package MultiKey;
176use base 'CDBase';
177__PACKAGE__->table('multikey');
178__PACKAGE__->columns('Primary' => qw/ id film /);
179__PACKAGE__->has_a(film => "Film");
180__PACKAGE__->db_Main->do(
181	qq{
182     CREATE TABLE multikey (
183	     id        INTEGER,
184     film      VARCHAR(255)
185     )
186}
187);
188
189package main;
190my $from_scalar = MultiKey->create({ id => 7, film => 'Bad Taste' });
191isa_ok($from_scalar->film(), "Film");
192
193