t/cdbi/18-has_a.t

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