t/cdbi/18-has_a.t

   1 use DBIx::Class::Optional::Dependencies -skip_all_without => 'cdbicompat';
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More;
   7 use Test::Exception;
   8 use DBIx::Class::_Util 'sigwarn_silencer';
   9
  10 use lib 't/cdbi/testlib';
  11 use Film;
  12 use Director;
  13 @YA::Film::ISA = 'Film';
  14
  15 Film->create_test_film;
  16
  17 ok my $btaste = Film->retrieve('Bad Taste'), "We have Bad Taste";
  18 ok my $pj = $btaste->Director, "Bad taste has a director";
  19 ok !ref($pj), ' ... which is not an object';
  20
  21 ok(Film->has_a('Director' => 'Director'), "Link Director table");
  22 ok(
  23   Director->create({
  24       Name     => 'Peter Jackson',
  25       Birthday => -300000000,
  26       IsInsane => 1
  27     }
  28   ),
  29   'create Director'
  30 );
  31
  32 {
  33   ok $btaste = Film->retrieve('Bad Taste'), "Reretrieve Bad Taste";
  34   ok $pj = $btaste->Director, "Bad taste now hasa() director";
  35   isa_ok $pj => 'Director';
  36   {
  37     no warnings qw(redefine once);
  38     local *Ima::DBI::st::execute =
  39       sub { ::fail("Shouldn't need to query db"); };
  40     is $pj->id, 'Peter Jackson', 'ID already stored';
  41   }
  42   ok $pj->IsInsane, "But we know he's insane";
  43 }
  44
  45 # Oh no!  Its Peter Jacksons even twin, Skippy!  Born one minute after him.
  46 my $sj = Director->create({
  47     Name     => 'Skippy Jackson',
  48     Birthday => (-300000000 + 60),
  49     IsInsane => 1,
  50   });
  51
  52 {
  53   throws_ok { $btaste->Director($btaste) }
  54     qr/isn't a Director/, "Can't set film as director";
  55   is $btaste->Director->id, $pj->id, "PJ still the director";
  56
  57   # drop from cache so that next retrieve() is from db
  58   $btaste->remove_from_object_index;
  59 }
  60
  61 {    # Still inflated after update
  62   my $btaste = Film->retrieve('Bad Taste');
  63   isa_ok $btaste->Director, "Director";
  64   $btaste->numexplodingsheep(17);
  65   $btaste->update;
  66   isa_ok $btaste->Director, "Director";
  67
  68   $btaste->Director('Someone Else');
  69   $btaste->update;
  70   isa_ok $btaste->Director, "Director";
  71   is $btaste->Director->id, "Someone Else", "Can change director";
  72 }
  73
  74 is $sj->id, 'Skippy Jackson', 'Create new director - Skippy';
  75 Film->has_a('CoDirector' => 'Director');
  76 {
  77   lives_ok { $btaste->CoDirector("Skippy Jackson") };
  78   isa_ok $btaste->CoDirector, "Director";
  79   is $btaste->CoDirector->id, $sj->id, "To skippy";
  80 }
  81
  82 $btaste->CoDirector($sj);
  83 $btaste->update;
  84 is($btaste->CoDirector->Name, 'Skippy Jackson', 'He co-directed');
  85 is(
  86   $btaste->Director->Name,
  87   'Peter Jackson',
  88   "Didnt interfere with each other"
  89 );
  90
  91 {    # Inheriting hasa
  92   my $btaste = YA::Film->retrieve('Bad Taste');
  93   is(ref($btaste->Director),    'Director',       'inheriting hasa()');
  94   is(ref($btaste->CoDirector),  'Director',       'inheriting hasa()');
  95   is($btaste->CoDirector->Name, 'Skippy Jackson', ' ... correctly');
  96 }
  97
  98 {
  99   $sj = Director->retrieve('Skippy Jackson');
 100   $pj = Director->retrieve('Peter Jackson');
 101
 102   my $fail;
 103   throws_ok {
 104     local $SIG{__WARN__} = sigwarn_silencer( qr/\Qusually should inherit from the related ResultClass ('Director')/ );
 105     $fail = YA::Film->create({
 106         Title             => 'Tastes Bad',
 107         Director          => $sj,
 108         codirector        => $btaste,
 109         Rating            => 'R',
 110         NumExplodingSheep => 23
 111       });
 112   } qr/isn't a Director/, "Can't have film as codirector";
 113   is $fail, undef, "We didn't get anything";
 114
 115   my $tastes_bad = YA::Film->create({
 116       Title             => 'Tastes Bad',
 117       Director          => $sj,
 118       codirector        => $pj,
 119       Rating            => 'R',
 120       NumExplodingSheep => 23
 121     });
 122   is($tastes_bad->Director->Name, 'Skippy Jackson', 'Director');
 123   is(
 124     $tastes_bad->_director_accessor->Name,
 125     'Skippy Jackson',
 126     'director_accessor'
 127   );
 128   is($tastes_bad->codirector->Name, 'Peter Jackson', 'codirector');
 129   is(
 130     $tastes_bad->_codirector_accessor->Name,
 131     'Peter Jackson',
 132     'codirector_accessor'
 133   );
 134 }
 135
 136 SKIP: {
 137         skip "Non-standard CDBI relationships not supported by compat", 9;
 138   {
 139
 140     YA::Film->add_relationship_type(has_a => "YA::HasA");
 141
 142     package YA::HasA;
 143     #use base 'Class::DBI::Relationship::HasA';
 144
 145     sub _inflator {
 146       my $self  = shift;
 147       my $col   = $self->accessor;
 148       my $super = $self->SUPER::_inflator($col);
 149
 150       return $super
 151         unless $col eq $self->class->find_column('Director');
 152
 153       return sub {
 154         my $self = shift;
 155         $self->_attribute_store($col, 'Ghostly Peter')
 156           if $self->_attribute_exists($col)
 157           and not defined $self->_attrs($col);
 158         return &$super($self);
 159       };
 160     }
 161   }
 162   {
 163
 164     package Rating;
 165
 166     sub new {
 167       my ($class, $mpaa, @details) = @_;
 168       bless {
 169         MPAA => $mpaa,
 170         WHY  => "@details"
 171       }, $class;
 172     }
 173     sub mpaa { shift->{MPAA}; }
 174     sub why  { shift->{WHY}; }
 175   }
 176   local *Director::mapme = sub {
 177     my ($class, $val) = @_;
 178     $val =~ s/Skippy/Peter/;
 179     $val;
 180   };
 181   no warnings 'once';
 182   local *Director::sanity_check = sub { $_[0]->IsInsane ? undef: $_[0] };
 183   YA::Film->has_a(
 184     director => 'Director',
 185     inflate  => 'mapme',
 186     deflate  => 'sanity_check'
 187   );
 188   YA::Film->has_a(
 189     rating  => 'Rating',
 190     inflate => sub {
 191       my ($val, $parent) = @_;
 192       my $sheep = $parent->find_column('NumexplodingSheep');
 193       if ($parent->_attrs($sheep) || 0 > 20) {
 194         return new Rating 'NC17', 'Graphic ovine violence';
 195       } else {
 196         return new Rating $val, 'Just because';
 197       }
 198     },
 199     deflate => sub {
 200       shift->mpaa;
 201     });
 202
 203   my $tbad = YA::Film->retrieve('Tastes Bad');
 204
 205   isa_ok $tbad->Director, 'Director';
 206   is $tbad->Director->Name, 'Peter Jackson', 'Director shuffle';
 207   $tbad->Director('Skippy Jackson');
 208   $tbad->update;
 209   is $tbad->Director, 'Ghostly Peter', 'Sanity checked';
 210
 211   isa_ok $tbad->Rating, 'Rating';
 212   is $tbad->Rating->mpaa, 'NC17', 'Rating bumped';
 213   $tbad->Rating(new Rating 'NS17', 'Shaken sheep');
 214   no warnings 'redefine';
 215   local *Director::mapme = sub {
 216     my ($class, $obj) = @_;
 217     $obj->isa('Film') ? $obj->Director : $obj;
 218   };
 219
 220   $pj->IsInsane(0);
 221   $pj->update;    # Hush warnings
 222
 223   ok $tbad->Director($btaste), 'Cross-class mapping';
 224   is $tbad->Director, 'Peter Jackson', 'Yields PJ';
 225   $tbad->update;
 226
 227   $tbad = Film->retrieve('Tastes Bad');
 228   ok !ref($tbad->Rating), 'Unmagical rating';
 229   is $tbad->Rating, 'NS17', 'but prior change stuck';
 230 }
 231
 232 { # Broken has_a declaration
 233   throws_ok{ Film->has_a(driector => "Director") }
 234     qr/No such column driector/,
 235     "Sensible error from has_a with incorrect column"
 236   ;
 237 }
 238
 239 done_testing;