t/cdbi/06-hasa.t

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