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