Some fixes after review
Peter Rabbitson [Tue, 30 Jun 2009 07:53:27 +0000 (07:53 +0000)]
lib/DBIx/Class/ResultSet.pm
lib/DBIx/Class/SQLAHacks.pm
lib/DBIx/Class/Storage/DBI.pm
lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm
t/746mssql.t

index d708d39..d34378a 100644 (file)
@@ -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
index 00345c4..0494a6a 100644 (file)
@@ -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}
   ;
index 236c33d..037673e 100644 (file)
@@ -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: <ash> (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 };
index 544e68c..1b661f8 100644 (file)
@@ -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);
 }
 
index bae2e7c..a7edb6f 100644 (file)
@@ -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 }
     }, {