From: Rafael Kitover Date: Mon, 28 Mar 2011 08:34:23 +0000 (-0400) Subject: make the DB2/AS400 storage a subclass of DB2, do RNO detection, fix FetchFirst X-Git-Tag: v0.08191~45 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=96eacdb705e37cca2a5a420ec92e353d0d8823b9;p=dbsrgits%2FDBIx-Class.git make the DB2/AS400 storage a subclass of DB2, do RNO detection, fix FetchFirst --- diff --git a/Changes b/Changes index 7bc45a9..afca692 100644 --- a/Changes +++ b/Changes @@ -11,6 +11,8 @@ Revision history for DBIx::Class privatize and warn on deprecated use - Massive overhaul of bind values/attributes handling - slightly changes the output of as_query (should not cause compat issues) + - Support ancient DB2 versions (5.4 and older), with proper limit + dialect * Fixes - Fix ::Storage::DBI::* MRO problems on 5.8.x perls diff --git a/lib/DBIx/Class/SQLMaker/LimitDialects.pm b/lib/DBIx/Class/SQLMaker/LimitDialects.pm index 00f7cb5..6ec33d5 100644 --- a/lib/DBIx/Class/SQLMaker/LimitDialects.pm +++ b/lib/DBIx/Class/SQLMaker/LimitDialects.pm @@ -6,78 +6,6 @@ use strict; use List::Util 'first'; use namespace::clean; -# FIXME -# This dialect has not been ported to the subquery-realiasing code -# that all other subquerying dialects are using. It is very possible -# that this dialect is entirely unnecessary - it is currently only -# used by ::Storage::DBI::ODBC::DB2_400_SQL which *should* be able to -# just subclass ::Storage::DBI::DB2 and use the already rewritten -# RowNumberOver. However nobody has access to this specific database -# engine, thus keeping legacy code as-is -# IF someone ever manages to test DB2-AS/400 with RNO, all the code -# in this block should go on to meet its maker -{ - sub _FetchFirst { - my ( $self, $sql, $order, $rows, $offset ) = @_; - - my $last = $rows + $offset; - - my ( $order_by_up, $order_by_down ) = $self->_order_directions( $order ); - - $sql = " - SELECT * FROM ( - SELECT * FROM ( - $sql - $order_by_up - FETCH FIRST $last ROWS ONLY - ) foo - $order_by_down - FETCH FIRST $rows ROWS ONLY - ) bar - $order_by_up - "; - - return $sql; - } - - sub _order_directions { - my ( $self, $order ) = @_; - - return unless $order; - - my $ref = ref $order; - - my @order; - - CASE: { - @order = @$order, last CASE if $ref eq 'ARRAY'; - @order = ( $order ), last CASE unless $ref; - @order = ( $$order ), last CASE if $ref eq 'SCALAR'; - $self->throw_exception(__PACKAGE__ . ": Unsupported data struct $ref for ORDER BY"); - } - - my ( $order_by_up, $order_by_down ); - - foreach my $spec ( @order ) - { - my @spec = split ' ', $spec; - $self->throw_exception("bad column order spec: $spec") if @spec > 2; - push( @spec, 'ASC' ) unless @spec == 2; - my ( $col, $up ) = @spec; # or maybe down - $up = uc( $up ); - $self->throw_exception("bad direction: $up") unless $up =~ /^(?:ASC|DESC)$/; - $order_by_up .= ", $col $up"; - my $down = $up eq 'ASC' ? 'DESC' : 'ASC'; - $order_by_down .= ", $col $down"; - } - - s/^,/ORDER BY/ for ( $order_by_up, $order_by_down ); - - return $order_by_up, $order_by_down; - } -} -### end-of-FIXME - =head1 NAME DBIx::Class::SQLMaker::LimitDialects - SQL::Abstract::Limit-like functionality for DBIx::Class::SQLMaker @@ -308,41 +236,26 @@ EOS return $sql; } -=head2 Top - - SELECT * FROM - - SELECT TOP $limit FROM ( - SELECT TOP $limit FROM ( - SELECT TOP ($limit+$offset) ... - ) ORDER BY $reversed_original_order - ) ORDER BY $original_order - -Unreliable Top-based implementation, supported by B<< MSSQL < 2005 >>. - -=head3 CAVEAT - -Due to its implementation, this limit dialect returns B -when $limit+$offset > total amount of rows in the resultset. - -=cut -sub _Top { - my ( $self, $sql, $rs_attrs, $rows, $offset ) = @_; +# used by _Top and _FetchFirst +sub _prep_for_skimming_limit { + my ( $self, $sql, $rs_attrs ) = @_; # mangle the input sql as we will be replacing the selector $sql =~ s/^ \s* SELECT \s+ .+? \s+ (?= \b FROM \b )//ix or $self->throw_exception("Unrecognizable SELECT: $sql"); + my %r = ( inner_sql => $sql ); + # get selectors - my ($in_sel, $out_sel, $alias_map, $extra_order_sel) + my ($alias_map, $extra_order_sel); + ($r{in_sel}, $r{out_sel}, $alias_map, $extra_order_sel) = $self->_subqueried_limit_attrs ($rs_attrs); my $requested_order = delete $rs_attrs->{order_by}; - - my $order_by_requested = $self->_order_by ($requested_order); + $r{order_by_requested} = $self->_order_by ($requested_order); # make up an order unless supplied - my $inner_order = ($order_by_requested + my $inner_order = ($r{order_by_requested} ? $requested_order : [ map { "$rs_attrs->{alias}.$_" } @@ -350,12 +263,10 @@ sub _Top { ] ); - my ($order_by_inner, $order_by_reversed); - # localise as we already have all the bind values we need { local $self->{order_bind}; - $order_by_inner = $self->_order_by ($inner_order); + $r{order_by_inner} = $self->_order_by ($inner_order); my @out_chunks; for my $ch ($self->_order_by_chunks ($inner_order)) { @@ -367,22 +278,22 @@ sub _Top { push @out_chunks, \join (' ', $ch, $dir eq 'ASC' ? 'DESC' : 'ASC' ); } - $order_by_reversed = $self->_order_by (\@out_chunks); + $r{order_by_reversed} = $self->_order_by (\@out_chunks); } # this is the order supplement magic - my $mid_sel = $out_sel; + $r{mid_sel} = $r{out_sel}; if ($extra_order_sel) { for my $extra_col (sort { $extra_order_sel->{$a} cmp $extra_order_sel->{$b} } keys %$extra_order_sel ) { - $in_sel .= sprintf (', %s AS %s', + $r{in_sel} .= sprintf (', %s AS %s', $extra_col, $extra_order_sel->{$extra_col}, ); - $mid_sel .= ', ' . $extra_order_sel->{$extra_col}; + $r{mid_sel} .= ', ' . $extra_order_sel->{$extra_col}; } # since whatever order bindvals there are, they will be realiased @@ -397,38 +308,119 @@ sub _Top { for my $col (keys %$map) { my $re_col = quotemeta ($col); $_ =~ s/$re_col/$map->{$col}/ - for ($order_by_reversed, $order_by_requested); + for ($r{order_by_reversed}, $r{order_by_requested}); } } # generate the rest of the sql - my $grpby_having = $self->_parse_rs_attrs ($rs_attrs); + $r{grpby_having} = $self->_parse_rs_attrs ($rs_attrs); - my $quoted_rs_alias = $self->_quote ($rs_attrs->{alias}); + $r{quoted_rs_alias} = $self->_quote ($rs_attrs->{alias}); + + \%r; +} + +=head2 Top + + SELECT * FROM + + SELECT TOP $limit FROM ( + SELECT TOP $limit FROM ( + SELECT TOP ($limit+$offset) ... + ) ORDER BY $reversed_original_order + ) ORDER BY $original_order + +Unreliable Top-based implementation, supported by B<< MSSQL < 2005 >>. + +=head3 CAVEAT + +Due to its implementation, this limit dialect returns B +when $limit+$offset > total amount of rows in the resultset. + +=cut + +sub _Top { + my ( $self, $sql, $rs_attrs, $rows, $offset ) = @_; + + my %l = %{ $self->_prep_for_skimming_limit($sql, $rs_attrs) }; $sql = sprintf ('SELECT TOP %u %s %s %s %s', $rows + ($offset||0), - $in_sel, - $sql, - $grpby_having, - $order_by_inner, + $l{in_sel}, + $l{inner_sql}, + $l{grpby_having}, + $l{order_by_inner}, ); $sql = sprintf ('SELECT TOP %u %s FROM ( %s ) %s %s', $rows, - $mid_sel, + $l{mid_sel}, $sql, - $quoted_rs_alias, - $order_by_reversed, + $l{quoted_rs_alias}, + $l{order_by_reversed}, ) if $offset; $sql = sprintf ('SELECT TOP %u %s FROM ( %s ) %s %s', $rows, - $out_sel, + $l{out_sel}, + $sql, + $l{quoted_rs_alias}, + $l{order_by_requested}, + ) if ( ($offset && $l{order_by_requested}) || ($l{mid_sel} ne $l{out_sel}) ); + + return $sql; +} + +=head2 FetchFirst + + SELECT * FROM + ( + SELECT * FROM ( + SELECT * FROM ( + SELECT * FROM ... + ) ORDER BY $reversed_original_order + FETCH FIRST $limit ROWS ONLY + ) ORDER BY $original_order + FETCH FIRST $limit ROWS ONLY + ) + +Unreliable FetchFirst-based implementation, supported by B<< IBM DB2 <= V5R3 >>. + +=head3 CAVEAT + +Due to its implementation, this limit dialect returns B +when $limit+$offset > total amount of rows in the resultset. + +=cut + +sub _FetchFirst { + my ( $self, $sql, $rs_attrs, $rows, $offset ) = @_; + + my %l = %{ $self->_prep_for_skimming_limit($sql, $rs_attrs) }; + + $sql = sprintf ('SELECT %s %s %s %s FETCH FIRST %u ROWS ONLY', + $l{in_sel}, + $l{inner_sql}, + $l{grpby_having}, + $l{order_by_inner}, + $rows + ($offset||0), + ); + + $sql = sprintf ('SELECT %s FROM ( %s ) %s %s FETCH FIRST %u ROWS ONLY', + $l{mid_sel}, + $sql, + $l{quoted_rs_alias}, + $l{order_by_reversed}, + $rows, + ) if $offset; + + $sql = sprintf ('SELECT %s FROM ( %s ) %s %s FETCH FIRST %u ROWS ONLY', + $l{out_sel}, $sql, - $quoted_rs_alias, - $order_by_requested, - ) if ( ($offset && $order_by_requested) || ($mid_sel ne $out_sel) ); + $l{quoted_rs_alias}, + $l{order_by_requested}, + $rows, + ) if ( ($offset && $l{order_by_requested}) || ($l{mid_sel} ne $l{out_sel}) ); return $sql; } @@ -445,6 +437,7 @@ If no $offset is supplied the limit is simply performed as: Otherwise we fall back to L =cut + sub _RowCountOrGenericSubQ { my $self = shift; my ($sql, $rs_attrs, $rows, $offset) = @_; diff --git a/lib/DBIx/Class/Storage/DBI/DB2.pm b/lib/DBIx/Class/Storage/DBI/DB2.pm index 31b9230..aea773f 100644 --- a/lib/DBIx/Class/Storage/DBI/DB2.pm +++ b/lib/DBIx/Class/Storage/DBI/DB2.pm @@ -5,45 +5,81 @@ use warnings; use base qw/DBIx::Class::Storage::DBI/; use mro 'c3'; +use Try::Tiny; +use namespace::clean; -__PACKAGE__->sql_limit_dialect ('RowNumberOver'); -__PACKAGE__->sql_quote_char ('"'); __PACKAGE__->datetime_parser_type('DateTime::Format::DB2'); +__PACKAGE__->sql_quote_char ('"'); -sub _dbh_last_insert_id { - my ($self, $dbh, $source, $col) = @_; +# lazy-default kind of thing +sub sql_name_sep { + my $self = shift; - my $sth = $dbh->prepare_cached('VALUES(IDENTITY_VAL_LOCAL())', {}, 3); - $sth->execute(); + my $v = $self->next::method(@_); - my @res = $sth->fetchrow_array(); + if (! defined $v and ! @_) { + $v = $self->next::method($self->_dbh_get_info(41) || '.'); + } - return @res ? $res[0] : undef; + return $v; } +sub sql_limit_dialect { + my $self = shift; -1; + my $v = $self->next::method(@_); -=head1 NAME + if (! defined $v and ! @_) { + $v = $self->next::method( + ($self->_server_info->{normalized_dbms_version}||0) >= 5.004 + ? 'RowNumberOver' + : 'FetchFirst' + ); + } + + return $v; +} + +sub _dbh_last_insert_id { + my ($self, $dbh, $source, $col) = @_; + + my $name_sep = $self->sql_name_sep; + + my $sth = $dbh->prepare_cached( + # An older equivalent of 'VALUES(IDENTITY_VAL_LOCAL())', for compat + # with ancient DB2 versions. Should work on modern DB2's as well: + # http://publib.boulder.ibm.com/infocenter/db2luw/v8/topic/com.ibm.db2.udb.doc/admin/r0002369.htm?resultof=%22%73%79%73%64%75%6d%6d%79%31%22%20 + "SELECT IDENTITY_VAL_LOCAL() FROM sysibm${name_sep}sysdummy1", + {}, + 3 + ); + $sth->execute(); + + my @res = $sth->fetchrow_array(); -DBIx::Class::Storage::DBI::DB2 - Automatic primary key class for DB2 + return @res ? $res[0] : undef; +} + +1; -=head1 SYNOPSIS +=head1 NAME - # In your table classes - use base 'DBIx::Class::Core'; - __PACKAGE__->set_primary_key('id'); +DBIx::Class::Storage::DBI::DB2 - IBM DB2 support for DBIx::Class =head1 DESCRIPTION -This class implements autoincrements for DB2. +This class implements autoincrements for DB2, sets the limit dialect to +RowNumberOver over FetchFirst depending on the availability of support for +RowNumberOver, queries the server name_sep from L and sets the L +parser to L. -=head1 AUTHORS +=head1 AUTHOR -Jess Robinson +See L and L. =head1 LICENSE You may distribute this code under the same terms as Perl itself. =cut +# vim:sts=2 sw=2: diff --git a/lib/DBIx/Class/Storage/DBI/ODBC/DB2_400_SQL.pm b/lib/DBIx/Class/Storage/DBI/ODBC/DB2_400_SQL.pm index 10cfcc0..8888a8e 100644 --- a/lib/DBIx/Class/Storage/DBI/ODBC/DB2_400_SQL.pm +++ b/lib/DBIx/Class/Storage/DBI/ODBC/DB2_400_SQL.pm @@ -1,56 +1,14 @@ package DBIx::Class::Storage::DBI::ODBC::DB2_400_SQL; + use strict; use warnings; -use base qw/DBIx::Class::Storage::DBI::ODBC/; +use base qw/ + DBIx::Class::Storage::DBI::DB2 + DBIx::Class::Storage::DBI::ODBC +/; use mro 'c3'; -warn 'Major advances took place in the DBIC codebase since this driver' - .' (::Storage::DBI::ODBC::DB2_400_SQL) was written. However since the' - .' RDBMS in question is so rare it is not possible for us to test any' - .' of the "new hottness". If you are using DB2 on AS-400 please get' - .' in contact with the developer team:' - .' http://search.cpan.org/dist/DBIx-Class/lib/DBIx/Class.pm#GETTING_HELP/SUPPORT' - ."\n" -; - -__PACKAGE__->sql_quote_char('"'); - -# FIXME -# Most likely all of this code is redundant and unnecessary. We should -# be able to simply use base qw/DBIx::Class::Storage::DBI::DB2/; -# Unfortunately nobody has an RDBMS engine to test with, so keeping -# things as-is for the time being - -sub _dbh_last_insert_id { - my ($self, $dbh, $source, $col) = @_; - - # get the schema/table separator: - # '.' when SQL naming is active - # '/' when system naming is active - my $sep = $self->_dbh_get_info(41); - my $sth = $dbh->prepare_cached( - "SELECT IDENTITY_VAL_LOCAL() FROM SYSIBM${sep}SYSDUMMY1", {}, 3); - $sth->execute(); - - my @res = $sth->fetchrow_array(); - - return @res ? $res[0] : undef; -} - -sub _sql_maker_opts { - my ($self) = @_; - - $self->dbh_do(sub { - my ($self, $dbh) = @_; - - return { - limit_dialect => 'FetchFirst', - name_sep => $self->_dbh_get_info(41) - }; - }); -} - 1; =head1 NAME @@ -58,28 +16,17 @@ sub _sql_maker_opts { DBIx::Class::Storage::DBI::ODBC::DB2_400_SQL - Support specific to DB2/400 over ODBC -=head1 SYNOPSIS - - # In your result (table) classes - use base 'DBIx::Class::Core'; - __PACKAGE__->set_primary_key('id'); - - =head1 DESCRIPTION -This class implements support specific to DB2/400 over ODBC, including -auto-increment primary keys, SQL::Abstract::Limit dialect, and name separator -for connections using either SQL naming or System naming. - - -=head1 AUTHORS +This is an empty subclass of L. -Marc Mims C<< >> +=head1 AUTHOR -Based on DBIx::Class::Storage::DBI::DB2 by Jess Robinson. +See L and L. =head1 LICENSE You may distribute this code under the same terms as Perl itself. =cut +# vim:sts=2 sw=2: diff --git a/t/745db2.t b/t/745db2.t index c323529..0299816 100644 --- a/t/745db2.t +++ b/t/745db2.t @@ -3,6 +3,7 @@ use warnings; use Test::More; use Test::Exception; +use Try::Tiny; use lib qw(t/lib); use DBICTest; @@ -17,6 +18,23 @@ my $schema = DBICTest::Schema->connect($dsn, $user, $pass); my $dbh = $schema->storage->dbh; +# test RNO and name_sep detection +my $name_sep = $dbh->get_info(41); + +is $schema->storage->sql_maker->name_sep, $name_sep, + 'name_sep detection'; + +my $have_rno = try { + $dbh->selectrow_array( +"SELECT row_number() OVER (ORDER BY 1) FROM sysibm${name_sep}sysdummy1" + ); + 1; +}; + +is $schema->storage->sql_maker->limit_dialect, + ($have_rno ? 'RowNumberOver' : 'FetchFirst'), + 'limit_dialect detection'; + eval { $dbh->do("DROP TABLE artist") }; $dbh->do("CREATE TABLE artist (artistid INTEGER GENERATED BY DEFAULT AS IDENTITY (START WITH 1, INCREMENT BY 1), name VARCHAR(255), charfield CHAR(10), rank INTEGER DEFAULT 13);"); @@ -85,6 +103,25 @@ is( $lim->next->artistid, 101, "iterator->next ok" ); is( $lim->next->artistid, 102, "iterator->next ok" ); is( $lim->next, undef, "next past end of resultset ok" ); +# test FetchFirst limit dialect syntax +{ + local $schema->storage->sql_maker->{limit_dialect} = 'FetchFirst'; + + my $lim = $ars->search({}, { + rows => 3, + offset => 2, + order_by => 'artistid', + }); + + is $lim->count, 3, 'fetch first limit count ok'; + + is $lim->all, 3, 'fetch first number of ->all objects matches count'; + + is $lim->next->artistid, 3, 'iterator->next ok'; + is $lim->next->artistid, 66, 'iterator->next ok'; + is $lim->next->artistid, 101, 'iterator->next ok'; + is $lim->next, undef, 'iterator->next past end of resultset ok'; +} my $test_type_info = { 'artistid' => { diff --git a/t/sqlmaker/limit_dialects/fetch_first.t b/t/sqlmaker/limit_dialects/fetch_first.t new file mode 100644 index 0000000..f084782 --- /dev/null +++ b/t/sqlmaker/limit_dialects/fetch_first.t @@ -0,0 +1,218 @@ +use strict; +use warnings; + +use Test::More; +use lib qw(t/lib); +use DBICTest; +use DBIC::SqlMakerTest; + +my $schema = DBICTest->init_schema; + +# based on toplimit.t +delete $schema->storage->_sql_maker->{_cached_syntax}; +$schema->storage->_sql_maker->limit_dialect ('FetchFirst'); + +my $books_45_and_owners = $schema->resultset ('BooksInLibrary')->search ({}, { prefetch => 'owner', rows => 2, offset => 3 }); + +for my $null_order ( + undef, + '', + {}, + [], + [{}], +) { + my $rs = $books_45_and_owners->search ({}, {order_by => $null_order }); + is_same_sql_bind( + $rs->as_query, + '(SELECT id, source, owner, title, price, owner__id, owner__name + FROM ( + SELECT me.id, me.source, me.owner, me.title, me.price, owner.id AS owner__id, owner.name AS owner__name + FROM books me + JOIN owners owner ON owner.id = me.owner + WHERE ( source = ? ) + ORDER BY me.id + FETCH FIRST 5 ROWS ONLY + ) me + ORDER BY me.id DESC + FETCH FIRST 2 ROWS ONLY + )', + [ [ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'source' } + => 'Library' ] ], + ); +} + + +for my $ord_set ( + { + order_by => \'foo DESC', + order_inner => 'foo DESC', + order_outer => 'ORDER__BY__1 ASC', + order_req => 'ORDER__BY__1 DESC', + exselect_outer => 'ORDER__BY__1', + exselect_inner => 'foo AS ORDER__BY__1', + }, + { + order_by => { -asc => 'foo' }, + order_inner => 'foo ASC', + order_outer => 'ORDER__BY__1 DESC', + order_req => 'ORDER__BY__1 ASC', + exselect_outer => 'ORDER__BY__1', + exselect_inner => 'foo AS ORDER__BY__1', + }, + { + order_by => { -desc => 'foo' }, + order_inner => 'foo DESC', + order_outer => 'ORDER__BY__1 ASC', + order_req => 'ORDER__BY__1 DESC', + exselect_outer => 'ORDER__BY__1', + exselect_inner => 'foo AS ORDER__BY__1', + }, + { + order_by => 'foo', + order_inner => 'foo', + order_outer => 'ORDER__BY__1 DESC', + order_req => 'ORDER__BY__1', + exselect_outer => 'ORDER__BY__1', + exselect_inner => 'foo AS ORDER__BY__1', + }, + { + order_by => [ qw{ foo me.owner} ], + order_inner => 'foo, me.owner', + order_outer => 'ORDER__BY__1 DESC, me.owner DESC', + order_req => 'ORDER__BY__1, me.owner', + exselect_outer => 'ORDER__BY__1', + exselect_inner => 'foo AS ORDER__BY__1', + }, + { + order_by => ['foo', { -desc => 'bar' } ], + order_inner => 'foo, bar DESC', + order_outer => 'ORDER__BY__1 DESC, ORDER__BY__2 ASC', + order_req => 'ORDER__BY__1, ORDER__BY__2 DESC', + exselect_outer => 'ORDER__BY__1, ORDER__BY__2', + exselect_inner => 'foo AS ORDER__BY__1, bar AS ORDER__BY__2', + }, + { + order_by => { -asc => [qw{ foo bar }] }, + order_inner => 'foo ASC, bar ASC', + order_outer => 'ORDER__BY__1 DESC, ORDER__BY__2 DESC', + order_req => 'ORDER__BY__1 ASC, ORDER__BY__2 ASC', + exselect_outer => 'ORDER__BY__1, ORDER__BY__2', + exselect_inner => 'foo AS ORDER__BY__1, bar AS ORDER__BY__2', + }, + { + order_by => [ + 'foo', + { -desc => [qw{bar}] }, + { -asc => [qw{me.owner sensors}]}, + ], + order_inner => 'foo, bar DESC, me.owner ASC, sensors ASC', + order_outer => 'ORDER__BY__1 DESC, ORDER__BY__2 ASC, me.owner DESC, ORDER__BY__3 DESC', + order_req => 'ORDER__BY__1, ORDER__BY__2 DESC, me.owner ASC, ORDER__BY__3 ASC', + exselect_outer => 'ORDER__BY__1, ORDER__BY__2, ORDER__BY__3', + exselect_inner => 'foo AS ORDER__BY__1, bar AS ORDER__BY__2, sensors AS ORDER__BY__3', + }, +) { + my $o_sel = $ord_set->{exselect_outer} + ? ', ' . $ord_set->{exselect_outer} + : '' + ; + my $i_sel = $ord_set->{exselect_inner} + ? ', ' . $ord_set->{exselect_inner} + : '' + ; + + is_same_sql_bind( + $books_45_and_owners->search ({}, {order_by => $ord_set->{order_by}})->as_query, + "(SELECT id, source, owner, title, price, owner__id, owner__name + FROM ( + SELECT id, source, owner, title, price, owner__id, owner__name$o_sel + FROM ( + SELECT me.id, me.source, me.owner, me.title, me.price, owner.id AS owner__id, owner.name AS owner__name$i_sel + FROM books me + JOIN owners owner ON owner.id = me.owner + WHERE ( source = ? ) + ORDER BY $ord_set->{order_inner} + FETCH FIRST 5 ROWS ONLY + ) me + ORDER BY $ord_set->{order_outer} + FETCH FIRST 2 ROWS ONLY + ) me + ORDER BY $ord_set->{order_req} + FETCH FIRST 2 ROWS ONLY + )", + [ [ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'source' } + => 'Library' ] ], + ); +} + +# with groupby +is_same_sql_bind ( + $books_45_and_owners->search ({}, { group_by => 'title', order_by => 'title' })->as_query, + '(SELECT me.id, me.source, me.owner, me.title, me.price, owner.id, owner.name + FROM ( + SELECT id, source, owner, title, price + FROM ( + SELECT id, source, owner, title, price + FROM ( + SELECT me.id, me.source, me.owner, me.title, me.price + FROM books me + JOIN owners owner ON owner.id = me.owner + WHERE ( source = ? ) + GROUP BY title + ORDER BY title + FETCH FIRST 5 ROWS ONLY + ) me + ORDER BY title DESC + FETCH FIRST 2 ROWS ONLY + ) me + ORDER BY title + FETCH FIRST 2 ROWS ONLY + ) me + JOIN owners owner ON owner.id = me.owner + WHERE ( source = ? ) + ORDER BY title + )', + [ map { [ + { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'source' } + => 'Library' ] + } (1,2) ], +); + +# test deprecated column mixing over join boundaries +my $rs_selectas_top = $schema->resultset ('BooksInLibrary')->search ({}, { + '+select' => ['owner.name'], + '+as' => ['owner_name'], + join => 'owner', + rows => 1 +}); + +is_same_sql_bind( $rs_selectas_top->search({})->as_query, + '(SELECT + me.id, me.source, me.owner, me.title, me.price, + owner.name AS owner_name + FROM books me + JOIN owners owner ON owner.id = me.owner + WHERE ( source = ? ) + ORDER BY me.id + FETCH FIRST 1 ROWS ONLY + )', + [ [ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'source' } + => 'Library' ] ], + ); + +{ + my $rs = $schema->resultset('Artist')->search({}, { + columns => 'name', + offset => 1, + order_by => 'name', + }); + local $rs->result_source->{name} = "weird \n newline/multi \t \t space containing \n table"; + + like ( + ${$rs->as_query}->[0], + qr| weird \s \n \s newline/multi \s \t \s \t \s space \s containing \s \n \s table|x, + 'Newlines/spaces preserved in final sql', + ); +} + +done_testing;