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