t/cdbi/18-has_a.t

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