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