t/cdbi/06-hasa.t

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