t/cdbi/06-hasa.t

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