1$| = 1;
2use strict;
3
4use Test::More;
5
6eval { require Date::Simple };
7plan skip_all => "Need Date::Simple for this test" if $@;
8
9eval { require 't/testlib/MyFoo.pm' };
10plan skip_all => "Need MySQL for this test" if $@;
11
12plan tests => 68;
13
14package main;
15
16ok(
17	my $bar = MyFoo->insert({ name => "bar", val => 4, tdate => "2000-01-01" }),
18	"bar"
19);
20ok(
21	my $baz = MyFoo->insert({ name => "baz", val => 7, tdate => "2000-01-01" }),
22	"baz"
23);
24is($baz->id, $bar->id + 1, "Auto incremented primary key");
25is($bar->tdate, Date::Simple->new->format, " .. got today's date");
26ok(my $wibble = $bar->copy, "Copy with auto_increment");
27is($wibble->id, $baz->id + 1, " .. correct key");
28ok(my $wobble = $bar->copy(6), "Copy without auto_increment");
29is($wobble->id, 6, " .. correct key");
30ok($wobble->tdate('2001-01-01') && $wobble->update, "Set the date of wobble");
31isa_ok $wobble->tdate, "Date::Simple";
32is($wobble->tdate, Date::Simple->new->format, " but it's set to today");
33my $bobble = MyFoo->retrieve($wobble->id);
34is($bobble->tdate, Date::Simple->new->format, " set to today in DB too");
35isa_ok $bobble->tdate, "Date::Simple";
36
37is MyFoo->count_all, 4, "count_all()";
38is MyFoo->minimum_value_of("val"), 4, "min()";
39is MyFoo->maximum_value_of("val"), 7, "max()";
40
41require './t/testlib/MyStarLinkMCPK.pm';
42
43ok(my $f1 = MyFilm->insert({ title => "Veronique" }), "Create Veronique");
44ok(my $f2 = MyFilm->insert({ title => "Red" }),       "Create Red");
45
46ok(my $s1 = MyStar->insert({ name => "Irene Jacob" }),      "Irene Jacob");
47ok(my $s2 = MyStar->insert({ name => "Jerzy Gudejko" }),    "Create Jerzy");
48ok(my $s3 = MyStar->insert({ name => "Fr�d�rique Feder" }), "Create Fred");
49
50ok(my $l1 = MyStarLink->insert({ film => $f1, star => $s1 }), "Link 1");
51ok(my $l2 = MyStarLink->insert({ film => $f1, star => $s2 }), "Link 2");
52ok(my $l3 = MyStarLink->insert({ film => $f2, star => $s1 }), "Link 3");
53ok(my $l4 = MyStarLink->insert({ film => $f2, star => $s3 }), "Link 4");
54
55ok(my $lm1 = MyStarLinkMCPK->insert({ film => $f1, star => $s1 }),
56	"Link MCPK 1");
57ok(my $lm2 = MyStarLinkMCPK->insert({ film => $f1, star => $s2 }),
58	"Link MCPK 2");
59ok(my $lm3 = MyStarLinkMCPK->insert({ film => $f2, star => $s1 }),
60	"Link MCPK 3");
61ok(my $lm4 = MyStarLinkMCPK->insert({ film => $f2, star => $s3 }),
62	"Link MCPK 4");
63
64{    # Warnings for scalar context?
65	my $err = "";
66	local $SIG{__WARN__} = sub { $err = $_[0]; };
67	$err = "";
68	1 if MyStarLinkMCPK->_essential;
69	is $err, "", "_essential() tolerates scalar context with multi-column key";
70
71	1 if MyStarLinkMCPK->primary_column;
72	like $err, qr/fetching in scalar context/, "but primary_column() complains";
73}
74
75# try to create one with duplicate primary key
76my $lm5 = eval { MyStarLinkMCPK->insert({ film => $f2, star => $s3 }) };
77ok(!$lm5, "Can't insert duplicate");
78ok($@ =~ /^Can't insert .* duplicate/i, "Duplicate insert caused exception");
79
80# create one to delete
81ok(my $lm6 = MyStarLinkMCPK->insert({ film => $f2, star => $s2 }),
82	"Link MCPK 5");
83ok(my $lm7 = MyStarLinkMCPK->retrieve(film => $f2, star => $s2),
84	"Retrieve from table");
85ok($lm7 && $lm7->delete, "Delete from table");
86ok(!MyStarLinkMCPK->retrieve(film => $f2, star => $s2), "No longer in table");
87
88# test stringify
89is "$lm1", "1/1", "stringify";
90is "$lm4", "2/3", "stringify";
91
92my $to_ids = sub { join ":", sort map $_->id, @_ };
93
94{
95	my @ver_star = $f1->stars;
96	is @ver_star, 2, "Veronique has 2 stars ";
97	isa_ok $ver_star[0] => 'MyStar';
98	is $to_ids->(@ver_star), $to_ids->($s1, $s2), "Correct stars";
99}
100
101{
102	my @irene = $s1->films;
103	is @irene, 2, "Irene Jacob has 2 films";
104	isa_ok $irene[0] => 'MyFilm';
105	is $to_ids->(@irene), $to_ids->($f1, $f2), "Correct films";
106}
107
108{
109	my @jerzy = $s2->films;
110	is @jerzy, 1, "Jerzy has 1 film";
111	is $jerzy[0]->id, $f1->id, " Veronique";
112}
113
114{
115	ok MyStar->has_many(filmids => [ MyStarLink => 'film', 'id' ]),
116		"**** Multi-map";
117	my @filmid = $s1->filmids;
118	ok !ref $filmid[0], "Film-id is not a reference";
119
120	my $first = $s1->filmids->first;
121	ok !ref $first, "First is not a reference";
122	is $first, $filmid[0], "But it's the same as filmid[0]";
123}
124
125{    # cascades correctly
126	my $lenin  = MyFilm->insert({ title    => "Leningrad Cowboys Go America" });
127	my $pimme  = MyStar->insert({ name     => "Pimme Korhonen" });
128	my $cowboy = MyStarLink->insert({ film => $lenin, star => $pimme });
129	$lenin->delete;
130	is MyStar->search(name => 'Pimme Korhonen')->count, 1, "Pimme still exists";
131	is MyStarLink->search(star => $pimme->id)->count, 0, "But in no films";
132}
133
134{
135	ok MyStar->has_many(filmids_mcpk => [ MyStarLinkMCPK => 'film', 'id' ]),
136		"**** Multi-map via MCPK";
137	my @filmid = $s1->filmids_mcpk;
138	ok !ref $filmid[0], "Film-id is not a reference";
139
140	my $first = $s1->filmids_mcpk->first;
141	ok !ref $first, "First is not a reference";
142	is $first, $filmid[0], "But it's the same as filmid[0]";
143}
144
145{
146	ok my $f0 = MyFilm->insert({ filmid => 0, title => "Year 0" }),
147		"Create with explicit id = 0";
148	isa_ok $f0 => 'MyFilm';
149	is $f0->id, 0, "ID of 0";
150}
151
152{    # create doesn't mess with my hash.
153	my %info = (Name => "Catherine Wilkening");
154	my $cw = MyStar->find_or_create(\%info);
155	is scalar keys %info, 1, "Our hash still has only one key";
156	is $info{Name}, "Catherine Wilkening", "Still same name";
157}
158
159{
160	MyFilm->set_sql(
161		retrieve_all_sorted => "SELECT __ESSENTIAL__ FROM __TABLE__ ORDER BY %s");
162
163	sub MyFilm::retrieve_all_sorted_by {
164		my ($class, $order_by) = @_;
165		return $class->sth_to_objects($class->sql_retrieve_all_sorted($order_by));
166	}
167
168	my @all = MyFilm->retrieve_all_sorted_by("title");
169	is @all, 3, "3 films";
170	ok $all[2]->title gt $all[1]->title && $all[1]->title gt $all[0]->title,
171		"sorted by title";
172}
173
174{
175
176	package Class::DBI::Search::Test::Limited;
177	use base 'Class::DBI::Search::Basic';
178
179	sub fragment {
180		my $self = shift;
181		my $frag = $self->SUPER::fragment;
182		if (defined(my $limit = $self->opt('limit'))) {
183			$frag .= " LIMIT $limit";
184		}
185		return $frag;
186	}
187
188	package main;
189
190	MyFilm->add_searcher(search => "Class::DBI::Search::Test::Limited");
191
192	my @common = map MyFilm->insert({ title => "Common Title" }), 1 .. 3;
193	{
194		my @ltd = MyFilm->search(
195			title => "Common Title",
196			{
197				order_by => 'filmid',
198				limit    => 1
199			}
200		);
201		is @ltd, 1, "Limit to one film";
202		is $ltd[0]->id, $common[0]->id, "The correct one";
203	}
204
205	{
206		my @ltd = MyFilm->search(
207			title => "Common Title",
208			{
209				order_by => 'filmid',
210				limit    => "1,1"
211			}
212		);
213		is @ltd, 1, "Limit to middle film";
214		is $ltd[0]->id, $common[1]->id, " - correctly";
215	}
216
217}
218