t/cdbi-t/06-hasa.t

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