c2939efce16b9184b217c00c7de2c2fbaa36c6d5
[dbsrgits/DBIx-Class.git] / t / cdbi / 09-has_many.t
1 use strict;
2 use Test::More;
3
4 use lib 't/cdbi/testlib';
5 use Film;
6 use Actor;
7 Actor->has_a(Film => 'Film');
8 Film->has_many(actors => 'Actor', { order_by => 'name' });
9 is(Actor->primary_column, 'id', "Actor primary OK");
10
11 ok(Actor->can('Salary'), "Actor table set-up OK");
12 ok(Film->can('actors'),  " and have a suitable method in Film");
13
14 Film->create_test_film;
15
16 ok(my $btaste = Film->retrieve('Bad Taste'), "We have Bad Taste");
17
18 ok(
19   my $pvj = Actor->create(
20     {
21       Name   => 'Peter Vere-Jones',
22       Film   => undef,
23       Salary => '30_000',             # For a voice!
24     }
25   ),
26   'create Actor'
27 );
28 is $pvj->Name, "Peter Vere-Jones", "PVJ name ok";
29 is $pvj->Film, undef, "No film";
30 ok $pvj->set_Film($btaste), "Set film";
31 $pvj->update;
32 is $pvj->Film->id, $btaste->id, "Now film";
33 {
34   my @actors = $btaste->actors;
35   is(@actors, 1, "Bad taste has one actor");
36   is($actors[0]->Name, $pvj->Name, " - the correct one");
37 }
38
39 my %pj_data = (
40   Name   => 'Peter Jackson',
41   Salary => '0',               # it's a labour of love
42 );
43
44 eval { my $pj = Film->add_to_actors(\%pj_data) };
45 like $@, qr/class/, "add_to_actors must be object method";
46
47 eval { my $pj = $btaste->add_to_actors(%pj_data) };
48 like $@, qr/expects a hashref/, "add_to_actors takes hash";
49
50 ok(
51   my $pj = $btaste->add_to_actors(
52     {
53       Name   => 'Peter Jackson',
54       Salary => '0',               # it's a labour of love
55     }
56   ),
57   'add_to_actors'
58 );
59 is $pj->Name,  "Peter Jackson",    "PJ ok";
60 is $pvj->Name, "Peter Vere-Jones", "PVJ still ok";
61
62 {
63   my @actors = $btaste->actors;
64   is @actors, 2, " - so now we have 2";
65   is $actors[0]->Name, $pj->Name,  "PJ first";
66   is $actors[1]->Name, $pvj->Name, "PVJ first";
67 }
68
69 eval {
70   my @actors = $btaste->actors(Name => $pj->Name);
71   is @actors, 1, "One actor from restricted (sorted) has_many";
72   is $actors[0]->Name, $pj->Name, "It's PJ";
73 };
74 is $@, '', "No errors";
75
76 my $as = Actor->create(
77   {
78     Name   => 'Arnold Schwarzenegger',
79     Film   => 'Terminator 2',
80     Salary => '15_000_000'
81   }
82 );
83
84 eval { $btaste->actors($pj, $pvj, $as) };
85 ok $@, $@;
86 is($btaste->actors, 2, " - so we still only have 2 actors");
87
88 my @bta_before = Actor->search(Film => 'Bad Taste');
89 is(@bta_before, 2, "We have 2 actors in bad taste");
90 ok($btaste->delete, "Delete bad taste");
91 my @bta_after = Actor->search(Film => 'Bad Taste');
92 is(@bta_after, 0, " - after deleting there are no actors");
93
94 # While we're here, make sure Actors have unreadable mutators and
95 # unwritable accessors
96
97 eval { $as->Name("Paul Reubens") };
98 ok $@, $@;
99 eval { my $name = $as->set_Name };
100 ok $@, $@;
101
102 is($as->Name, 'Arnold Schwarzenegger', "Arnie's still Arnie");
103
104
105 # Test infering of the foreign key of a has_many from an existing has_a
106 {
107     use Thing;
108     use OtherThing;
109
110     Thing->has_a(that_thing => "OtherThing");
111     OtherThing->has_many(things => "Thing");
112
113     my $other_thing = OtherThing->create({ id => 1 });
114     Thing->create({ id => 1, that_thing => $other_thing });
115     Thing->create({ id => 2, that_thing => $other_thing });
116
117     is_deeply [sort map { $_->id } $other_thing->things], [1,2];
118 }
119
120 done_testing;