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