Commit | Line | Data |
ccee4390 |
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 | |