Tests and test schema adjustments for resultset update/delete
Peter Rabbitson [Sat, 23 May 2009 19:33:28 +0000 (19:33 +0000)]
t/delete/related.t
t/lib/DBICTest/Schema/FourKeys.pm
t/lib/DBICTest/Schema/FourKeys_to_TwoKeys.pm
t/lib/sqlite.sql
t/resultset/update_delete.t [new file with mode: 0644]

index 39aa429..f3fb78b 100644 (file)
@@ -4,7 +4,7 @@ use warnings;
 use lib qw(t/lib);
 use DBICTest;
 
-plan tests => 6;
+plan tests => 3;
 
 my $schema = DBICTest->init_schema();
 
@@ -43,46 +43,3 @@ is ($cdrs->count, $total_cds -= 2, 'related + condition delete ok');
 # test that related deletion with limit condition works
 $a2_cds->search ({}, { rows => 1})->delete;
 is ($cdrs->count, $total_cds -= 1, 'related + limit delete ok');
-
-my $tkfk = $schema->resultset('FourKeys_to_TwoKeys');
-
-my ($fa, $fb) = $tkfk->related_resultset ('fourkeys')->populate ([
-  [qw/foo bar hello goodbye sensors/],
-  [qw/1   1   1     1       a      /],
-  [qw/2   2   2     2       b      /],
-]);
-
-# This is already provided by DBICTest
-#my ($ta, $tb) = $tkfk->related_resultset ('twokeys')->populate ([
-#  [qw/artist  cd /],
-#  [qw/1       1  /],
-#  [qw/2       2  /],
-#]);
-my ($ta, $tb) = $schema->resultset ('TwoKeys')
-                  ->search ( [ { artist => 1, cd => 1 }, { artist => 2, cd => 2 } ])
-                    ->all;
-
-my $tkfk_cnt = $tkfk->count;
-
-my $non_void_ctx = $tkfk->populate ([
-  { autopilot => 'a', fourkeys =>  $fa, twokeys => $ta },
-  { autopilot => 'b', fourkeys =>  $fb, twokeys => $tb },
-  { autopilot => 'x', fourkeys =>  $fa, twokeys => $tb },
-  { autopilot => 'y', fourkeys =>  $fb, twokeys => $ta },
-]);
-is ($tkfk->count, $tkfk_cnt += 4, 'FourKeys_to_TwoKeys populated succesfully');
-
-my $sub_rs = $tkfk->search (
-  [ 
-    { map { $_ => 1 } qw/artist.artistid cd.cdid fourkeys.foo fourkeys.bar fourkeys.hello fourkeys.goodbye/ },
-    { map { $_ => 2 } qw/artist.artistid cd.cdid fourkeys.foo fourkeys.bar fourkeys.hello fourkeys.goodbye/ },
-  ],
-  {
-    join => [ 'fourkeys', { twokeys => [qw/artist cd/] } ],
-  },
-);
-
-is ($sub_rs->count, 2, 'Only two rows from fourkeys match');
-$sub_rs->delete;
-
-is ($tkfk->count, $tkfk_cnt -= 2, 'Only two rows deleted');
index 3fedb52..9966cfb 100644 (file)
@@ -9,7 +9,8 @@ __PACKAGE__->add_columns(
   'bar' => { data_type => 'integer' },
   'hello' => { data_type => 'integer' },
   'goodbye' => { data_type => 'integer' },
-  'sensors' => { data_type => 'character' },
+  'sensors' => { data_type => 'character', size => 10 },
+  'read_count' => { data_type => 'integer', is_nullable => 1 },
 );
 __PACKAGE__->set_primary_key(qw/foo bar hello goodbye/);
 
index 5387136..d95ed6c 100644 (file)
@@ -12,6 +12,7 @@ __PACKAGE__->add_columns(
   't_artist' => { data_type => 'integer' },
   't_cd' => { data_type => 'integer' },
   'autopilot' => { data_type => 'character' },
+  'pilot_sequence' => { data_type => 'integer', is_nullable => 1 },
 );
 __PACKAGE__->set_primary_key(
   qw/f_foo f_bar f_hello f_goodbye t_artist t_cd/
index 3da5786..ec68a99 100644 (file)
@@ -1,6 +1,6 @@
 -- 
 -- Created by SQL::Translator::Producer::SQLite
--- Created on Thu Apr 30 10:04:57 2009
+-- Created on Sat May 23 21:30:53 2009
 -- 
 
 
@@ -195,7 +195,8 @@ CREATE TABLE fourkeys (
   bar integer NOT NULL,
   hello integer NOT NULL,
   goodbye integer NOT NULL,
-  sensors character NOT NULL,
+  sensors character(10) NOT NULL,
+  read_count integer,
   PRIMARY KEY (foo, bar, hello, goodbye)
 );
 
@@ -210,6 +211,7 @@ CREATE TABLE fourkeys_to_twokeys (
   t_artist integer NOT NULL,
   t_cd integer NOT NULL,
   autopilot character NOT NULL,
+  pilot_sequence integer,
   PRIMARY KEY (f_foo, f_bar, f_hello, f_goodbye, t_artist, t_cd)
 );
 
diff --git a/t/resultset/update_delete.t b/t/resultset/update_delete.t
new file mode 100644 (file)
index 0000000..8810418
--- /dev/null
@@ -0,0 +1,97 @@
+use strict;
+use warnings;
+
+use lib qw(t/lib);
+use Test::More;
+use Test::Exception;
+use DBICTest;
+
+#plan tests => 5;
+plan 'no_plan';
+
+my $schema = DBICTest->init_schema();
+
+my $tkfks = $schema->resultset('FourKeys_to_TwoKeys');
+
+warn "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa";
+
+my ($fa, $fb) = $tkfks->related_resultset ('fourkeys')->populate ([
+  [qw/foo bar hello goodbye sensors read_count/],
+  [qw/1   1   1     1       a       10         /],
+  [qw/2   2   2     2       b       20         /],
+]);
+
+# This is already provided by DBICTest
+#my ($ta, $tb) = $tkfk->related_resultset ('twokeys')->populate ([
+#  [qw/artist  cd /],
+#  [qw/1       1  /],
+#  [qw/2       2  /],
+#]);
+my ($ta, $tb) = $schema->resultset ('TwoKeys')
+                  ->search ( [ { artist => 1, cd => 1 }, { artist => 2, cd => 2 } ])
+                    ->all;
+
+my $tkfk_cnt = $tkfks->count;
+
+my $non_void_ctx = $tkfks->populate ([
+  { autopilot => 'a', fourkeys =>  $fa, twokeys => $ta, pilot_sequence => 10 },
+  { autopilot => 'b', fourkeys =>  $fb, twokeys => $tb, pilot_sequence => 20 },
+  { autopilot => 'x', fourkeys =>  $fa, twokeys => $tb, pilot_sequence => 30 },
+  { autopilot => 'y', fourkeys =>  $fb, twokeys => $ta, pilot_sequence => 40 },
+]);
+is ($tkfks->count, $tkfk_cnt += 4, 'FourKeys_to_TwoKeys populated succesfully');
+
+#
+# Make sure the forced group by works (i.e. the joining does not cause double-updates)
+#
+
+# create a resultset matching $fa and $fb only
+my $fks = $schema->resultset ('FourKeys')
+                  ->search ({ map { $_ => [1, 2] } qw/foo bar hello goodbye/}, { join => 'fourkeys_to_twokeys' });
+
+is ($fks->count, 4, 'Joined FourKey count correct (2x2)');
+$fks->update ({ read_count => \ 'read_count + 1' });
+$_->discard_changes for ($fa, $fb);
+
+is ($fa->read_count, 11, 'Update ran only once on joined resultset');
+is ($fb->read_count, 21, 'Update ran only once on joined resultset');
+
+
+#
+# Make sure multicolumn in or the equivalen functions correctly
+#
+
+my $sub_rs = $tkfks->search (
+  [
+    { map { $_ => 1 } qw/artist.artistid cd.cdid fourkeys.foo fourkeys.bar fourkeys.hello fourkeys.goodbye/ },
+    { map { $_ => 2 } qw/artist.artistid cd.cdid fourkeys.foo fourkeys.bar fourkeys.hello fourkeys.goodbye/ },
+  ],
+  {
+    join => [ 'fourkeys', { twokeys => [qw/artist cd/] } ],
+  },
+);
+
+is ($sub_rs->count, 2, 'Only two rows from fourkeys match');
+
+# attempts to delete a grouped rs should fail miserably
+throws_ok (
+  sub { $sub_rs->search ({}, { distinct => 1 })->delete },
+  qr/attempted a delete operation on a resultset which does group_by/,
+  'Grouped rs update/delete not allowed',
+);
+
+# grouping on PKs only should pass
+$sub_rs->search ({}, { group_by => [ reverse $sub_rs->result_source->primary_columns ] })     # reverse to make sure the comaprison works
+          ->update ({ pilot_sequence => \ 'pilot_sequence + 1' });
+
+is_deeply (
+  [ $tkfks->search ({ autopilot => [qw/a b x y/]}, { order_by => 'autopilot' })
+            ->get_column ('pilot_sequence')->all 
+  ],
+  [qw/11 21 30 40/],
+  'Only two rows incremented',
+);
+
+$sub_rs->delete;
+
+is ($tkfks->count, $tkfk_cnt -= 2, 'Only two rows deleted');