[Bast-commits] r6381 - in DBIx-Class/0.08/trunk/t: delete lib
lib/DBICTest/Schema resultset
ribasushi at dev.catalyst.perl.org
ribasushi at dev.catalyst.perl.org
Sat May 23 19:33:28 GMT 2009
Author: ribasushi
Date: 2009-05-23 19:33:28 +0000 (Sat, 23 May 2009)
New Revision: 6381
Added:
DBIx-Class/0.08/trunk/t/resultset/update_delete.t
Modified:
DBIx-Class/0.08/trunk/t/delete/related.t
DBIx-Class/0.08/trunk/t/lib/DBICTest/Schema/FourKeys.pm
DBIx-Class/0.08/trunk/t/lib/DBICTest/Schema/FourKeys_to_TwoKeys.pm
DBIx-Class/0.08/trunk/t/lib/sqlite.sql
Log:
Tests and test schema adjustments for resultset update/delete
Modified: DBIx-Class/0.08/trunk/t/delete/related.t
===================================================================
--- DBIx-Class/0.08/trunk/t/delete/related.t 2009-05-23 14:44:59 UTC (rev 6380)
+++ DBIx-Class/0.08/trunk/t/delete/related.t 2009-05-23 19:33:28 UTC (rev 6381)
@@ -4,7 +4,7 @@
use lib qw(t/lib);
use DBICTest;
-plan tests => 6;
+plan tests => 3;
my $schema = DBICTest->init_schema();
@@ -43,46 +43,3 @@
# 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');
Modified: DBIx-Class/0.08/trunk/t/lib/DBICTest/Schema/FourKeys.pm
===================================================================
--- DBIx-Class/0.08/trunk/t/lib/DBICTest/Schema/FourKeys.pm 2009-05-23 14:44:59 UTC (rev 6380)
+++ DBIx-Class/0.08/trunk/t/lib/DBICTest/Schema/FourKeys.pm 2009-05-23 19:33:28 UTC (rev 6381)
@@ -9,7 +9,8 @@
'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/);
Modified: DBIx-Class/0.08/trunk/t/lib/DBICTest/Schema/FourKeys_to_TwoKeys.pm
===================================================================
--- DBIx-Class/0.08/trunk/t/lib/DBICTest/Schema/FourKeys_to_TwoKeys.pm 2009-05-23 14:44:59 UTC (rev 6380)
+++ DBIx-Class/0.08/trunk/t/lib/DBICTest/Schema/FourKeys_to_TwoKeys.pm 2009-05-23 19:33:28 UTC (rev 6381)
@@ -12,6 +12,7 @@
'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/
Modified: DBIx-Class/0.08/trunk/t/lib/sqlite.sql
===================================================================
--- DBIx-Class/0.08/trunk/t/lib/sqlite.sql 2009-05-23 14:44:59 UTC (rev 6380)
+++ DBIx-Class/0.08/trunk/t/lib/sqlite.sql 2009-05-23 19:33:28 UTC (rev 6381)
@@ -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 @@
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 @@
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)
);
Copied: DBIx-Class/0.08/trunk/t/resultset/update_delete.t (from rev 6328, DBIx-Class/0.08/trunk/t/delete/related.t)
===================================================================
--- DBIx-Class/0.08/trunk/t/resultset/update_delete.t (rev 0)
+++ DBIx-Class/0.08/trunk/t/resultset/update_delete.t 2009-05-23 19:33:28 UTC (rev 6381)
@@ -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');
More information about the Bast-commits
mailing list