- Refactor DBIx::Class::Storage::DBI::Sybase to automatically
load a subclass, namely Microsoft_SQL_Server.pm
- (similar to DBIx::Class::Storage::DBI::ODBC)
+ (similar to DBIx::Class::Storage::DBI::ODBC)
+ - Proper support for update/delete of joined resultsets
+ (using IN => $sub_rs->as_query)
0.08102 2009-04-30 08:29:00 (UTC)
- Fixed two subtle bugs when using columns or select/as
requires 'DBD::SQLite' => 1.23;
requires 'Data::Page' => 2.00;
requires 'Scalar::Util' => 0;
-requires 'SQL::Abstract' => 1.53;
+requires 'SQL::Abstract' => 1.54;
requires 'SQL::Abstract::Limit' => 0.13;
requires 'Class::C3::Componentised' => 1.0005;
requires 'Storable' => 0;
# No-op. No condition, we're updating/deleting everything
return $cond unless ref $full_cond;
- if (ref $full_cond eq 'ARRAY') {
- $cond = [
- map {
- my %hash;
- foreach my $key (keys %{$_}) {
- $key =~ /([^.]+)$/;
- $hash{$1} = $_->{$key};
- }
- \%hash;
- } @{$full_cond}
- ];
- }
- elsif (ref $full_cond eq 'HASH') {
- if ((keys %{$full_cond})[0] eq '-and') {
- $cond->{-and} = [];
-
- my @cond = @{$full_cond->{-and}};
- for (my $i = 0; $i < @cond; $i++) {
- my $entry = $cond[$i];
-
- my $hash;
- if (ref $entry eq 'HASH') {
- $hash = $self->_cond_for_update_delete($entry);
- }
- else {
- $entry =~ /([^.]+)$/;
- $hash->{$1} = $cond[++$i];
- }
-
- push @{$cond->{-and}}, $hash;
- }
- }
- else {
- foreach my $key (keys %{$full_cond}) {
- $key =~ /([^.]+)$/;
- $cond->{$1} = $full_cond->{$key};
- }
- }
- }
- else {
- $self->throw_exception(
- "Can't update/delete on resultset with condition unless hash or array"
- );
+ foreach my $pk ($self->result_source->primary_columns) {
+ $cond->{$pk} = { -in => $self->get_column($pk)->as_query };
}
return $cond;
$self->throw_exception("Values for update must be a hash")
unless ref $values eq 'HASH';
- carp( 'WARNING! Currently $rs->update() does not generate proper SQL'
- . ' on joined resultsets, and may affect rows well outside of the'
- . ' contents of $rs. Use at your own risk' )
- if ( $self->{attrs}{seen_join} );
-
my $cond = $self->_cond_for_update_delete;
-
+
return $self->result_source->storage->update(
$self->result_source, $values, $cond
);
delete may not generate correct SQL for a query with joins or a resultset
chained from a related resultset. In this case it will generate a warning:-
- WARNING! Currently $rs->delete() does not generate proper SQL on
- joined resultsets, and may delete rows well outside of the contents
- of $rs. Use at your own risk
-
In these cases you may find that delete_all is more appropriate, or you
need to respecify your query in a way that can be expressed without a join.
my ($self) = @_;
$self->throw_exception("Delete should not be passed any arguments")
if $_[1];
- carp( 'WARNING! Currently $rs->delete() does not generate proper SQL'
- . ' on joined resultsets, and may delete rows well outside of the'
- . ' contents of $rs. Use at your own risk' )
- if ( $self->{attrs}{seen_join} );
+
my $cond = $self->_cond_for_update_delete;
$self->result_source->storage->delete($self->result_source, $cond);
=cut
-sub as_query { return shift->_resultset->as_query }
+sub as_query { return shift->_resultset->as_query(@_) }
=head2 next
use base qw/SQL::Abstract::Limit/;
-# This prevents the caching of $dbh in S::A::L, I believe
sub new {
my $self = shift->SUPER::new(@_);
+ # This prevents the caching of $dbh in S::A::L, I believe
# If limit_dialect is a ref (like a $dbh), go ahead and replace
# it with what it resolves to:
$self->{limit_dialect} = $self->_find_syntax($self->{limit_dialect})
$self;
}
+
+
+# Some databases (sqlite) do not handle multiple parenthesis
+# around in/between arguments. A tentative x IN ( ( 1, 2 ,3) )
+# is interpreted as x IN 1 or something similar.
+#
+# Since we currently do not have access to the SQLA AST, resort
+# to barbaric mutilation of any SQL supplied in literal form
+
+sub _strip_outer_paren {
+ my ($self, $arg) = @_;
+
+use Data::Dumper;
+
+ return $self->_SWITCH_refkind ($arg, {
+ ARRAYREFREF => sub {
+ $$arg->[0] = __strip_outer_paren ($$arg->[0]);
+ return $arg;
+ },
+ SCALARREF => sub {
+ return \__strip_outer_paren( $$arg );
+ },
+ FALLBACK => sub {
+ return $arg
+ },
+ });
+}
+
+sub __strip_outer_paren {
+ my $sql = shift;
+
+ if ($sql and not ref $sql) {
+ while ($sql =~ /^ \s* \( (.*) \) \s* $/x ) {
+ $sql = $1;
+ }
+ }
+
+ return $sql;
+}
+
+sub _where_field_IN {
+ my ($self, $lhs, $op, $rhs) = @_;
+ $rhs = $self->_strip_outer_paren ($rhs);
+ return $self->SUPER::_where_field_IN ($lhs, $op, $rhs);
+}
+
+sub _where_field_BETWEEN {
+ my ($self, $lhs, $op, $rhs) = @_;
+ $rhs = $self->_strip_outer_paren ($rhs);
+ return $self->SUPER::_where_field_BETWEEN ($lhs, $op, $rhs);
+}
+
+
+
# DB2 is the only remaining DB using this. Even though we are not sure if
# RowNumberOver is still needed here (should be part of SQLA) leave the
# code in place
+++ /dev/null
-use Test::More;
-use strict;
-use warnings;
-use lib qw(t/lib);
-use DBICTest;
-
-plan tests => 9;
-
-# This set of tests attempts to do a delete on a chained resultset, which
-# would lead to SQL DELETE with a JOIN, which is not supported by the
-# SQL generator right now.
-# So it currently checks that these operations fail with a warning.
-# When the SQL generator is fixed this test will need fixing up appropriately.
-
-my $schema = DBICTest->init_schema();
-my $total_tracks = $schema->resultset('Track')->count;
-cmp_ok($total_tracks, '>', 0, 'need track records');
-
-# test that delete_related w/o conditions deletes all related records only
-{
- my $w;
- local $SIG{__WARN__} = sub { $w = shift };
-
- my $artist = $schema->resultset("Artist")->find(3);
- my $artist_tracks = $artist->cds->search_related('tracks')->count;
- cmp_ok($artist_tracks, '<', $total_tracks, 'need more tracks than just related tracks');
-
- ok(!eval{$artist->cds->search_related('tracks')->delete});
- cmp_ok($schema->resultset('Track')->count, '==', $total_tracks, 'No tracks should be deleted');
- like ($w, qr/Currently \$rs->delete\(\) does not generate proper SQL/, 'Delete join warning');
-}
-
-# test that delete_related w/conditions deletes just the matched related records only
-{
- my $w;
- local $SIG{__WARN__} = sub { $w = shift };
-
- my $artist2 = $schema->resultset("Artist")->find(2);
- my $artist2_tracks = $artist2->search_related('cds')->search_related('tracks')->count;
- cmp_ok($artist2_tracks, '<', $total_tracks, 'need more tracks than related tracks');
-
- ok(!eval{$artist2->search_related('cds')->search_related('tracks')->delete});
- cmp_ok($schema->resultset('Track')->count, '==', $total_tracks, 'No tracks should be deleted');
- like ($w, qr/Currently \$rs->delete\(\) does not generate proper SQL/, 'Delete join warning');
-}
eval "use DBD::SQLite";
plan $@
? ( skip_all => 'needs DBD::SQLite for testing' )
- : ( tests => 18 );
+ : ( tests => 33 );
}
# figure out if we've got a version of sqlite that is older than 3.2.6, in
] ] }
);
-cmp_ok( $rs + 0, '==', 1, "Single record in resultset");
+is( $rs + 0, 1, "Single record in resultset");
is($rs->first->title, 'Forkful of bees', 'Correct record returned');
{ 'year' => 2001, 'artist.name' => 'Caterwauler McCrae' },
{ join => 'artist' });
-cmp_ok( $rs + 0, '==', 1, "Single record in resultset");
+is( $rs + 0, 1, "Single record in resultset");
is($rs->first->title, 'Forkful of bees', 'Correct record returned');
'liner_notes.notes' => 'Kill Yourself!' },
{ join => [ qw/artist liner_notes/ ] });
-cmp_ok( $rs + 0, '==', 1, "Single record in resultset");
+is( $rs + 0, 1, "Single record in resultset");
is($rs->first->title, 'Come Be Depressed With Us', 'Correct record returned');
{ 'artist' => 1 },
{ join => [qw/artist/], order_by => 'artist.name' }
);
-cmp_ok( scalar $rs->all, '==', scalar $rs->slice(0, $rs->count - 1), 'slice() with join has same count as all()' );
+is( scalar $rs->all, scalar $rs->slice(0, $rs->count - 1), 'slice() with join has same count as all()' );
ok(!$rs->slice($rs->count+1000, $rs->count+1002)->count,
'Slicing beyond end of rs returns a zero count');
{ 'liner_notes.notes' => 'Kill Yourself!' },
{ join => { 'cds' => 'liner_notes' } });
-cmp_ok( $rs->count, '==', 1, "Single record in resultset");
+is( $rs->count, 1, "Single record in resultset");
is($rs->first->name, 'We Are Goth', 'Correct record returned');
-# test for warnings on delete of joined resultset
-$rs = $schema->resultset("CD")->search(
- { 'artist.name' => 'Caterwauler McCrae' },
- { join => [qw/artist/]}
-);
-my $tst_delete_warning;
-eval {
- local $SIG{__WARN__} = sub { $tst_delete_warning = shift };
- $rs->delete();
-};
-ok( ($@ || $tst_delete_warning), 'fail/warning on attempt to delete a join-ed resultset');
-
-# test for warnings on update of joined resultset
-$rs = $schema->resultset("CD")->search(
- { 'artist.name' => 'Random Boy Band' },
- { join => [qw/artist/]}
-);
-my $tst_update_warning;
-eval {
- local $SIG{__WARN__} = sub { $tst_update_warning = shift };
- $rs->update({ 'artist' => 1 });
-};
-
-ok( ($@ || $tst_update_warning), 'fail/warning on attempt to update a join-ed resultset');
+{
+ $schema->populate('Artist', [
+ [ qw/artistid name/ ],
+ [ 4, 'Another Boy Band' ],
+ ]);
+ $schema->populate('CD', [
+ [ qw/cdid artist title year/ ],
+ [ 6, 2, "Greatest Hits", 2001 ],
+ [ 7, 4, "Greatest Hits", 2005 ],
+ [ 8, 4, "BoyBandBlues", 2008 ],
+ ]);
+ $schema->populate('TwoKeys', [
+ [ qw/artist cd/ ],
+ [ 2, 4 ],
+ [ 2, 6 ],
+ [ 4, 7 ],
+ [ 4, 8 ],
+ ]);
+
+ sub cd_count {
+ return $schema->resultset("CD")->count;
+ }
+ sub tk_count {
+ return $schema->resultset("TwoKeys")->count;
+ }
+
+ is(cd_count(), 8, '8 rows in table cd');
+ is(tk_count(), 7, '7 rows in table twokeys');
+
+ sub artist1 {
+ return $schema->resultset("CD")->search(
+ { 'artist.name' => 'Caterwauler McCrae' },
+ { join => [qw/artist/]}
+ );
+ }
+ sub artist2 {
+ return $schema->resultset("CD")->search(
+ { 'artist.name' => 'Random Boy Band' },
+ { join => [qw/artist/]}
+ );
+ }
+
+ is( artist1()->count, 3, '3 Caterwauler McCrae CDs' );
+ ok( artist1()->delete, 'Successfully deleted 3 CDs' );
+ is( artist1()->count, 0, '0 Caterwauler McCrae CDs' );
+ is( artist2()->count, 2, '3 Random Boy Band CDs' );
+ ok( artist2()->update( { 'artist' => 1 } ) );
+ is( artist2()->count, 0, '0 Random Boy Band CDs' );
+ is( artist1()->count, 2, '2 Caterwauler McCrae CDs' );
+
+ # test update on multi-column-pk
+ sub tk1 {
+ return $schema->resultset("TwoKeys")->search(
+ {
+ 'artist.name' => { like => '%Boy Band' },
+ 'cd.title' => 'Greatest Hits',
+ },
+ { join => [qw/artist cd/] }
+ );
+ }
+ sub tk2 {
+ return $schema->resultset("TwoKeys")->search(
+ { 'artist.name' => 'Caterwauler McCrae' },
+ { join => [qw/artist/]}
+ );
+ }
+ is( tk2()->count, 2, 'TwoKeys count == 2' );
+ is( tk1()->count, 2, 'TwoKeys count == 2' );
+ ok( tk1()->update( { artist => 1 } ) );
+ is( tk1()->count, 0, 'TwoKeys count == 0' );
+ is( tk2()->count, 4, '2 Caterwauler McCrae CDs' );
+ ok( tk2()->delete, 'Successfully deleted 4 CDs' );
+ is(cd_count(), 5, '5 rows in table cd');
+ is(tk_count(), 3, '3 rows in table twokeys');
+}
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Data::Dumper;
+
+use Test::More;
+
+plan ( tests => 1 );
+
+use lib qw(t/lib);
+use DBICTest;
+use DBIC::SqlMakerTest;
+
+my $schema = DBICTest->init_schema();
+
+{
+ my $rs = $schema->resultset("CD")->search(
+ { 'artist.name' => 'Caterwauler McCrae' },
+ { join => [qw/artist/]}
+ );
+ my $squery = $rs->get_column('cdid')->as_query;
+ my $subsel_rs = $schema->resultset("CD")->search( { cdid => { IN => $squery } } );
+ is($subsel_rs->count, $rs->count, 'Subselect on PK got the same row count');
+}
my $subsel_rs = $schema->resultset("CD")->search( { cdid => { IN => $rs->get_column('cdid')->as_query } } );
cmp_ok($subsel_rs->count, '==', $rs->count, 'Subselect on PK got the same row count');
}
-
-__END__
projects / dbsrgits/DBIx-Class.git / commitdiff