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