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