1use strict; 2use Test::More; 3 4BEGIN { 5 eval "use DBD::SQLite"; 6 plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 55); 7} 8 9INIT { 10 local $SIG{__WARN__} = 11 sub { like $_[0], qr/clashes with built-in method/, $_[0] }; 12 use lib 't/testlib'; 13 require Film; 14 require Actor; 15 Actor->has_a(film => 'Film'); 16} 17sub Class::DBI::sheep { fail "sheep() Method called"; } 18 19sub Film::mutator_name_for { 20 my ($class, $col) = @_; 21 return "set_sheep" if lc $col eq "numexplodingsheep"; 22 return $col; 23} 24 25sub Film::accessor_name_for { 26 my ($class, $col) = @_; 27 return "sheep" if lc $col eq "numexplodingsheep"; 28 return $col; 29} 30 31sub Actor::accessor_name_for { 32 my ($class, $col) = @_; 33 return "movie" if lc $col eq "film"; 34 return $col; 35} 36 37my $data = { 38 Title => 'Bad Taste', 39 Director => 'Peter Jackson', 40 Rating => 'R', 41}; 42 43eval { 44 my $data = $data; 45 $data->{NumExplodingSheep} = 1; 46 ok my $bt = Film->insert($data), "Modified accessor - with column name"; 47 isa_ok $bt, "Film"; 48}; 49is $@, '', "No errors"; 50 51eval { 52 my $data = $data; 53 $data->{sheep} = 1; 54 ok my $bt = Film->insert($data), "Modified accessor - with accessor"; 55 isa_ok $bt, "Film"; 56}; 57is $@, '', "No errors"; 58 59eval { 60 my @film = Film->search({ sheep => 1 }); 61 is @film, 2, "Can search with modified accessor"; 62}; 63 64{ 65 66 eval { 67 local $data->{set_sheep} = 1; 68 ok my $bt = Film->insert($data), "Modified mutator - with mutator"; 69 isa_ok $bt, "Film"; 70 }; 71 is $@, '', "No errors"; 72 73 eval { 74 local $data->{NumExplodingSheep} = 1; 75 ok my $bt = Film->insert($data), "Modified mutator - with column name"; 76 isa_ok $bt, "Film"; 77 }; 78 is $@, '', "No errors"; 79 80 eval { 81 local $data->{sheep} = 1; 82 ok my $bt = Film->insert($data), "Modified mutator - with accessor"; 83 isa_ok $bt, "Film"; 84 }; 85 is $@, '', "No errors"; 86 87} 88 89{ 90 my $p_data = { 91 name => 'Peter Jackson', 92 film => 'Bad Taste', 93 }; 94 my $bt = Film->insert($data); 95 my $ac = Actor->insert($p_data); 96 97 eval { my $f = $ac->film }; 98 like $@, qr/Can't locate object method "film"/, "no hasa film"; 99 100 eval { 101 ok my $f = $ac->movie, "hasa movie"; 102 isa_ok $f, "Film"; 103 is $f->id, $bt->id, " - Bad Taste"; 104 }; 105 is $@, '', "No errors"; 106 107 { 108 local $data->{Title} = "Another film"; 109 my $film = Film->insert($data); 110 111 eval { $ac->film($film) }; 112 ok $@, $@; 113 114 eval { $ac->movie($film) }; 115 ok $@, $@; 116 117 eval { 118 ok $ac->set_film($film), "Set movie through hasa"; 119 $ac->update; 120 ok my $f = $ac->movie, "hasa movie"; 121 isa_ok $f, "Film"; 122 is $f->id, $film->id, " - Another Film"; 123 }; 124 is $@, '', "No problem"; 125 } 126 127} 128 129{ # have non persistent accessor? 130 Film->columns(TEMP => qw/nonpersistent/); 131 ok(Film->find_column('nonpersistent'), "nonpersistent is a column"); 132 ok(!Film->has_real_column('nonpersistent'), " - but it's not real"); 133 134 { 135 my $film = Film->insert({ Title => "Veronique", nonpersistent => 42 }); 136 is $film->title, "Veronique", "Title set OK"; 137 is $film->nonpersistent, 42, "As is non persistent value"; 138 $film->remove_from_object_index; 139 ok $film = Film->retrieve('Veronique'), "Re-retrieve film"; 140 is $film->title, "Veronique", "Title still OK"; 141 is $film->nonpersistent, undef, "Non persistent value gone"; 142 ok $film->nonpersistent(40), "Can set it"; 143 is $film->nonpersistent, 40, "And it's there again"; 144 ok $film->update, "Commit the film"; 145 is $film->nonpersistent, 40, "And it's still there"; 146 } 147} 148 149{ # was bug with TEMP and no Essential 150 is_deeply( 151 Actor->columns('Essential'), 152 Actor->columns('Primary'), 153 "Actor has no specific essential columns" 154 ); 155 ok(Actor->find_column('nonpersistent'), "nonpersistent is a column"); 156 ok(!Actor->has_real_column('nonpersistent'), " - but it's not real"); 157 my $pj = eval { Actor->search(name => "Peter Jackson")->first }; 158 is $@, '', "no problems retrieving actors"; 159 isa_ok $pj => "Actor"; 160} 161 162{ 163 Film->autoupdate(1); 164 my $naked = Film->insert({ title => 'Naked' }); 165 my $sandl = Film->insert({ title => 'Secrets and Lies' }); 166 167 my $rating = 1; 168 my $update_failure = sub { 169 my $obj = shift; 170 eval { $obj->rating($rating++) }; 171 return $@ =~ /read only/; 172 }; 173 174 ok !$update_failure->($naked), "Can update Naked"; 175 ok $naked->make_read_only, "Make Naked read only"; 176 ok $update_failure->($naked), "Can't update Naked any more"; 177 ok !$update_failure->($sandl), "But can still update Secrets and Lies"; 178 my $july4 = eval { Film->insert({ title => "4 Days in July" }) }; 179 isa_ok $july4 => "Film", "And can still insert new films"; 180 181 ok(Film->make_read_only, "Make all Films read only"); 182 ok $update_failure->($naked), "Still can't update Naked"; 183 ok $update_failure->($sandl), "And can't update S&L any more"; 184 eval { $july4->delete }; 185 like $@, qr/read only/, "And can't delete 4 Days in July"; 186 my $abigail = eval { Film->insert({ title => "Abigail's Party" }) }; 187 like $@, qr/read only/, "Or insert new films"; 188 $SIG{__WARN__} = sub { }; 189} 190 191