t/delete/related.t

   1 use Test::More;
   2 use strict;
   3 use warnings;
   4 use lib qw(t/lib);
   5 use DBICTest;
   6
   7 plan tests => 6;
   8
   9 my $schema = DBICTest->init_schema();
  10
  11 my $ars = $schema->resultset('Artist');
  12 my $cdrs = $schema->resultset('CD');
  13
  14 # create some custom entries
  15 $ars->populate ([
  16   [qw/artistid  name/],
  17   [qw/71        a1/],
  18   [qw/72        a2/],
  19   [qw/73        a3/],
  20 ]);
  21 $cdrs->populate ([
  22   [qw/cdid artist title   year/],
  23   [qw/70   71     delete0 2005/],
  24   [qw/71   72     delete1 2005/],
  25   [qw/72   72     delete2 2005/],
  26   [qw/73   72     delete3 2006/],
  27   [qw/74   72     delete4 2007/],
  28   [qw/75   73     delete5 2008/],
  29 ]);
  30
  31 my $total_cds = $cdrs->count;
  32
  33 # test that delete_related w/o conditions deletes all related records only
  34 $ars->search ({name => 'a3' })->search_related ('cds')->delete;
  35 is ($cdrs->count, $total_cds -= 1, 'related delete ok');
  36
  37 my $a2_cds = $ars->search ({ name => 'a2' })->search_related ('cds');
  38
  39 # test that related deletion w/conditions deletes just the matched related records only
  40 $a2_cds->search ({ year => 2005 })->delete;
  41 is ($cdrs->count, $total_cds -= 2, 'related + condition delete ok');
  42
  43 # test that related deletion with limit condition works
  44 $a2_cds->search ({}, { rows => 1})->delete;
  45 is ($cdrs->count, $total_cds -= 1, 'related + limit delete ok');
  46
  47 my $tkfk = $schema->resultset('FourKeys_to_TwoKeys');
  48
  49 my ($fa, $fb) = $tkfk->related_resultset ('fourkeys')->populate ([
  50   [qw/foo bar hello goodbye sensors/],
  51   [qw/1   1   1     1       a      /],
  52   [qw/2   2   2     2       b      /],
  53 ]);
  54
  55 # This is already provided by DBICTest
  56 #my ($ta, $tb) = $tkfk->related_resultset ('twokeys')->populate ([
  57 #  [qw/artist  cd /],
  58 #  [qw/1       1  /],
  59 #  [qw/2       2  /],
  60 #]);
  61 my ($ta, $tb) = $schema->resultset ('TwoKeys')
  62                   ->search ( [ { artist => 1, cd => 1 }, { artist => 2, cd => 2 } ])
  63                     ->all;
  64
  65 my $tkfk_cnt = $tkfk->count;
  66
  67 my $non_void_ctx = $tkfk->populate ([
  68   { autopilot => 'a', fourkeys =>  $fa, twokeys => $ta },
  69   { autopilot => 'b', fourkeys =>  $fb, twokeys => $tb },
  70   { autopilot => 'x', fourkeys =>  $fa, twokeys => $tb },
  71   { autopilot => 'y', fourkeys =>  $fb, twokeys => $ta },
  72 ]);
  73 is ($tkfk->count, $tkfk_cnt += 4, 'FourKeys_to_TwoKeys populated succesfully');
  74
  75 my $sub_rs = $tkfk->search (
  76   [
  77     { map { $_ => 1 } qw/artist.artistid cd.cdid fourkeys.foo fourkeys.bar fourkeys.hello fourkeys.goodbye/ },
  78     { map { $_ => 2 } qw/artist.artistid cd.cdid fourkeys.foo fourkeys.bar fourkeys.hello fourkeys.goodbye/ },
  79   ],
  80   {
  81     join => [ 'fourkeys', { twokeys => [qw/artist cd/] } ],
  82   },
  83 );
  84
  85 is ($sub_rs->count, 2, 'Only two rows from fourkeys match');
  86 $sub_rs->delete;
  87
  88 is ($tkfk->count, $tkfk_cnt -= 2, 'Only two rows deleted');