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
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
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<incorrect results>
-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}.$_" }
]
);
- 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)) {
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
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<incorrect results>
+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<incorrect results>
+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;
}
Otherwise we fall back to L</GenericSubQ>
=cut
+
sub _RowCountOrGenericSubQ {
my $self = shift;
my ($sql, $rs_attrs, $rows, $offset) = @_;
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<DBI> and sets the L<DateTime>
+parser to L<DateTime::Format::DB2>.
-=head1 AUTHORS
+=head1 AUTHOR
-Jess Robinson
+See L<DBIx::Class/AUTHOR> and L<DBIx::Class/CONTRIBUTORS>.
=head1 LICENSE
You may distribute this code under the same terms as Perl itself.
=cut
+# vim:sts=2 sw=2:
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
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<DBIx::Class::Storage::DBI::DB2>.
-Marc Mims C<< <marc@questright.com> >>
+=head1 AUTHOR
-Based on DBIx::Class::Storage::DBI::DB2 by Jess Robinson.
+See L<DBIx::Class/AUTHOR> and L<DBIx::Class/CONTRIBUTORS>.
=head1 LICENSE
You may distribute this code under the same terms as Perl itself.
=cut
+# vim:sts=2 sw=2:
use Test::More;
use Test::Exception;
+use Try::Tiny;
use lib qw(t/lib);
use DBICTest;
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);");
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' => {
--- /dev/null
+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;
projects / dbsrgits/DBIx-Class.git / commitdiff