t/cdbi/18-has_a.t

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