t/cdbi/18-has_a.t

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