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