t/cdbi/18-has_a.t

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