t/cdbi/15-accessor.t

   1 BEGIN { do "./t/lib/ANFANG.pm" or die ( $@ || $! ) }
   2 use DBIx::Class::Optional::Dependencies -skip_all_without => 'cdbicompat';
   3
   4 use strict;
   5 use warnings;
   6
   7 use Test::More;
   8
   9 use lib 't/cdbi/testlib';
  10 INIT {
  11   require Film;
  12   require Actor;
  13   require Director;
  14
  15   Actor->has_a(film => 'Film');
  16   Film->has_a(director => 'Director');
  17
  18   sub Class::DBI::sheep { ok 0; }
  19 }
  20
  21 # Install the deprecation warning intercept here for the rest of the 08 dev cycle
  22 local $SIG{__WARN__} = sub {
  23   warn @_ unless (DBIx::Class->VERSION < 0.09 and $_[0] =~ /Query returned more than one row/);
  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     is $bt->sheep, 1, 'sheep bursting violently';
  63 };
  64 is $@, '', "No errors";
  65
  66 eval {
  67     my $data = { %$data };
  68     $data->{sheep} = 2;
  69     ok my $bt = Film->create($data), "Modified accessor - with accessor";
  70     isa_ok $bt, "Film";
  71     is $bt->sheep, 2, 'sheep bursting violently';
  72 };
  73 is $@, '', "No errors";
  74
  75 eval {
  76     my $data = { %$data };
  77     $data->{NumExplodingSheep} = 1;
  78     ok my $bt = Film->find_or_create($data),
  79     "find_or_create Modified accessor - find with column name";
  80     isa_ok $bt, "Film";
  81     is $bt->sheep, 1, 'sheep bursting violently';
  82 };
  83 is $@, '', "No errors";
  84
  85 eval {
  86     my $data = { %$data };
  87     $data->{sheep} = 1;
  88     ok my $bt = Film->find_or_create($data),
  89     "find_or_create Modified accessor - find with accessor";
  90     isa_ok $bt, "Film";
  91     is $bt->sheep, 1, 'sheep bursting violently';
  92 };
  93 is $@, '', "No errors";
  94
  95 eval {
  96     my $data = { %$data };
  97     $data->{NumExplodingSheep} = 3;
  98     ok my $bt = Film->find_or_create($data),
  99     "find_or_create Modified accessor - create with column name";
 100     isa_ok $bt, "Film";
 101
 102     local $TODO = 'TODOifying failing tests, waiting for Schwern';
 103     is $bt->sheep, 3, 'sheep bursting violently';
 104 };
 105 is $@, '', "No errors";
 106
 107 eval {
 108     my $data = { %$data };
 109     $data->{sheep} = 4;
 110     ok my $bt = Film->find_or_create($data),
 111     "find_or_create Modified accessor - create with accessor";
 112     isa_ok $bt, "Film";
 113
 114     local $TODO = 'TODOifying failing tests, waiting for Schwern';
 115     is $bt->sheep, 4, 'sheep bursting violently';
 116 };
 117 is $@, '', "No errors";
 118
 119 eval {
 120     my @film = Film->search({ sheep => 1 });
 121     is @film, 2, "Can search with modified accessor";
 122 };
 123 {
 124   local $TODO = 'TODOifying failing tests, waiting for Schwern';
 125   is $@, '', "No errors";
 126 }
 127
 128 {
 129
 130     eval {
 131         local $data->{set_sheep} = 1;
 132         ok my $bt = Film->create($data), "Modified mutator - with mutator";
 133         isa_ok $bt, "Film";
 134     };
 135     is $@, '', "No errors";
 136
 137     eval {
 138         local $data->{NumExplodingSheep} = 1;
 139         ok my $bt = Film->create($data), "Modified mutator - with column name";
 140         isa_ok $bt, "Film";
 141     };
 142     is $@, '', "No errors";
 143
 144     eval {
 145         local $data->{sheep} = 1;
 146         ok my $bt = Film->create($data), "Modified mutator - with accessor";
 147         isa_ok $bt, "Film";
 148     };
 149     is $@, '', "No errors";
 150
 151 }
 152
 153 {
 154     my $p_data = {
 155         name => 'Peter Jackson',
 156         film => 'Bad Taste',
 157     };
 158     my $bt = Film->create($data);
 159     my $ac = Actor->create($p_data);
 160
 161     ok !eval { my $f = $ac->film; 1 };
 162     like $@, qr/film/, "no hasa film";
 163
 164     eval {
 165         ok my $f = $ac->movie, "hasa movie";
 166         isa_ok $f, "Film";
 167         is $f->id, $bt->id, " - Bad Taste";
 168     };
 169     is $@, '', "No errors";
 170
 171     {
 172         local $data->{Title} = "Another film";
 173         my $film = Film->create($data);
 174
 175         eval { $ac->film($film) };
 176         ok $@, $@;
 177
 178         eval { $ac->movie($film) };
 179         ok $@, $@;
 180
 181         eval {
 182             ok $ac->set_film($film), "Set movie through hasa";
 183             $ac->update;
 184             ok my $f = $ac->movie, "hasa movie";
 185             isa_ok $f, "Film";
 186             is $f->id, $film->id, " - Another Film";
 187         };
 188         is $@, '', "No problem";
 189     }
 190
 191 }
 192
 193
 194 # Make sure a class with an accessor_name() method has a similar mutator.
 195 {
 196     my $aki = Director->create({
 197         name     => "Aki Kaurismaki",
 198     });
 199
 200     $aki->nutty_as_a_fruitcake(1);
 201     is $aki->nutty_as_a_fruitcake, 1,
 202         "a custom accessor without a custom mutator is setable";
 203     $aki->update;
 204 }
 205
 206 {
 207     Film->columns(TEMP => qw/nonpersistent/);
 208     ok(Film->find_column('nonpersistent'), "nonpersistent is a column");
 209     ok(!Film->has_real_column('nonpersistent'), " - but it's not real");
 210
 211     {
 212         my $film = Film->create({ Title => "Veronique", nonpersistent => 42 });
 213         is $film->title,         "Veronique", "Title set OK";
 214         is $film->nonpersistent, 42,          "As is non persistent value";
 215         $film->remove_from_object_index;
 216         ok $film = Film->retrieve('Veronique'), "Re-retrieve film";
 217         is $film->title, "Veronique", "Title still OK";
 218         is $film->nonpersistent, undef, "Non persistent value gone";
 219         ok $film->nonpersistent(40), "Can set it";
 220         is $film->nonpersistent, 40, "And it's there again";
 221         ok $film->update, "Commit the film";
 222         is $film->nonpersistent, 40, "And it's still there";
 223     }
 224 }
 225
 226 {
 227     is_deeply(
 228         [Actor->columns('Essential')],
 229         [Actor->columns('Primary')],
 230         "Actor has no specific essential columns"
 231     );
 232     ok(Actor->find_column('nonpersistent'), "nonpersistent is a column");
 233     ok(!Actor->has_real_column('nonpersistent'), " - but it's not real");
 234     my $pj = eval { Actor->search(name => "Peter Jackson")->first };
 235     is $@, '', "no problems retrieving actors";
 236     isa_ok $pj => "Actor";
 237 }
 238
 239 {
 240     Film->autoupdate(1);
 241     my $naked = Film->create({ title => 'Naked' });
 242     my $sandl = Film->create({ title => 'Secrets and Lies' });
 243
 244     my $rating = 1;
 245     my $update_failure = sub {
 246         my $obj = shift;
 247         eval { $obj->rating($rating++) };
 248         return $@ =~ /read only/;
 249     };
 250
 251     ok !$update_failure->($naked), "Can update Naked";
 252     ok $naked->make_read_only, "Make Naked read only";
 253     ok $update_failure->($naked), "Can't update Naked any more";
 254     ok !$update_failure->($sandl), "But can still update Secrets and Lies";
 255     my $july4 = eval { Film->create({ title => "4 Days in July" }) };
 256     isa_ok $july4 => "Film", "And can still create new films";
 257
 258     ok(Film->make_read_only, "Make all Films read only");
 259     ok $update_failure->($naked), "Still can't update Naked";
 260     ok $update_failure->($sandl), "And can't update S&L any more";
 261     eval { $july4->delete };
 262     like $@, qr/read only/, "And can't delete 4 Days in July";
 263     my $abigail = eval { Film->create({ title => "Abigail's Party" }) };
 264     like $@, qr/read only/, "Or create new films";
 265
 266     $_->discard_changes for ($naked, $sandl);
 267 }
 268
 269 done_testing;