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 }