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