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