t/cdbi/23-cascade.t

   1 BEGIN { do "./t/lib/ANFANG.pm" or die ( $@ || $! ) }
   2 use DBIx::Class::Optional::Dependencies -skip_all_without => 'cdbicompat';
   3
   4 use strict;
   5 use warnings;
   6
   7 use Test::More;
   8 use Data::Dumper;
   9
  10 use lib 't/cdbi/testlib';
  11 use Film;
  12 use Director;
  13
  14 { # Cascade on delete
  15     Director->has_many(nasties => 'Film');
  16
  17     my $dir = Director->insert({
  18         name => "Lewis Teague",
  19     });
  20     my $kk = $dir->add_to_nasties({
  21         Title => 'Alligator'
  22     });
  23     is $kk->director, $dir, "Director set OK";
  24     is $dir->nasties, 1, "We have one nasty";
  25
  26     ok $dir->delete;
  27     ok !Film->retrieve("Alligator"), "has_many cascade deletes by default";
  28 }
  29
  30
  31 # Two ways of saying not to cascade
  32 for my $args ({ no_cascade_delete => 1 }, { cascade => "None" }) {
  33     Director->has_many(nasties => 'Film', $args);
  34
  35     my $dir = Director->insert({
  36         name => "Lewis Teague",
  37     });
  38     my $kk = $dir->add_to_nasties({
  39         Title => 'Alligator'
  40     });
  41     is $kk->director, $dir, "Director set OK";
  42     is $dir->nasties, 1, "We have one nasty";
  43
  44     ok $dir->delete;
  45     local $Data::Dumper::Terse = 1;
  46     ok +Film->retrieve("Alligator"), 'has_many with ' . Dumper ($args);;
  47     $kk->delete;
  48 }
  49
  50
  51 #{ # Fail on cascade
  52 #    local $TODO = 'cascade => "Fail" unimplemented';
  53 #
  54 #    Director->has_many(nasties => Film => { cascade => 'Fail' });
  55 #
  56 #    my $dir = Director->insert({ name => "Nasty Noddy" });
  57 #    my $kk = $dir->add_to_nasties({ Title => 'Killer Killers' });
  58 #    is $kk->director, $dir, "Director set OK";
  59 #    is $dir->nasties, 1, "We have one nasty";
  60 #
  61 #    ok !eval { $dir->delete };
  62 #    like $@, qr/1/, "Can't delete while films exist";
  63 #
  64 #    my $rr = $dir->add_to_nasties({ Title => 'Revenge of the Revengers' });
  65 #    ok !eval { $dir->delete };
  66 #    like $@, qr/2/, "Still can't delete";
  67 #
  68 #    $dir->nasties->delete_all;
  69 #    ok eval { $dir->delete };
  70 #    is $@, '', "Can delete once films are gone";
  71 #}
  72
  73 done_testing;