t/cdbi/15-accessor.t

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