t/cdbi/06-hasa.t

   1 use strict;
   2 use Test::More;
   3
   4 @YA::Film::ISA = 'Film';
   5
   6 #local $SIG{__WARN__} = sub { };
   7
   8 INIT {
   9   use lib 't/cdbi/testlib';
  10   use Film;
  11   use Director;
  12 }
  13
  14 Film->create_test_film;
  15 ok(my $btaste = Film->retrieve('Bad Taste'), "We have Bad Taste");
  16 ok(my $pj = $btaste->Director, "Bad taste has_a() director");
  17 ok(!ref($pj), ' ... which is not an object');
  18
  19 ok(Film->has_a('Director' => 'Director'), "Link Director table");
  20 ok(
  21   Director->create(
  22     {
  23       Name     => 'Peter Jackson',
  24       Birthday => -300000000,
  25       IsInsane => 1
  26     }
  27   ),
  28   'create Director'
  29 );
  30
  31 $btaste = Film->retrieve('Bad Taste');
  32
  33 ok($pj = $btaste->Director, "Bad taste now has_a() director");
  34 isa_ok($pj => 'Director');
  35 is($pj->id, 'Peter Jackson', ' ... and is the correct director');
  36
  37 # Oh no!  Its Peter Jacksons even twin, Skippy!  Born one minute after him.
  38 my $sj = Director->create(
  39   {
  40     Name     => 'Skippy Jackson',
  41     Birthday => (-300000000 + 60),
  42     IsInsane => 1,
  43   }
  44 );
  45
  46 is($sj->id, 'Skippy Jackson', 'We have a new director');
  47
  48 Film->has_a(CoDirector => 'Director');
  49
  50 $btaste->CoDirector($sj);
  51 $btaste->update;
  52 is($btaste->CoDirector->Name, 'Skippy Jackson', 'He co-directed');
  53 is(
  54   $btaste->Director->Name,
  55   'Peter Jackson',
  56   "Didnt interfere with each other"
  57 );
  58
  59 { # Ensure search can take an object
  60   my @films = Film->search(Director => $pj);
  61   is @films, 1, "1 Film directed by $pj";
  62   is $films[0]->id, "Bad Taste", "Bad Taste";
  63 }
  64
  65 inheriting_hasa();
  66
  67 {
  68
  69   # Skippy directs a film and Peter helps!
  70   $sj = Director->retrieve('Skippy Jackson');
  71   $pj = Director->retrieve('Peter Jackson');
  72
  73   fail_with_bad_object($sj, $btaste);
  74   taste_bad($sj,            $pj);
  75 }
  76
  77 sub inheriting_hasa {
  78   my $btaste = YA::Film->retrieve('Bad Taste');
  79   is(ref($btaste->Director),   'Director', 'inheriting has_a()');
  80   is(ref($btaste->CoDirector), 'Director', 'inheriting has_a()');
  81   is($btaste->CoDirector->Name, 'Skippy Jackson', ' ... correctly');
  82 }
  83
  84 sub taste_bad {
  85   my ($dir, $codir) = @_;
  86   my $tastes_bad = YA::Film->create(
  87     {
  88       Title             => 'Tastes Bad',
  89       Director          => $dir,
  90       CoDirector        => $codir,
  91       Rating            => 'R',
  92       NumExplodingSheep => 23
  93     }
  94   );
  95   is($tastes_bad->_Director_accessor, 'Skippy Jackson', 'Director_accessor');
  96   is($tastes_bad->Director->Name,   'Skippy Jackson', 'Director');
  97   is($tastes_bad->CoDirector->Name, 'Peter Jackson',  'CoDirector');
  98   is(
  99     $tastes_bad->_CoDirector_accessor,
 100     'Peter Jackson',
 101     'CoDirector_accessor'
 102   );
 103 }
 104
 105 sub fail_with_bad_object {
 106   my ($dir, $codir) = @_;
 107   eval {
 108     YA::Film->create(
 109       {
 110         Title             => 'Tastes Bad',
 111         Director          => $dir,
 112         CoDirector        => $codir,
 113         Rating            => 'R',
 114         NumExplodingSheep => 23
 115       }
 116     );
 117   };
 118   ok $@, $@;
 119 }
 120
 121 package Foo;
 122 use base 'CDBase';
 123 __PACKAGE__->table('foo');
 124 __PACKAGE__->columns('All' => qw/ id fav /);
 125 # fav is a film
 126 __PACKAGE__->db_Main->do( qq{
 127      CREATE TABLE foo (
 128        id        INTEGER,
 129        fav       VARCHAR(255)
 130      )
 131 });
 132
 133
 134 package Bar;
 135 use base 'CDBase';
 136 __PACKAGE__->table('bar');
 137 __PACKAGE__->columns('All' => qw/ id fav /);
 138 # fav is a foo
 139 __PACKAGE__->db_Main->do( qq{
 140      CREATE TABLE bar (
 141        id        INTEGER,
 142        fav       INTEGER
 143      )
 144 });
 145
 146 package main;
 147 Foo->has_a("fav" => "Film");
 148 Bar->has_a("fav" => "Foo");
 149 my $foo = Foo->create({ id => 6, fav => 'Bad Taste' });
 150 my $bar = Bar->create({ id => 2, fav => 6 });
 151 isa_ok($bar->fav, "Foo");
 152 isa_ok($foo->fav, "Film");
 153
 154 {
 155   my $foo;
 156   Foo->add_trigger(after_create => sub { $foo = shift->fav });
 157   my $gwh = Foo->create({ id => 93, fav => 'Good Will Hunting' });
 158   isa_ok $foo, "Film", "Object in after_create trigger";
 159 }
 160
 161 done_testing;