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