made cdbi-t optional
[dbsrgits/DBIx-Class-Historic.git] / t / cdbi-t / 06-hasa.t
CommitLineData
ccee4390 1use strict;
2use Test::More;
3
4BEGIN {
289ba852 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);
ccee4390 12}
13
14@YA::Film::ISA = 'Film';
15
16#local $SIG{__WARN__} = sub { };
17
18INIT {
19 use lib 't/testlib';
20 use Film;
21 use Director;
22}
23
24Film->create_test_film;
25ok(my $btaste = Film->retrieve('Bad Taste'), "We have Bad Taste");
26ok(my $pj = $btaste->Director, "Bad taste has_a() director");
27ok(!ref($pj), ' ... which is not an object');
28
29ok(Film->has_a('Director' => 'Director'), "Link Director table");
30ok(
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
43ok($pj = $btaste->Director, "Bad taste now has_a() director");
44isa_ok($pj => 'Director');
45is($pj->id, 'Peter Jackson', ' ... and is the correct director');
46
47# Oh no! Its Peter Jacksons even twin, Skippy! Born one minute after him.
48my $sj = Director->create(
49 {
50 Name => 'Skippy Jackson',
51 Birthday => (-300000000 + 60),
52 IsInsane => 1,
53 }
54);
55
56is($sj->id, 'Skippy Jackson', 'We have a new director');
57
58Film->has_a(CoDirector => 'Director');
59
60$btaste->CoDirector($sj);
61$btaste->update;
62is($btaste->CoDirector->Name, 'Skippy Jackson', 'He co-directed');
63is(
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
75inheriting_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
87sub 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
94sub 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
115sub 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
131package Foo;
132use 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
144package Bar;
145use 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
156package main;
157Foo->has_a("fav" => "Film");
158Bar->has_a("fav" => "Foo");
159my $foo = Foo->create({ id => 6, fav => 'Bad Taste' });
160my $bar = Bar->create({ id => 2, fav => 6 });
161isa_ok($bar->fav, "Foo");
162isa_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