t/cdbi-t/15-accessor.t

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