t/cdbi-t/18-has_a.t

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