t/cdbi/09-has_many.t

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