From: Peter Rabbitson Date: Tue, 30 Jun 2009 07:53:27 +0000 (+0000) Subject: Some fixes after review X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=893403c81;p=dbsrgits%2FDBIx-Class-Historic.git Some fixes after review --- diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm index d708d39..d34378a 100644 --- a/lib/DBIx/Class/ResultSet.pm +++ b/lib/DBIx/Class/ResultSet.pm @@ -1257,8 +1257,11 @@ sub _count_subq_rs { # this is so that ordering can be thrown away in things like Top limit $sub_attrs->{-for_count_only} = 1; + my $sub_rs = $rsrc->resultset_class->new ($rsrc, $sub_attrs); $attrs->{from} = [{ - count_subq => $rsrc->resultset_class->new ($rsrc, $sub_attrs )->as_query + -alias => 'count_subq', + -source_handle => $rsrc->handle, + count_subq => $sub_rs->as_query, }]; # the subquery replaces this diff --git a/lib/DBIx/Class/SQLAHacks.pm b/lib/DBIx/Class/SQLAHacks.pm index 00345c4..0494a6a 100644 --- a/lib/DBIx/Class/SQLAHacks.pm +++ b/lib/DBIx/Class/SQLAHacks.pm @@ -213,7 +213,7 @@ sub _Top { my $req_order = $order->{order_by}; my $limit_order = - scalar $self->_order_by_chunks ($req_order) # exaime normalized version, collapses nesting + scalar $self->_order_by_chunks ($req_order) # examine normalized version, collapses nesting ? $req_order : $order->{_virtual_order_by} ; diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm index 236c33d..037673e 100644 --- a/lib/DBIx/Class/Storage/DBI.pm +++ b/lib/DBIx/Class/Storage/DBI.pm @@ -1238,7 +1238,7 @@ sub _select_args { where => $where, }; - my $alias2source = $self->_resolve_ident_sources ($ident); + my ($alias2source, $root_alias) = $self->_resolve_ident_sources ($ident); # calculate bind_attrs before possible $ident mangling my $bind_attrs = {}; @@ -1250,7 +1250,7 @@ sub _select_args { $bind_attrs->{$fqcn} = $bindtypes->{$col} if $bindtypes->{$col}; # so that unqualified searches can be bound too - $bind_attrs->{$col} = $bind_attrs->{$fqcn} if $alias eq 'me'; + $bind_attrs->{$col} = $bind_attrs->{$fqcn} if $alias eq $root_alias; } } @@ -1432,10 +1432,17 @@ sub _adjust_select_args_for_limited_prefetch { ); # put it in the new {from} - unshift @outer_from, { $alias => $subq }; + unshift @outer_from, { + -alias => $alias, + -source_handle => $select_root->{-source_handle}, + $alias => $subq, + }; # This is totally horrific - the $where ends up in both the inner and outer query - # Unfortunately not much can be done until SQLA2 introspection arrives + # Unfortunately not much can be done until SQLA2 introspection arrives, and even + # then if where conditions apply to the *right* side of the prefetch, you may have + # to both filter the inner select (e.g. to apply a limit) and then have to re-filter + # the outer select to exclude joins you didin't want in the first place # # OTOH it can be seen as a plus: (notes that this query would make a DBA cry ;) return (\@outer_from, $select, $where, $attrs); @@ -1445,12 +1452,14 @@ sub _resolve_ident_sources { my ($self, $ident) = @_; my $alias2source = {}; + my $root_alias; # the reason this is so contrived is that $ident may be a {from} # structure, specifying multiple tables to join if ( Scalar::Util::blessed($ident) && $ident->isa("DBIx::Class::ResultSource") ) { # this is compat mode for insert/update/delete which do not deal with aliases $alias2source->{me} = $ident; + $root_alias = 'me'; } elsif (ref $ident eq 'ARRAY') { @@ -1458,6 +1467,7 @@ sub _resolve_ident_sources { my $tabinfo; if (ref $_ eq 'HASH') { $tabinfo = $_; + $root_alias = $tabinfo->{-alias}; } if (ref $_ eq 'ARRAY' and ref $_->[0] eq 'HASH') { $tabinfo = $_->[0]; @@ -1468,7 +1478,7 @@ sub _resolve_ident_sources { } } - return $alias2source; + return ($alias2source, $root_alias); } # Takes $ident, \@column_names @@ -1480,17 +1490,18 @@ sub _resolve_ident_sources { # my $col_sources = $self->_resolve_column_info($ident, [map $_->[0], @{$bind}]); sub _resolve_column_info { my ($self, $ident, $colnames) = @_; - my $alias2src = $self->_resolve_ident_sources($ident); + my ($alias2src, $root_alias) = $self->_resolve_ident_sources($ident); my $sep = $self->_sql_maker_opts->{name_sep} || '.'; $sep = "\Q$sep\E"; - my %return; - foreach my $col (@{$colnames}) { - $col =~ m/^ (?: ([^$sep]+) $sep)? (.+) $/x; + my (%return, %converted); + foreach my $col (@$colnames) { + my ($alias, $colname) = $col =~ m/^ (?: ([^$sep]+) $sep)? (.+) $/x; - my $alias = $1 || 'me'; - my $colname = $2; + # deal with unqualified cols - we assume the main alias for all + # unqualified ones, ugly but can't think of anything better right now + $alias ||= $root_alias; my $rsrc = $alias2src->{$alias}; $return{$col} = $rsrc && { %{$rsrc->column_info($colname)}, -result_source => $rsrc }; diff --git a/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm b/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm index 544e68c..1b661f8 100644 --- a/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm +++ b/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm @@ -3,6 +3,7 @@ use strict; use warnings; use base qw/DBIx::Class::Storage::DBI::MSSQL/; +use List::Util(); sub insert_bulk { my ($self, $source, $cols, $data) = @_; @@ -17,23 +18,17 @@ sub insert_bulk { } } - my $table = $source->from; if ($identity_insert) { - $source->storage->dbh_do(sub { - my ($storage, $dbh, @cols) = @_; - $dbh->do("SET IDENTITY_INSERT $table ON;"); - }); + my $table = $source->from; + $self->dbh->do("SET IDENTITY_INSERT $table ON"); } next::method(@_); if ($identity_insert) { - $source->storage->dbh_do(sub { - my ($storage, $dbh, @cols) = @_; - $dbh->do("SET IDENTITY_INSERT $table OFF;"); - }); + my $table = $source->from; + $self->dbh->do("SET IDENTITY_INSERT $table OFF"); } - } sub _prep_for_execute { @@ -41,23 +36,20 @@ sub _prep_for_execute { my ($op, $extra_bind, $ident, $args) = @_; my ($sql, $bind) = $self->next::method (@_); - $sql .= ';SELECT SCOPE_IDENTITY()' if $op eq 'insert'; - my %identity_insert_tables; - my $col_info = $self->_resolve_column_info($ident, [map $_->[0], @{$bind}]); + if ($op eq 'insert') { + $sql .= ';SELECT SCOPE_IDENTITY()'; + + my $col_info = $self->_resolve_column_info($ident, [map $_->[0], @{$bind}]); + if (List::Util::first { $_->{is_auto_increment} } (values %$col_info) ) { - foreach my $bound (@{$bind}) { - my $col = $bound->[0]; - if ($col_info->{$col}->{is_auto_increment}) { - my $table = $col_info->{$col}->{-result_source}->from; - $identity_insert_tables{$table} = 1; + my $table = $ident->from; + my $identity_insert_on = "SET IDENTITY_INSERT $table ON"; + my $identity_insert_off = "SET IDENTITY_INSERT $table OFF"; + $sql = "$identity_insert_on; $sql; $identity_insert_off"; } } - my $identity_insert_on = join '', map { "SET IDENTITY_INSERT $_ ON; " } keys %identity_insert_tables; - my $identity_insert_off = join '', map { "SET IDENTITY_INSERT $_ OFF; " } keys %identity_insert_tables; - $sql = "$identity_insert_on $sql $identity_insert_off"; - return ($sql, $bind); } diff --git a/t/746mssql.t b/t/746mssql.t index bae2e7c..a7edb6f 100644 --- a/t/746mssql.t +++ b/t/746mssql.t @@ -2,6 +2,7 @@ use strict; use warnings; use Test::More; +use Test::Exception; use lib qw(t/lib); use DBICTest; use DBIC::SqlMakerTest; @@ -11,7 +12,7 @@ my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_MSSQL_ODBC_${_}" } qw/DSN USER PA plan skip_all => 'Set $ENV{DBICTEST_MSSQL_ODBC_DSN}, _USER and _PASS to run this test' unless ($dsn && $user); -plan tests => 25; +plan tests => 27; my $schema = DBICTest::Schema->connect($dsn, $user, $pass); @@ -97,41 +98,46 @@ CREATE TABLE Owners ( SQL }); -$schema->populate ('Owners', [ - [qw/id name /], - [qw/1 wiggle/], - [qw/2 woggle/], - [qw/3 boggle/], - [qw/4 fREW/], - [qw/5 fRIOUX/], - [qw/6 fROOH/], - [qw/7 fRUE/], - [qw/8 fISMBoC/], - [qw/9 station/], - [qw/10 mirror/], - [qw/11 dimly/], - [qw/12 face_to_face/], - [qw/13 icarus/], - [qw/14 dream/], - [qw/15 dyrstyggyr/], -]); - -$schema->populate ('BooksInLibrary', [ - [qw/source owner title /], - [qw/Library 1 secrets0/], - [qw/Library 1 secrets1/], - [qw/Eatery 1 secrets2/], - [qw/Library 2 secrets3/], - [qw/Library 3 secrets4/], - [qw/Eatery 3 secrets5/], - [qw/Library 4 secrets6/], - [qw/Library 5 secrets7/], - [qw/Eatery 5 secrets8/], - [qw/Library 6 secrets9/], - [qw/Library 7 secrets10/], - [qw/Eatery 7 secrets11/], - [qw/Library 8 secrets12/], -]); + +lives_ok ( sub { + $schema->populate ('Owners', [ + [qw/id name /], + [qw/1 wiggle/], + [qw/2 woggle/], + [qw/3 boggle/], + [qw/4 fREW/], + [qw/5 fRIOUX/], + [qw/6 fROOH/], + [qw/7 fRUE/], + [qw/8 fISMBoC/], + [qw/9 station/], + [qw/10 mirror/], + [qw/11 dimly/], + [qw/12 face_to_face/], + [qw/13 icarus/], + [qw/14 dream/], + [qw/15 dyrstyggyr/], + ]); +}, 'populate with PKs supplied ok' ); + +lives_ok ( sub { + $schema->populate ('BooksInLibrary', [ + [qw/source owner title /], + [qw/Library 1 secrets0/], + [qw/Library 1 secrets1/], + [qw/Eatery 1 secrets2/], + [qw/Library 2 secrets3/], + [qw/Library 3 secrets4/], + [qw/Eatery 3 secrets5/], + [qw/Library 4 secrets6/], + [qw/Library 5 secrets7/], + [qw/Eatery 5 secrets8/], + [qw/Library 6 secrets9/], + [qw/Library 7 secrets10/], + [qw/Eatery 7 secrets11/], + [qw/Library 8 secrets12/], + ]); +}, 'populate without PKs supplied ok' ); # # try a prefetch on tables with identically named columns @@ -142,7 +148,7 @@ $schema->storage->_sql_maker->{quote_char} = [qw/[ ]/]; $schema->storage->_sql_maker->{name_sep} = '.'; { - # try a ->has_many direction (group_by is not possible on has_many with limit) + # try a ->has_many direction my $owners = $schema->resultset ('Owners')->search ({ 'books.id' => { '!=', undef } }, {