t/cdbi/06-hasa.t

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