From: Peter Rabbitson <ribasushi@cpan.org>
Date: Wed, 9 Dec 2009 22:13:59 +0000 (+0000)
Subject: Merge 'mssql_rno_pagination' into 'trunk'
X-Git-Tag: v0.08116~103
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=9fff842f80b78e4faf165ae4001c87b9f7c92728;hp=8bcd9ece59ed15506918847950e64f8b44815fa8;p=dbsrgits%2FDBIx-Class.git

Merge 'mssql_rno_pagination' into 'trunk'

r8022@Thesaurus (orig r8010):  frew | 2009-12-02 17:57:17 +0100
branch for replacing TOP with RNO in MSSQL
r8027@Thesaurus (orig r8015):  frew | 2009-12-03 02:48:36 +0100
Switch to RowNumberOver for MSSQL
r8028@Thesaurus (orig r8016):  ribasushi | 2009-12-03 10:03:18 +0100
The correct top100 mssql solution and test
r8031@Thesaurus (orig r8019):  frew | 2009-12-03 15:56:35 +0100
fix RNO for MSSQL to not use a kludgy regexp
r8032@Thesaurus (orig r8020):  frew | 2009-12-04 01:33:28 +0100
initial (broken) version of 42rno.t
r8033@Thesaurus (orig r8021):  frew | 2009-12-04 01:37:06 +0100
first shot at moving stuff around
r8034@Thesaurus (orig r8022):  frew | 2009-12-04 01:45:42 +0100
rename files to get rid of numbers and use folders
r8035@Thesaurus (orig r8023):  frew | 2009-12-04 01:48:00 +0100
missed toplimit
r8036@Thesaurus (orig r8024):  frew | 2009-12-04 01:52:44 +0100
still broken rno test, but now it actually tests mssql
r8042@Thesaurus (orig r8030):  ribasushi | 2009-12-04 09:34:56 +0100
Variable clash
r8043@Thesaurus (orig r8031):  ribasushi | 2009-12-04 11:44:47 +0100
The complex prefetch rewrite actually takes care of this as cleanly as possible
r8044@Thesaurus (orig r8032):  ribasushi | 2009-12-04 11:47:22 +0100
Smarter implementation of the select top 100pct subselect handling
r8045@Thesaurus (orig r8033):  ribasushi | 2009-12-04 12:07:05 +0100
Add support for unordered limited resultsets
Rename the limit helper to signify it is MS specific
Make sure we don't lose group_by/having clauses
r8046@Thesaurus (orig r8034):  ribasushi | 2009-12-04 12:07:56 +0100
Un-todoify mssql limit tests - no changes necessary (throw away the obsolete generated sql checks)
r8047@Thesaurus (orig r8035):  ribasushi | 2009-12-04 12:24:13 +0100
Tests for bindvar propagation and Changes
r8049@Thesaurus (orig r8037):  ribasushi | 2009-12-04 15:01:32 +0100
KISS - a select(1) makes perfect ordering criteria
r8050@Thesaurus (orig r8038):  ribasushi | 2009-12-04 15:06:11 +0100
Unify the MSSQL and DB2 RNO implementations - they are the same
r8051@Thesaurus (orig r8039):  ribasushi | 2009-12-05 10:29:50 +0100
Wrap mssql selects in yet another subquery to make limited right-ordered join resultsets possible
r8052@Thesaurus (orig r8040):  ribasushi | 2009-12-05 10:46:41 +0100
Better not touch Top - it's too complex at this point
r8053@Thesaurus (orig r8041):  ribasushi | 2009-12-05 11:03:00 +0100
Extend test just a bit more
r8054@Thesaurus (orig r8042):  ribasushi | 2009-12-05 11:44:25 +0100
DB2 and MSSQL have different default order syntaxes
r8056@Thesaurus (orig r8044):  frew | 2009-12-08 02:10:06 +0100
add version check for mssql 2005 and greater
r8059@Thesaurus (orig r8047):  frew | 2009-12-08 16:15:50 +0100
real exception instead of die
r8061@Thesaurus (orig r8049):  ribasushi | 2009-12-09 00:19:49 +0100
Test for immediate connection with known storage type
r8062@Thesaurus (orig r8050):  frew | 2009-12-09 01:24:45 +0100
fix mssql version check so it's lazier
r8064@Thesaurus (orig r8052):  ribasushi | 2009-12-09 02:40:51 +0100
Fix comment
r8066@Thesaurus (orig r8054):  caelum | 2009-12-09 16:12:56 +0100
fix _get_mssql_version for ODBC
---

diff --git a/Changes b/Changes
index d670a58..cd21c5a 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,6 @@
 Revision history for DBIx::Class
 
+        - Real limit/offset support for MSSQL server (via Row_Number)
         - Fix distinct => 1 with non-selecting order_by (the columns
           in order_by also need to be aded to the resulting group_by)
         - Do not attempt to deploy FK constraints pointing to a View
diff --git a/Makefile.PL b/Makefile.PL
index c3ebdcc..86497df 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -143,6 +143,7 @@ resources 'repository'  => 'http://dev.catalyst.perl.org/repos/bast/DBIx-Class/'
 resources 'MailingList' => 'http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/dbix-class';
 
 no_index 'DBIx::Class::SQLAHacks';
+no_index 'DBIx::Class::SQLAHacks::MySQL';
 no_index 'DBIx::Class::SQLAHacks::MSSQL';
 no_index 'DBIx::Class::SQLAHacks::OracleJoins';
 no_index 'DBIx::Class::Storage::DBI::AmbiguousGlob';
diff --git a/lib/DBIx/Class/SQLAHacks.pm b/lib/DBIx/Class/SQLAHacks.pm
index 81661fb..02c336c 100644
--- a/lib/DBIx/Class/SQLAHacks.pm
+++ b/lib/DBIx/Class/SQLAHacks.pm
@@ -47,31 +47,36 @@ sub new {
 }
 
 
-# Slow but ANSI standard Limit/Offset support. DB2 uses this
+# ANSI standard Limit/Offset implementation. DB2 and MSSQL use this
 sub _RowNumberOver {
   my ($self, $sql, $order, $rows, $offset ) = @_;
 
-  $offset += 1;
-  my $last = $rows + $offset - 1;
-  my ( $order_by ) = $self->_order_by( $order );
+  # get the order_by only (or make up an order if none exists)
+  my $order_by = $self->_order_by(
+    (delete $order->{order_by}) || $self->_rno_default_order
+  );
 
-  $sql = <<"SQL";
-SELECT * FROM
-(
-   SELECT Q1.*, ROW_NUMBER() OVER( ) AS ROW_NUM FROM (
-      $sql
-      $order_by
-   ) Q1
-) Q2
-WHERE ROW_NUM BETWEEN $offset AND $last
+  # whatever is left
+  my $group_having = $self->_order_by($order);
 
-SQL
+  $sql = sprintf (<<'EOS', $order_by, $sql, $group_having, $offset + 1, $offset + $rows, );
+
+SELECT * FROM (
+  SELECT orig_query.*, ROW_NUMBER() OVER(%s ) AS rno__row__index FROM (%s%s) orig_query
+) rno_subq WHERE rno__row__index BETWEEN %d AND %d
 
+EOS
+
+  $sql =~ s/\s*\n\s*/ /g;   # easier to read in the debugger
   return $sql;
 }
 
-# Crappy Top based Limit/Offset support. MSSQL uses this currently,
-# but may have to switch to RowNumberOver one day
+# some databases are happy with OVER (), some need OVER (ORDER BY (SELECT (1)) )
+sub _rno_default_order {
+  return undef;
+}
+
+# Crappy Top based Limit/Offset support. Legacy from MSSQL.
 sub _Top {
   my ( $self, $sql, $order, $rows, $offset ) = @_;
 
diff --git a/lib/DBIx/Class/SQLAHacks/MSSQL.pm b/lib/DBIx/Class/SQLAHacks/MSSQL.pm
index 1b18b1e..f1af970 100644
--- a/lib/DBIx/Class/SQLAHacks/MSSQL.pm
+++ b/lib/DBIx/Class/SQLAHacks/MSSQL.pm
@@ -5,29 +5,10 @@ use base qw( DBIx::Class::SQLAHacks );
 use Carp::Clan qw/^DBIx::Class|^SQL::Abstract/;
 
 #
-# MSSQL is retarded wrt TOP (crappy limit) and ordering.
-# One needs to add a TOP to *all* ordered subqueries, if
-# TOP has been used in the statement at least once.
-# Do it here.
+# MSSQL does not support ... OVER() ... RNO limits
 #
-sub select {
-  my $self = shift;
-
-  my ($sql, @bind) = $self->SUPER::select (@_);
-
-  # ordering was requested and there are at least 2 SELECT/FROM pairs
-  # (thus subquery), and there is no TOP specified
-  if (
-    $sql =~ /\bSELECT\b .+? \bFROM\b .+? \bSELECT\b .+? \bFROM\b/isx
-      &&
-    $sql !~ /^ \s* SELECT \s+ TOP \s+ \d+ /xi
-      &&
-    scalar $self->_order_by_chunks ($_[3]->{order_by})
-  ) {
-    $sql =~ s/^ \s* SELECT \s/SELECT TOP 100 PERCENT /xi;
-  }
-
-  return wantarray ? ($sql, @bind) : $sql;
+sub _rno_default_order {
+  return \ '(SELECT(1))';
 }
 
 1;
diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm
index f7a9955..d69af71 100644
--- a/lib/DBIx/Class/Storage/DBI.pm
+++ b/lib/DBIx/Class/Storage/DBI.pm
@@ -1779,12 +1779,52 @@ sub _select_args {
   if (
     ( $attrs->{rows} && keys %{$attrs->{collapse}} )
        ||
-    ( $attrs->{group_by} && @{$attrs->{group_by}} &&
-      $attrs->{_prefetch_select} && @{$attrs->{_prefetch_select}} )
+    ( $attrs->{group_by}
+        &&
+      @{$attrs->{group_by}}
+        &&
+      $attrs->{_prefetch_select}
+        &&
+      @{$attrs->{_prefetch_select}}
+    )
   ) {
+
     ($ident, $select, $where, $attrs)
       = $self->_adjust_select_args_for_complex_prefetch ($ident, $select, $where, $attrs);
   }
+
+  elsif (
+    ($attrs->{rows} || $attrs->{offset})
+      &&
+    $sql_maker->limit_dialect eq 'RowNumberOver'
+      &&
+    (ref $ident eq 'ARRAY' && @$ident > 1)  # indicates a join
+      &&
+    scalar $sql_maker->_order_by_chunks ($attrs->{order_by})
+  ) {
+    # the RNO limit dialect above mangles the SQL such that the join gets lost
+    # wrap a subquery here
+
+    push @limit, delete @{$attrs}{qw/rows offset/};
+
+    my $subq = $self->_select_args_to_query (
+      $ident,
+      $select,
+      $where,
+      $attrs,
+    );
+
+    $ident = {
+      -alias => $attrs->{alias},
+      -source_handle => $ident->[0]{-source_handle},
+      $attrs->{alias} => $subq,
+    };
+
+    # all part of the subquery now
+    delete @{$attrs}{qw/order_by group_by having/};
+    $where = undef;
+  }
+
   elsif (! $attrs->{software_limit} ) {
     push @limit, $attrs->{rows}, $attrs->{offset};
   }
diff --git a/lib/DBIx/Class/Storage/DBI/MSSQL.pm b/lib/DBIx/Class/Storage/DBI/MSSQL.pm
index 2db2af7..dec843f 100644
--- a/lib/DBIx/Class/Storage/DBI/MSSQL.pm
+++ b/lib/DBIx/Class/Storage/DBI/MSSQL.pm
@@ -178,6 +178,28 @@ sub _execute {
 
 sub last_insert_id { shift->_identity }
 
+#
+# MSSQL is retarded wrt ordered subselects. One needs to add a TOP 100%
+# to *all* subqueries, do it here.
+#
+sub _select_args_to_query {
+  my $self = shift;
+
+  my ($sql, $prep_bind, @rest) = $self->next::method (@_);
+
+  # see if this is an ordered subquery
+  my $attrs = $_[3];
+  if ( scalar $self->sql_maker->_order_by_chunks ($attrs->{order_by}) ) {
+    $sql =~ s/^ \s* SELECT \s/SELECT TOP 100 PERCENT /xi;
+  }
+
+  return wantarray
+    ? ($sql, $prep_bind, @rest)
+    : \[ "($sql)", @$prep_bind ]
+  ;
+}
+
+
 # savepoint syntax is the same as in Sybase ASE
 
 sub _svp_begin {
@@ -205,14 +227,35 @@ sub build_datetime_parser {
 
 sub sqlt_type { 'SQLServer' }
 
-sub _sql_maker_opts {
-  my ( $self, $opts ) = @_;
+sub _get_mssql_version {
+  my $self = shift;
+
+  my $data = $self->_get_dbh->selectrow_hashref('xp_msver ProductVersion');
+
+  if ($data->{Character_Value} =~ /^(\d+)\./) {
+    return $1;
+  } else {
+    $self->throw_exception(q{Your ProductVersion's Character_Value is missing or malformed!});
+  }
+}
+
+sub sql_maker {
+  my $self = shift;
+
+  unless ($self->_sql_maker) {
+    unless ($self->{_sql_maker_opts}{limit_dialect}) {
+      my $version = $self->_get_mssql_version;
+
+      $self->{_sql_maker_opts} = {
+        limit_dialect => ($version >= 9 ? 'RowNumberOver' : 'Top'),
+        %{$self->{_sql_maker_opts}||{}}
+      };
+    }
 
-  if ( $opts ) {
-    $self->{_sql_maker_opts} = { %$opts };
+    my $maker = $self->next::method (@_);
   }
 
-  return { limit_dialect => 'Top', %{$self->{_sql_maker_opts}||{}} };
+  return $self->_sql_maker;
 }
 
 1;
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 d0a0133..1b51b57 100644
--- a/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm
+++ b/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm
@@ -175,6 +175,14 @@ sub connect_call_use_MARS {
   }
 }
 
+sub _get_mssql_version {
+  my $self = shift;
+
+  my ($version) = $self->_get_dbh->get_info(18) =~ /^(\d+)/;
+
+  return $version;
+}
+
 1;
 
 =head1 AUTHOR
diff --git a/t/746mssql.t b/t/746mssql.t
index f120c12..e34d0f0 100644
--- a/t/746mssql.t
+++ b/t/746mssql.t
@@ -28,6 +28,11 @@ my $schema = DBICTest::Schema->connect($dsn, $user, $pass);
 
 isa_ok( $schema->storage, 'DBIx::Class::Storage::DBI::ODBC::Microsoft_SQL_Server' );
 
+{
+  my $schema2 = $schema->connect ($schema->storage->connect_info);
+  ok (! $schema2->storage->connected, 'a re-connected cloned schema starts unconnected');
+}
+
 $schema->storage->dbh_do (sub {
     my ($storage, $dbh) = @_;
     eval { $dbh->do("DROP TABLE artist") };
@@ -249,6 +254,20 @@ lives_ok ( sub {
   ]);
 }, 'populate without PKs supplied ok' );
 
+# make sure ordered subselects work
+{
+  my $book_owner_ids = $schema->resultset ('BooksInLibrary')
+                               ->search ({}, { join => 'owner', distinct => 1, order_by => { -desc => 'owner'} })
+                                ->get_column ('owner');
+
+  my $owners = $schema->resultset ('Owners')->search ({
+    id => { -in => $book_owner_ids->as_query }
+  });
+
+  is ($owners->count, 8, 'Correct amount of book owners');
+  is ($owners->all, 8, 'Correct amount of book owner objects');
+}
+
 #
 # try a prefetch on tables with identically named columns
 #
@@ -259,84 +278,88 @@ $schema->storage->_sql_maker->{name_sep} = '.';
 
 {
   # try a ->has_many direction
-  my $owners = $schema->resultset ('Owners')->search ({
-      'books.id' => { '!=', undef }
-    }, {
+  my $owners = $schema->resultset ('Owners')->search (
+    {
+      'books.id' => { '!=', undef },
+      'me.name' => { '!=', 'somebogusstring' },
+    },
+    {
       prefetch => 'books',
-      order_by => 'name',
+      order_by => { -asc => \['name + ?', [ test => 'xxx' ]] }, # test bindvar propagation
       rows     => 3,  # 8 results total
-    });
+    },
+  );
+
+  my ($sql, @bind) = @${$owners->page(3)->as_query};
+  is_deeply (
+    \@bind,
+    [ ([ 'me.name' => 'somebogusstring' ], [ test => 'xxx' ]) x 2 ],  # double because of the prefetch subq
+  );
 
   is ($owners->page(1)->all, 3, 'has_many prefetch returns correct number of rows');
   is ($owners->page(1)->count, 3, 'has-many prefetch returns correct count');
 
-  TODO: {
-    local $TODO = 'limit past end of resultset problem';
-    is ($owners->page(3)->all, 2, 'has_many prefetch returns correct number of rows');
-    is ($owners->page(3)->count, 2, 'has-many prefetch returns correct count');
-    is ($owners->page(3)->count_rs->next, 2, 'has-many prefetch returns correct count_rs');
-
-    # make sure count does not become overly complex
-    is_same_sql_bind (
-      $owners->page(3)->count_rs->as_query,
-      '(
-        SELECT COUNT( * )
-          FROM (
-            SELECT TOP 3 [me].[id]
-              FROM [owners] [me]
-              LEFT JOIN [books] [books] ON [books].[owner] = [me].[id]
-            WHERE ( [books].[id] IS NOT NULL )
-            GROUP BY [me].[id]
-            ORDER BY [me].[id] DESC
-          ) [count_subq]
-      )',
-      [],
-    );
-  }
+  is ($owners->page(3)->all, 2, 'has_many prefetch returns correct number of rows');
+  is ($owners->page(3)->count, 2, 'has-many prefetch returns correct count');
+  is ($owners->page(3)->count_rs->next, 2, 'has-many prefetch returns correct count_rs');
+
 
   # try a ->belongs_to direction (no select collapse, group_by should work)
-  my $books = $schema->resultset ('BooksInLibrary')->search ({
+  my $books = $schema->resultset ('BooksInLibrary')->search (
+    {
       'owner.name' => [qw/wiggle woggle/],
-    }, {
+    },
+    {
       distinct => 1,
+      having => \['1 = ?', [ test => 1 ] ], #test having propagation
       prefetch => 'owner',
       rows     => 2,  # 3 results total
       order_by => { -desc => 'owner' },
-      # there is no sane way to order by the right side of a grouped prefetch currently :(
-      #order_by => { -desc => 'owner.name' },
-    });
-
+    },
+  );
+
+  ($sql, @bind) = @${$books->page(3)->as_query};
+  is_deeply (
+    \@bind,
+    [
+      # inner
+      [ 'owner.name' => 'wiggle' ], [ 'owner.name' => 'woggle' ], [ source => 'Library' ], [ test => '1' ],
+      # outer
+      [ 'owner.name' => 'wiggle' ], [ 'owner.name' => 'woggle' ], [ source => 'Library' ],
+    ],
+  );
 
   is ($books->page(1)->all, 2, 'Prefetched grouped search returns correct number of rows');
   is ($books->page(1)->count, 2, 'Prefetched grouped search returns correct count');
 
-  TODO: {
-    local $TODO = 'limit past end of resultset problem';
-    is ($books->page(2)->all, 1, 'Prefetched grouped search returns correct number of rows');
-    is ($books->page(2)->count, 1, 'Prefetched grouped search returns correct count');
-    is ($books->page(2)->count_rs->next, 1, 'Prefetched grouped search returns correct count_rs');
-
-    # make sure count does not become overly complex (FIXME - the distinct-induced group_by is incorrect)
-    is_same_sql_bind (
-      $books->page(2)->count_rs->as_query,
-      '(
-        SELECT COUNT( * )
-          FROM (
-            SELECT TOP 2 [me].[id]
-              FROM [books] [me]
-              JOIN [owners] [owner] ON [owner].[id] = [me].[owner]
-            WHERE ( ( ( [owner].[name] = ? OR [owner].[name] = ? ) AND [source] = ? ) )
-            GROUP BY [me].[id], [me].[source], [me].[owner], [me].[title], [me].[price]
-            ORDER BY [me].[id] DESC
-          ) [count_subq]
-      )',
-      [
-        [ 'owner.name' => 'wiggle' ],
-        [ 'owner.name' => 'woggle' ],
-        [ 'source' => 'Library' ],
-      ],
-    );
-  }
+  is ($books->page(2)->all, 1, 'Prefetched grouped search returns correct number of rows');
+  is ($books->page(2)->count, 1, 'Prefetched grouped search returns correct count');
+  is ($books->page(2)->count_rs->next, 1, 'Prefetched grouped search returns correct count_rs');
+}
+
+# make sure right-join-side ordering limit works
+{
+  my $rs = $schema->resultset ('BooksInLibrary')->search (
+    {
+      'owner.name' => [qw/wiggle woggle/],
+    },
+    {
+      join => 'owner',
+      order_by => { -desc => 'owner.name' },
+    }
+  );
+
+  is ($rs->all, 3, 'Correct amount of objects from right-sorted joined resultset');
+  my $limited_rs = $rs->search ({}, {rows => 3, offset => 1});
+  is ($limited_rs->count, 2, 'Correct count of limited right-sorted joined resultset');
+  is ($limited_rs->count_rs->next, 2, 'Correct count_rs of limited right-sorted joined resultset');
+  is ($limited_rs->all, 2, 'Correct amount of objects from limited right-sorted joined resultset');
+
+  is_deeply (
+    [map { $_->name } ($limited_rs->search_related ('owner')->all) ],
+    [qw/woggle wiggle/],    # there is 1 woggle library book and 2 wiggle books, the limit gets us one of each
+    'Rows were properly ordered'
+  );
 }
 
 done_testing;
diff --git a/t/42toplimit.t b/t/sqlahacks/limit_dialects/toplimit.t
similarity index 100%
rename from t/42toplimit.t
rename to t/sqlahacks/limit_dialects/toplimit.t
diff --git a/t/19quotes.t b/t/sqlahacks/quotes/quotes.t
similarity index 100%
rename from t/19quotes.t
rename to t/sqlahacks/quotes/quotes.t
diff --git a/t/19quotes_newstyle.t b/t/sqlahacks/quotes/quotes_newstyle.t
similarity index 100%
rename from t/19quotes_newstyle.t
rename to t/sqlahacks/quotes/quotes_newstyle.t
diff --git a/t/95sql_maker.t b/t/sqlahacks/sql_maker/sql_maker.t
similarity index 100%
rename from t/95sql_maker.t
rename to t/sqlahacks/sql_maker/sql_maker.t
diff --git a/t/95sql_maker_quote.t b/t/sqlahacks/sql_maker/sql_maker_quote.t
similarity index 100%
rename from t/95sql_maker_quote.t
rename to t/sqlahacks/sql_maker/sql_maker_quote.t