- Bumped minimum Module::Install for developers
- Bumped DBD::SQLite dependency and removed some TODO markers
from tests
+ - No longer depend on SQL::Abstract::Limit - DBIC has been doing
+ most of the heavy lifting for a while anyway
0.08123 2010-06-12 14:46 (UTC)
* Fixes
'Module::Find' => '0.06',
'Path::Class' => '0.18',
'SQL::Abstract' => '1.67',
- 'SQL::Abstract::Limit' => '0.13',
'Sub::Name' => '0.04',
'Data::Dumper::Concise' => '1.000',
'Scope::Guard' => '0.03',
# Deprecated/internal modules need no exposure
no_index directory => $_ for (qw|
lib/DBIx/Class/Admin
- lib/DBIx/Class/SQLAHacks
lib/DBIx/Class/PK/Auto
lib/DBIx/Class/CDBICompat
|);
no_index package => $_ for (qw/
- DBIx::Class::SQLAHacks DBIx::Class::Storage::DBIHacks
+ DBIx::Class::Storage::DBIHacks
/);
-
WriteAll();
# Re-write META.yml to _exclude_ all forced requires (we do not want to ship this)
return $rv;
}
-=head2 Setting limit dialect for SQL::Abstract::Limit
-
-In some cases, SQL::Abstract::Limit cannot determine the dialect of
-the remote SQL server by looking at the database handle. This is a
-common problem when using the DBD::JDBC, since the DBD-driver only
-know that in has a Java-driver available, not which JDBC driver the
-Java component has loaded. This specifically sets the limit_dialect
-to Microsoft SQL-server (See more names in SQL::Abstract::Limit
--documentation.
-
- __PACKAGE__->storage->sql_maker->limit_dialect('mssql');
-
-The JDBC bridge is one way of getting access to a MSSQL server from a platform
-that Microsoft doesn't deliver native client libraries for. (e.g. Linux)
-
-The limit dialect can also be set at connect time by specifying a
-C<limit_dialect> key in the final hash as shown above.
-
=head2 Working with PostgreSQL array types
You can also assign values to PostgreSQL array columns by passing array
--- /dev/null
+package DBIx::Class::SQLMaker;
+
+=head1 NAME
+
+DBIx::Class::SQLMaker - An SQL::Abstract-based SQL maker class
+
+=head1 DESCRIPTION
+
+This module is a subclass of L<SQL::Abstract> and includes a number of
+DBIC-specific workarounds, not yet suitable for inclusion into the
+L<SQL::Abstract> core. It also provides all (and more than) the functionality
+of L<SQL::Abstract::Limit>, see L<DBIx::Class::SQLMaker::LimitDialects> for
+more info.
+
+Currently the enhancements to L<SQL::Abstract> are:
+
+=over
+
+=item * Support for C<JOIN> statements (via extended C<table/from> support)
+
+=item * Support of functions in C<SELECT> lists
+
+=item * C<GROUP BY>/C<HAVING> support (via extensions to the order_by parameter)
+
+=item * Support of C<...FOR UPDATE> type of select statement modifiers
+
+=back
+
+=cut
+
+use base qw/
+ DBIx::Class::SQLMaker::LimitDialects
+ SQL::Abstract
+ Class::Accessor::Grouped
+/;
+use mro 'c3';
+use strict;
+use warnings;
+use Sub::Name 'subname';
+use Carp::Clan qw/^DBIx::Class|^SQL::Abstract|^Try::Tiny/;
+use namespace::clean;
+
+__PACKAGE__->mk_group_accessors (simple => qw/quote_char name_sep limit_dialect/);
+
+BEGIN {
+ # reinstall the carp()/croak() functions imported into SQL::Abstract
+ # as Carp and Carp::Clan do not like each other much
+ no warnings qw/redefine/;
+ no strict qw/refs/;
+ for my $f (qw/carp croak/) {
+
+ my $orig = \&{"SQL::Abstract::$f"};
+ my $clan_import = \&{$f};
+ *{"SQL::Abstract::$f"} = subname "SQL::Abstract::$f" =>
+ sub {
+ if (Carp::longmess() =~ /DBIx::Class::SQLMaker::[\w]+ .+? called \s at/x) {
+ $clan_import->(@_);
+ }
+ else {
+ goto $orig;
+ }
+ };
+ }
+}
+
+# the "oh noes offset/top without limit" constant
+# limited to 32 bits for sanity (and consistency,
+# since it is ultimately handed to sprintf %u)
+# Implemented as a method, since ::Storage::DBI also
+# refers to it (i.e. for the case of software_limit or
+# as the value to abuse with MSSQL ordered subqueries)
+sub __max_int { 0xFFFFFFFF };
+
+# Handle limit-dialect selection
+sub select {
+ my ($self, $table, $fields, $where, $rs_attrs, $limit, $offset) = @_;
+
+
+ $fields = $self->_recurse_fields($fields);
+
+ if (defined $offset) {
+ croak ('A supplied offset must be a non-negative integer')
+ if ( $offset =~ /\D/ or $offset < 0 );
+ }
+ $offset ||= 0;
+
+ if (defined $limit) {
+ croak ('A supplied limit must be a positive integer')
+ if ( $limit =~ /\D/ or $limit <= 0 );
+ }
+ elsif ($offset) {
+ $limit = $self->__max_int;
+ }
+
+
+ my ($sql, @bind);
+ if ($limit) {
+ # this is legacy code-flow from SQLA::Limit, it is not set in stone
+
+ ($sql, @bind) = $self->next::method ($table, $fields, $where);
+
+ my $limiter =
+ $self->can ('emulate_limit') # also backcompat hook from SQLA::Limit
+ ||
+ do {
+ my $dialect = $self->limit_dialect
+ or croak "Unable to generate SQL-limit - no limit dialect specified on $self, and no emulate_limit method found";
+ $self->can ("_$dialect")
+ or croak (__PACKAGE__ . " does not implement the requested dialect '$dialect'");
+ }
+ ;
+
+ $sql = $self->$limiter ($sql, $rs_attrs, $limit, $offset);
+ }
+ else {
+ ($sql, @bind) = $self->next::method ($table, $fields, $where, $rs_attrs);
+ }
+
+ push @{$self->{where_bind}}, @bind;
+
+# this *must* be called, otherwise extra binds will remain in the sql-maker
+ my @all_bind = $self->_assemble_binds;
+
+ return wantarray ? ($sql, @all_bind) : $sql;
+}
+
+sub _assemble_binds {
+ my $self = shift;
+ return map { @{ (delete $self->{"${_}_bind"}) || [] } } (qw/from where having order/);
+}
+
+# Handle default inserts
+sub insert {
+# optimized due to hotttnesss
+# my ($self, $table, $data, $options) = @_;
+
+ # SQLA will emit INSERT INTO $table ( ) VALUES ( )
+ # which is sadly understood only by MySQL. Change default behavior here,
+ # until SQLA2 comes with proper dialect support
+ if (! $_[2] or (ref $_[2] eq 'HASH' and !keys %{$_[2]} ) ) {
+ my $sql = "INSERT INTO $_[1] DEFAULT VALUES";
+
+ if (my $ret = ($_[3]||{})->{returning} ) {
+ $sql .= $_[0]->_insert_returning ($ret);
+ }
+
+ return $sql;
+ }
+
+ next::method(@_);
+}
+
+sub _recurse_fields {
+ my ($self, $fields) = @_;
+ my $ref = ref $fields;
+ return $self->_quote($fields) unless $ref;
+ return $$fields if $ref eq 'SCALAR';
+
+ if ($ref eq 'ARRAY') {
+ return join(', ', map { $self->_recurse_fields($_) } @$fields);
+ }
+ elsif ($ref eq 'HASH') {
+ my %hash = %$fields; # shallow copy
+
+ my $as = delete $hash{-as}; # if supplied
+
+ my ($func, $args, @toomany) = %hash;
+
+ # there should be only one pair
+ if (@toomany) {
+ croak "Malformed select argument - too many keys in hash: " . join (',', keys %$fields );
+ }
+
+ if (lc ($func) eq 'distinct' && ref $args eq 'ARRAY' && @$args > 1) {
+ croak (
+ 'The select => { distinct => ... } syntax is not supported for multiple columns.'
+ .' Instead please use { group_by => [ qw/' . (join ' ', @$args) . '/ ] }'
+ .' or { select => [ qw/' . (join ' ', @$args) . '/ ], distinct => 1 }'
+ );
+ }
+
+ my $select = sprintf ('%s( %s )%s',
+ $self->_sqlcase($func),
+ $self->_recurse_fields($args),
+ $as
+ ? sprintf (' %s %s', $self->_sqlcase('as'), $self->_quote ($as) )
+ : ''
+ );
+
+ return $select;
+ }
+ # Is the second check absolutely necessary?
+ elsif ( $ref eq 'REF' and ref($$fields) eq 'ARRAY' ) {
+ return $self->_fold_sqlbind( $fields );
+ }
+ else {
+ croak($ref . qq{ unexpected in _recurse_fields()})
+ }
+}
+
+my $for_syntax = {
+ update => 'FOR UPDATE',
+ shared => 'FOR SHARE',
+};
+
+# this used to be a part of _order_by but is broken out for clarity.
+# What we have been doing forever is hijacking the $order arg of
+# SQLA::select to pass in arbitrary pieces of data (first the group_by,
+# then pretty much the entire resultset attr-hash, as more and more
+# things in the SQLA space need to have mopre info about the $rs they
+# create SQL for. The alternative would be to keep expanding the
+# signature of _select with more and more positional parameters, which
+# is just gross. All hail SQLA2!
+sub _parse_rs_attrs {
+ my ($self, $arg) = @_;
+
+ my $sql = '';
+
+ if (my $g = $self->_recurse_fields($arg->{group_by}) ) {
+ $sql .= $self->_sqlcase(' group by ') . $g;
+ }
+
+ if (defined $arg->{having}) {
+ my ($frag, @bind) = $self->_recurse_where($arg->{having});
+ push(@{$self->{having_bind}}, @bind);
+ $sql .= $self->_sqlcase(' having ') . $frag;
+ }
+
+ if (defined $arg->{order_by}) {
+ $sql .= $self->_order_by ($arg->{order_by});
+ }
+
+ if (my $for = $arg->{for}) {
+ $sql .= " $for_syntax->{$for}" if $for_syntax->{$for};
+ }
+
+ return $sql;
+}
+
+sub _order_by {
+ my ($self, $arg) = @_;
+
+ # check that we are not called in legacy mode (order_by as 4th argument)
+ if (ref $arg eq 'HASH' and not grep { $_ =~ /^-(?:desc|asc)/i } keys %$arg ) {
+ return $self->_parse_rs_attrs ($arg);
+ }
+ else {
+ my ($sql, @bind) = $self->next::method($arg);
+ push @{$self->{order_bind}}, @bind;
+ return $sql;
+ }
+}
+
+sub _table {
+# optimized due to hotttnesss
+# my ($self, $from) = @_;
+ if (my $ref = ref $_[1] ) {
+ if ($ref eq 'ARRAY') {
+ return $_[0]->_recurse_from(@{$_[1]});
+ }
+ elsif ($ref eq 'HASH') {
+ return $_[0]->_make_as($_[1]);
+ }
+ }
+
+ return $_[0]->next::method ($_[1]);
+}
+
+sub _generate_join_clause {
+ my ($self, $join_type) = @_;
+
+ return sprintf ('%s JOIN ',
+ $join_type ? ' ' . uc($join_type) : ''
+ );
+}
+
+sub _recurse_from {
+ my ($self, $from, @join) = @_;
+ my @sqlf;
+ push(@sqlf, $self->_make_as($from));
+ foreach my $j (@join) {
+ my ($to, $on) = @$j;
+
+
+ # check whether a join type exists
+ my $to_jt = ref($to) eq 'ARRAY' ? $to->[0] : $to;
+ my $join_type;
+ if (ref($to_jt) eq 'HASH' and defined($to_jt->{-join_type})) {
+ $join_type = $to_jt->{-join_type};
+ $join_type =~ s/^\s+ | \s+$//xg;
+ }
+
+ $join_type = $self->{_default_jointype} if not defined $join_type;
+
+ push @sqlf, $self->_generate_join_clause( $join_type );
+
+ if (ref $to eq 'ARRAY') {
+ push(@sqlf, '(', $self->_recurse_from(@$to), ')');
+ } else {
+ push(@sqlf, $self->_make_as($to));
+ }
+ push(@sqlf, ' ON ', $self->_join_condition($on));
+ }
+ return join('', @sqlf);
+}
+
+sub _fold_sqlbind {
+ my ($self, $sqlbind) = @_;
+
+ my @sqlbind = @$$sqlbind; # copy
+ my $sql = shift @sqlbind;
+ push @{$self->{from_bind}}, @sqlbind;
+
+ return $sql;
+}
+
+sub _make_as {
+ my ($self, $from) = @_;
+ return join(' ', map { (ref $_ eq 'SCALAR' ? $$_
+ : ref $_ eq 'REF' ? $self->_fold_sqlbind($_)
+ : $self->_quote($_))
+ } reverse each %{$self->_skip_options($from)});
+}
+
+sub _skip_options {
+ my ($self, $hash) = @_;
+ my $clean_hash = {};
+ $clean_hash->{$_} = $hash->{$_}
+ for grep {!/^-/} keys %$hash;
+ return $clean_hash;
+}
+
+sub _join_condition {
+ my ($self, $cond) = @_;
+ if (ref $cond eq 'HASH') {
+ my %j;
+ for (keys %$cond) {
+ my $v = $cond->{$_};
+ if (ref $v) {
+ croak (ref($v) . qq{ reference arguments are not supported in JOINS - try using \"..." instead'})
+ if ref($v) ne 'SCALAR';
+ $j{$_} = $v;
+ }
+ else {
+ my $x = '= '.$self->_quote($v); $j{$_} = \$x;
+ }
+ };
+ return scalar($self->_recurse_where(\%j));
+ } elsif (ref $cond eq 'ARRAY') {
+ return join(' OR ', map { $self->_join_condition($_) } @$cond);
+ } else {
+ croak "Can't handle this yet!";
+ }
+}
+
+1;
+
+=head1 AUTHORS
+
+See L<DBIx::Class/CONTRIBUTORS>.
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
+
+=cut
-package # Hide from PAUSE
- DBIx::Class::SQLAHacks;
+package DBIx::Class::SQLMaker::LimitDialects;
-# This module is a subclass of SQL::Abstract::Limit and includes a number
-# of DBIC-specific workarounds, not yet suitable for inclusion into the
-# SQLA core
-
-use base qw/SQL::Abstract::Limit/;
-use strict;
use warnings;
+use strict;
+
+use Carp::Clan qw/^DBIx::Class|^SQL::Abstract|^Try::Tiny/;
use List::Util 'first';
-use Sub::Name 'subname';
use namespace::clean;
-use Carp::Clan qw/^DBIx::Class|^SQL::Abstract|^Try::Tiny/;
-BEGIN {
- # reinstall the carp()/croak() functions imported into SQL::Abstract
- # as Carp and Carp::Clan do not like each other much
- no warnings qw/redefine/;
- no strict qw/refs/;
- for my $f (qw/carp croak/) {
-
- my $orig = \&{"SQL::Abstract::$f"};
- *{"SQL::Abstract::$f"} = subname "SQL::Abstract::$f" =>
- sub {
- if (Carp::longmess() =~ /DBIx::Class::SQLAHacks::[\w]+ .+? called \s at/x) {
- __PACKAGE__->can($f)->(@_);
- }
- else {
- goto $orig;
- }
- };
+# 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;
}
-}
-# the "oh noes offset/top without limit" constant
-# limited to 32 bits for sanity (and since it is fed
-# to sprintf %u)
-sub __max_int { 0xFFFFFFFF };
+ sub _order_directions {
+ my ( $self, $order ) = @_;
+ return unless $order;
-# Tries to determine limit dialect.
-#
-sub new {
- my $self = shift->SUPER::new(@_);
+ my $ref = ref $order;
- # This prevents the caching of $dbh in S::A::L, I believe
- # If limit_dialect is a ref (like a $dbh), go ahead and replace
- # it with what it resolves to:
- $self->{limit_dialect} = $self->_find_syntax($self->{limit_dialect})
- if ref $self->{limit_dialect};
+ my @order;
- $self;
+ CASE: {
+ @order = @$order, last CASE if $ref eq 'ARRAY';
+ @order = ( $order ), last CASE unless $ref;
+ @order = ( $$order ), last CASE if $ref eq 'SCALAR';
+ croak __PACKAGE__ . ": Unsupported data struct $ref for ORDER BY";
+ }
+
+ my ( $order_by_up, $order_by_down );
+
+ foreach my $spec ( @order )
+ {
+ my @spec = split ' ', $spec;
+ croak( "bad column order spec: $spec" ) if @spec > 2;
+ push( @spec, 'ASC' ) unless @spec == 2;
+ my ( $col, $up ) = @spec; # or maybe down
+ $up = uc( $up );
+ croak( "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
-# !!! THIS IS ALSO HORRIFIC !!! /me ashamed
-#
-# Generates inner/outer select lists for various limit dialects
-# which result in one or more subqueries (e.g. RNO, Top, RowNum)
-# Any non-root-table columns need to have their table qualifier
-# turned into a column alias (otherwise names in subqueries clash
-# and/or lose their source table)
-#
-# Returns inner/outer strings of SQL QUOTED selectors with aliases
-# (to be used in whatever select statement), and an alias index hashref
-# of QUOTED SEL => QUOTED ALIAS pairs (to maybe be used for string-subst
-# higher up).
-# If an order_by is supplied, the inner select needs to bring out columns
-# used in implicit (non-selected) orders, and the order condition itself
-# needs to be realiased to the proper names in the outer query. Thus we
-# also return a hashref (order doesn't matter) of QUOTED EXTRA-SEL =>
-# QUOTED ALIAS pairs, which is a list of extra selectors that do *not*
-# exist in the original select list
+=head1 NAME
-sub _subqueried_limit_attrs {
- my ($self, $rs_attrs) = @_;
+DBIx::Class::SQLMaker::LimitDialects - SQL::Abstract::Limit-like functionality for DBIx::Class::SQLMaker
- croak 'Limit dialect implementation usable only in the context of DBIC (missing $rs_attrs)'
- unless ref ($rs_attrs) eq 'HASH';
+=head1 DESCRIPTION
- my ($re_sep, $re_alias) = map { quotemeta $_ } (
- $self->name_sep || '.',
- $rs_attrs->{alias},
- );
+This module replicates a lot of the functionality originally found in
+L<SQL::Abstract::Limit>. While simple limits would work as-is, the more
+complex dialects that require e.g. subqueries could not be reliably
+implemented without taking full advantage of the metadata locked within
+L<DBIx::Class::ResultSource> classes. After reimplementation of close to
+80% of the L<SQL::Abstract::Limit> functionality it was deemed more
+practical to simply make an independent DBIx::Class-specific limit-dialect
+provider.
- # correlate select and as, build selection index
- my (@sel, $in_sel_index);
- for my $i (0 .. $#{$rs_attrs->{select}}) {
+=head1 SQL LIMIT DIALECTS
- my $s = $rs_attrs->{select}[$i];
- my $sql_sel = $self->_recurse_fields ($s);
- my $sql_alias = (ref $s) eq 'HASH' ? $s->{-as} : undef;
+Note that the actual implementations listed below never use C<*> literally.
+Instead proper re-aliasing of selectors and order criteria is done, so that
+the limit dialect are safe to use on joined resultsets with clashing column
+names.
+Currently the provided dialects are:
- push @sel, {
- sql => $sql_sel,
- unquoted_sql => do { local $self->{quote_char}; $self->_recurse_fields ($s) },
- as =>
- $sql_alias
- ||
- $rs_attrs->{as}[$i]
- ||
- croak "Select argument $i ($s) without corresponding 'as'"
- ,
- };
+=cut
- $in_sel_index->{$sql_sel}++;
- $in_sel_index->{$self->_quote ($sql_alias)}++ if $sql_alias;
+=head2 LimitOffset
- # record unqualified versions too, so we do not have
- # to reselect the same column twice (in qualified and
- # unqualified form)
- if (! ref $s && $sql_sel =~ / $re_sep (.+) $/x) {
- $in_sel_index->{$1}++;
- }
- }
+ SELECT ... LIMIT $limit OFFSET $offset
+Supported by B<PostgreSQL> and B<SQLite>
- # re-alias and remove any name separators from aliases,
- # unless we are dealing with the current source alias
- # (which will transcend the subqueries as it is necessary
- # for possible further chaining)
- my (@in_sel, @out_sel, %renamed);
- for my $node (@sel) {
- if (first { $_ =~ / (?<! ^ $re_alias ) $re_sep /x } ($node->{as}, $node->{unquoted_sql}) ) {
- $node->{as} = $self->_unqualify_colname($node->{as});
- my $quoted_as = $self->_quote($node->{as});
- push @in_sel, sprintf '%s AS %s', $node->{sql}, $quoted_as;
- push @out_sel, $quoted_as;
- $renamed{$node->{sql}} = $quoted_as;
- }
- else {
- push @in_sel, $node->{sql};
- push @out_sel, $self->_quote ($node->{as});
- }
- }
+=cut
+sub _LimitOffset {
+ my ( $self, $sql, $order, $rows, $offset ) = @_;
+ $sql .= $self->_order_by( $order ) . " LIMIT $rows";
+ $sql .= " OFFSET $offset" if +$offset;
+ return $sql;
+}
- # see if the order gives us anything
- my %extra_order_sel;
- for my $chunk ($self->_order_by_chunks ($rs_attrs->{order_by})) {
- # order with bind
- $chunk = $chunk->[0] if (ref $chunk) eq 'ARRAY';
- $chunk =~ s/\s+ (?: ASC|DESC ) \s* $//ix;
+=head2 LimitXY
- next if $in_sel_index->{$chunk};
+ SELECT ... LIMIT $offset $limit
- $extra_order_sel{$chunk} ||= $self->_quote (
- 'ORDER__BY__' . scalar keys %extra_order_sel
- );
- }
+Supported by B<MySQL> and any L<SQL::Statement> based DBD
- return (
- (map { join (', ', @$_ ) } (
- \@in_sel,
- \@out_sel)
- ),
- \%renamed,
- keys %extra_order_sel ? \%extra_order_sel : (),
- );
+=cut
+sub _LimitXY {
+ my ( $self, $sql, $order, $rows, $offset ) = @_;
+ $sql .= $self->_order_by( $order ) . " LIMIT ";
+ $sql .= "$offset, " if +$offset;
+ $sql .= $rows;
+ return $sql;
}
-sub _unqualify_colname {
- my ($self, $fqcn) = @_;
- my $re_sep = quotemeta($self->name_sep || '.');
- $fqcn =~ s/ $re_sep /__/xg;
- return $fqcn;
-}
+=head2 RowNumberOver
+
+ SELECT * FROM (
+ SELECT *, ROW_NUMBER() OVER( ORDER BY ... ) AS RNO__ROW__INDEX FROM (
+ SELECT ...
+ )
+ ) WHERE RNO__ROW__INDEX BETWEEN ($offset+1) AND ($limit+$offset)
-# ANSI standard Limit/Offset implementation. DB2 and MSSQL >= 2005 use this
+
+ANSI standard Limit/Offset implementation. Supported by B<DB2> and
+B<< MSSQL >= 2005 >>.
+
+=cut
sub _RowNumberOver {
my ($self, $sql, $rs_attrs, $rows, $offset ) = @_;
return undef;
}
-# Informix specific limit, almost like LIMIT/OFFSET
+=head2 SkipFirst
+
+ SELECT SKIP $offset FIRST $limit * FROM ...
+
+Suported by B<Informix>, almost like LimitOffset. According to
+L<SQL::Abstract::Limit> C<... SKIP $offset LIMIT $limit ...> is also supported.
+
+=cut
sub _SkipFirst {
my ($self, $sql, $rs_attrs, $rows, $offset) = @_;
);
}
-# Firebird specific limit, reverse of _SkipFirst for Informix
+=head2 FirstSkip
+
+ SELECT FIRST $limit SKIP $offset * FROM ...
+
+Supported by B<Firebird/Interbase>, reverse of SkipFirst. According to
+L<SQL::Abstract::Limit> C<... ROWS $limit TO $offset ...> is also supported.
+
+=cut
sub _FirstSkip {
my ($self, $sql, $rs_attrs, $rows, $offset) = @_;
);
}
-# WhOracle limits
+=head2 RowNum
+
+ SELECT * FROM (
+ SELECT *, ROWNUM rownum__index FROM (
+ SELECT ...
+ )
+ ) WHERE rownum__index BETWEEN ($offset+1) AND ($limit+$offset)
+
+Supported by B<Oracle>.
+
+=cut
sub _RowNum {
my ( $self, $sql, $rs_attrs, $rows, $offset ) = @_;
return $sql;
}
-# Crappy Top based Limit/Offset support. Legacy for MSSQL < 2005
+=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 ) = @_;
return $sql;
}
-# This for Sybase ASE, to use SET ROWCOUNT when there is no offset, and
-# GenericSubQ otherwise.
+=head2 RowCountOrGenericSubQ
+
+This is not exactly a limit dialect, but more of a proxy for B<Sybase ASE>.
+If no $offset is supplied the limit is simply performed as:
+
+ SET ROWCOUNT $limit
+ SELECT ...
+ SET ROWCOUNT 0
+
+Otherwise we fall back to L</GenericSubQ>
+
+=cut
sub _RowCountOrGenericSubQ {
my $self = shift;
my ($sql, $rs_attrs, $rows, $offset) = @_;
EOF
}
-# This is the most evil limit "dialect" (more of a hack) for *really*
-# stupid databases. It works by ordering the set by some unique column,
-# and calculating amount of rows that have a less-er value (thus
-# emulating a RowNum-like index). Of course this implies the set can
-# only be ordered by a single unique columns.
+=head2 GenericSubQ
+
+ SELECT * FROM (
+ SELECT ...
+ )
+ WHERE (
+ SELECT COUNT(*) FROM $original_table cnt WHERE cnt.id < $original_table.id
+ ) BETWEEN $offset AND ($offset+$rows-1)
+
+This is the most evil limit "dialect" (more of a hack) for I<really> stupid
+databases. It works by ordering the set by some unique column, and calculating
+the amount of rows that have a less-er value (thus emulating a L</RowNum>-like
+index). Of course this implies the set can only be ordered by a single unique
+column. Also note that this technique can be and often is B<excruciatingly
+slow>.
+
+Currently used by B<Sybase ASE>, due to lack of any other option.
+
+=cut
sub _GenericSubQ {
my ($self, $sql, $rs_attrs, $rows, $offset) = @_;
}
-# While we're at it, this should make LIMIT queries more efficient,
-# without digging into things too deeply
-sub _find_syntax {
- my ($self, $syntax) = @_;
- return $self->{_cached_syntax} ||= $self->SUPER::_find_syntax($syntax);
-}
-
-# Quotes table names, handles "limit" dialects (e.g. where rownum between x and
-# y)
-sub select {
- my ($self, $table, $fields, $where, $rs_attrs, @rest) = @_;
+# !!! THIS IS ALSO HORRIFIC !!! /me ashamed
+#
+# Generates inner/outer select lists for various limit dialects
+# which result in one or more subqueries (e.g. RNO, Top, RowNum)
+# Any non-root-table columns need to have their table qualifier
+# turned into a column alias (otherwise names in subqueries clash
+# and/or lose their source table)
+#
+# Returns inner/outer strings of SQL QUOTED selectors with aliases
+# (to be used in whatever select statement), and an alias index hashref
+# of QUOTED SEL => QUOTED ALIAS pairs (to maybe be used for string-subst
+# higher up).
+# If an order_by is supplied, the inner select needs to bring out columns
+# used in implicit (non-selected) orders, and the order condition itself
+# needs to be realiased to the proper names in the outer query. Thus we
+# also return a hashref (order doesn't matter) of QUOTED EXTRA-SEL =>
+# QUOTED ALIAS pairs, which is a list of extra selectors that do *not*
+# exist in the original select list
- if (not ref($table) or ref($table) eq 'SCALAR') {
- $table = $self->_quote($table);
- }
+sub _subqueried_limit_attrs {
+ my ($self, $rs_attrs) = @_;
- @rest = (-1) unless defined $rest[0];
- croak "LIMIT 0 Does Not Compute" if $rest[0] == 0;
- # and anyway, SQL::Abstract::Limit will cause a barf if we don't first
+ croak 'Limit dialect implementation usable only in the context of DBIC (missing $rs_attrs)'
+ unless ref ($rs_attrs) eq 'HASH';
- my ($sql, @bind) = $self->SUPER::select(
- $table, $self->_recurse_fields($fields), $where, $rs_attrs, @rest
+ my ($re_sep, $re_alias) = map { quotemeta $_ } (
+ $self->name_sep || '.',
+ $rs_attrs->{alias},
);
- push @{$self->{where_bind}}, @bind;
-# this *must* be called, otherwise extra binds will remain in the sql-maker
- my @all_bind = $self->_assemble_binds;
+ # correlate select and as, build selection index
+ my (@sel, $in_sel_index);
+ for my $i (0 .. $#{$rs_attrs->{select}}) {
- return wantarray ? ($sql, @all_bind) : $sql;
-}
+ my $s = $rs_attrs->{select}[$i];
+ my $sql_sel = $self->_recurse_fields ($s);
+ my $sql_alias = (ref $s) eq 'HASH' ? $s->{-as} : undef;
-sub _assemble_binds {
- my $self = shift;
- return map { @{ (delete $self->{"${_}_bind"}) || [] } } (qw/from where having order/);
-}
-# Quotes table names, and handles default inserts
-sub insert {
- my $self = shift;
- my $table = shift;
- $table = $self->_quote($table);
+ push @sel, {
+ sql => $sql_sel,
+ unquoted_sql => do { local $self->{quote_char}; $self->_recurse_fields ($s) },
+ as =>
+ $sql_alias
+ ||
+ $rs_attrs->{as}[$i]
+ ||
+ croak "Select argument $i ($s) without corresponding 'as'"
+ ,
+ };
- # SQLA will emit INSERT INTO $table ( ) VALUES ( )
- # which is sadly understood only by MySQL. Change default behavior here,
- # until SQLA2 comes with proper dialect support
- if (! $_[0] or (ref $_[0] eq 'HASH' and !keys %{$_[0]} ) ) {
- my $sql = "INSERT INTO ${table} DEFAULT VALUES";
+ $in_sel_index->{$sql_sel}++;
+ $in_sel_index->{$self->_quote ($sql_alias)}++ if $sql_alias;
- if (my $ret = ($_[1]||{})->{returning} ) {
- $sql .= $self->_insert_returning ($ret);
+ # record unqualified versions too, so we do not have
+ # to reselect the same column twice (in qualified and
+ # unqualified form)
+ if (! ref $s && $sql_sel =~ / $re_sep (.+) $/x) {
+ $in_sel_index->{$1}++;
}
-
- return $sql;
- }
-
- $self->SUPER::insert($table, @_);
-}
-
-# Just quotes table names.
-sub update {
- my $self = shift;
- my $table = shift;
- $table = $self->_quote($table);
- $self->SUPER::update($table, @_);
-}
-
-# Just quotes table names.
-sub delete {
- my $self = shift;
- my $table = shift;
- $table = $self->_quote($table);
- $self->SUPER::delete($table, @_);
-}
-
-sub _emulate_limit {
- my $self = shift;
- # my ( $syntax, $sql, $order, $rows, $offset ) = @_;
-
- if ($_[3] == -1) {
- return $_[1] . $self->_parse_rs_attrs($_[2]);
- } else {
- return $self->SUPER::_emulate_limit(@_);
}
-}
-
-sub _recurse_fields {
- my ($self, $fields) = @_;
- my $ref = ref $fields;
- return $self->_quote($fields) unless $ref;
- return $$fields if $ref eq 'SCALAR';
-
- if ($ref eq 'ARRAY') {
- return join(', ', map { $self->_recurse_fields($_) } @$fields);
- }
- elsif ($ref eq 'HASH') {
- my %hash = %$fields; # shallow copy
-
- my $as = delete $hash{-as}; # if supplied
- my ($func, $args, @toomany) = %hash;
- # there should be only one pair
- if (@toomany) {
- croak "Malformed select argument - too many keys in hash: " . join (',', keys %$fields );
+ # re-alias and remove any name separators from aliases,
+ # unless we are dealing with the current source alias
+ # (which will transcend the subqueries as it is necessary
+ # for possible further chaining)
+ my (@in_sel, @out_sel, %renamed);
+ for my $node (@sel) {
+ if (first { $_ =~ / (?<! ^ $re_alias ) $re_sep /x } ($node->{as}, $node->{unquoted_sql}) ) {
+ $node->{as} = $self->_unqualify_colname($node->{as});
+ my $quoted_as = $self->_quote($node->{as});
+ push @in_sel, sprintf '%s AS %s', $node->{sql}, $quoted_as;
+ push @out_sel, $quoted_as;
+ $renamed{$node->{sql}} = $quoted_as;
}
-
- if (lc ($func) eq 'distinct' && ref $args eq 'ARRAY' && @$args > 1) {
- croak (
- 'The select => { distinct => ... } syntax is not supported for multiple columns.'
- .' Instead please use { group_by => [ qw/' . (join ' ', @$args) . '/ ] }'
- .' or { select => [ qw/' . (join ' ', @$args) . '/ ], distinct => 1 }'
- );
+ else {
+ push @in_sel, $node->{sql};
+ push @out_sel, $self->_quote ($node->{as});
}
-
- my $select = sprintf ('%s( %s )%s',
- $self->_sqlcase($func),
- $self->_recurse_fields($args),
- $as
- ? sprintf (' %s %s', $self->_sqlcase('as'), $self->_quote ($as) )
- : ''
- );
-
- return $select;
- }
- # Is the second check absolutely necessary?
- elsif ( $ref eq 'REF' and ref($$fields) eq 'ARRAY' ) {
- return $self->_fold_sqlbind( $fields );
- }
- else {
- croak($ref . qq{ unexpected in _recurse_fields()})
- }
-}
-
-my $for_syntax = {
- update => 'FOR UPDATE',
- shared => 'FOR SHARE',
-};
-
-# this used to be a part of _order_by but is broken out for clarity.
-# What we have been doing forever is hijacking the $order arg of
-# SQLA::select to pass in arbitrary pieces of data (first the group_by,
-# then pretty much the entire resultset attr-hash, as more and more
-# things in the SQLA space need to have mopre info about the $rs they
-# create SQL for. The alternative would be to keep expanding the
-# signature of _select with more and more positional parameters, which
-# is just gross. All hail SQLA2!
-sub _parse_rs_attrs {
- my ($self, $arg) = @_;
-
- my $sql = '';
-
- if (my $g = $self->_recurse_fields($arg->{group_by}) ) {
- $sql .= $self->_sqlcase(' group by ') . $g;
- }
-
- if (defined $arg->{having}) {
- my ($frag, @bind) = $self->_recurse_where($arg->{having});
- push(@{$self->{having_bind}}, @bind);
- $sql .= $self->_sqlcase(' having ') . $frag;
- }
-
- if (defined $arg->{order_by}) {
- $sql .= $self->_order_by ($arg->{order_by});
- }
-
- if (my $for = $arg->{for}) {
- $sql .= " $for_syntax->{$for}" if $for_syntax->{$for};
- }
-
- return $sql;
-}
-
-sub _order_by {
- my ($self, $arg) = @_;
-
- # check that we are not called in legacy mode (order_by as 4th argument)
- if (ref $arg eq 'HASH' and not grep { $_ =~ /^-(?:desc|asc)/i } keys %$arg ) {
- return $self->_parse_rs_attrs ($arg);
- }
- else {
- my ($sql, @bind) = $self->SUPER::_order_by ($arg);
- push @{$self->{order_bind}}, @bind;
- return $sql;
}
-}
-
-sub _order_directions {
- my ($self, $order) = @_;
-
- # strip bind values - none of the current _order_directions users support them
- return $self->SUPER::_order_directions( [ map
- { ref $_ ? $_->[0] : $_ }
- $self->_order_by_chunks ($order)
- ]);
-}
-sub _table {
- my ($self, $from) = @_;
- if (ref $from eq 'ARRAY') {
- return $self->_recurse_from(@$from);
- } elsif (ref $from eq 'HASH') {
- return $self->_make_as($from);
- } else {
- return $from; # would love to quote here but _table ends up getting called
- # twice during an ->select without a limit clause due to
- # the way S::A::Limit->select works. should maybe consider
- # bypassing this and doing S::A::select($self, ...) in
- # our select method above. meantime, quoting shims have
- # been added to select/insert/update/delete here
- }
-}
+ # see if the order gives us anything
+ my %extra_order_sel;
+ for my $chunk ($self->_order_by_chunks ($rs_attrs->{order_by})) {
+ # order with bind
+ $chunk = $chunk->[0] if (ref $chunk) eq 'ARRAY';
+ $chunk =~ s/\s+ (?: ASC|DESC ) \s* $//ix;
-sub _generate_join_clause {
- my ($self, $join_type) = @_;
+ next if $in_sel_index->{$chunk};
- return sprintf ('%s JOIN ',
- $join_type ? ' ' . uc($join_type) : ''
+ $extra_order_sel{$chunk} ||= $self->_quote (
+ 'ORDER__BY__' . scalar keys %extra_order_sel
);
-}
-
-sub _recurse_from {
- my ($self, $from, @join) = @_;
- my @sqlf;
- push(@sqlf, $self->_make_as($from));
- foreach my $j (@join) {
- my ($to, $on) = @$j;
-
-
- # check whether a join type exists
- my $to_jt = ref($to) eq 'ARRAY' ? $to->[0] : $to;
- my $join_type;
- if (ref($to_jt) eq 'HASH' and defined($to_jt->{-join_type})) {
- $join_type = $to_jt->{-join_type};
- $join_type =~ s/^\s+ | \s+$//xg;
- }
-
- $join_type = $self->{_default_jointype} if not defined $join_type;
-
- push @sqlf, $self->_generate_join_clause( $join_type );
-
- if (ref $to eq 'ARRAY') {
- push(@sqlf, '(', $self->_recurse_from(@$to), ')');
- } else {
- push(@sqlf, $self->_make_as($to));
- }
- push(@sqlf, ' ON ', $self->_join_condition($on));
}
- return join('', @sqlf);
-}
-
-sub _fold_sqlbind {
- my ($self, $sqlbind) = @_;
- my @sqlbind = @$$sqlbind; # copy
- my $sql = shift @sqlbind;
- push @{$self->{from_bind}}, @sqlbind;
-
- return $sql;
+ return (
+ (map { join (', ', @$_ ) } (
+ \@in_sel,
+ \@out_sel)
+ ),
+ \%renamed,
+ keys %extra_order_sel ? \%extra_order_sel : (),
+ );
}
-sub _make_as {
- my ($self, $from) = @_;
- return join(' ', map { (ref $_ eq 'SCALAR' ? $$_
- : ref $_ eq 'REF' ? $self->_fold_sqlbind($_)
- : $self->_quote($_))
- } reverse each %{$self->_skip_options($from)});
+sub _unqualify_colname {
+ my ($self, $fqcn) = @_;
+ my $re_sep = quotemeta($self->name_sep || '.');
+ $fqcn =~ s/ $re_sep /__/xg;
+ return $fqcn;
}
-sub _skip_options {
- my ($self, $hash) = @_;
- my $clean_hash = {};
- $clean_hash->{$_} = $hash->{$_}
- for grep {!/^-/} keys %$hash;
- return $clean_hash;
-}
+1;
-sub _join_condition {
- my ($self, $cond) = @_;
- if (ref $cond eq 'HASH') {
- my %j;
- for (keys %$cond) {
- my $v = $cond->{$_};
- if (ref $v) {
- croak (ref($v) . qq{ reference arguments are not supported in JOINS - try using \"..." instead'})
- if ref($v) ne 'SCALAR';
- $j{$_} = $v;
- }
- else {
- my $x = '= '.$self->_quote($v); $j{$_} = \$x;
- }
- };
- return scalar($self->_recurse_where(\%j));
- } elsif (ref $cond eq 'ARRAY') {
- return join(' OR ', map { $self->_join_condition($_) } @$cond);
- } else {
- croak "Can't handle this yet!";
- }
-}
+=head1 AUTHORS
-sub limit_dialect {
- my $self = shift;
- if (@_) {
- $self->{limit_dialect} = shift;
- undef $self->{_cached_syntax};
- }
- return $self->{limit_dialect};
-}
+See L<DBIx::Class/CONTRIBUTORS>.
-# Set to an array-ref to specify separate left and right quotes for table names.
-# A single scalar is equivalen to [ $char, $char ]
-sub quote_char {
- my $self = shift;
- $self->{quote_char} = shift if @_;
- return $self->{quote_char};
-}
+=head1 LICENSE
-# Character separating quoted table names.
-sub name_sep {
- my $self = shift;
- $self->{name_sep} = shift if @_;
- return $self->{name_sep};
-}
+You may distribute this code under the same terms as Perl itself.
-1;
+=cut
package # Hide from PAUSE
- DBIx::Class::SQLAHacks::MSSQL;
+ DBIx::Class::SQLMaker::MSSQL;
-use base qw( DBIx::Class::SQLAHacks );
+use base qw( DBIx::Class::SQLMaker );
use Carp::Clan qw/^DBIx::Class|^SQL::Abstract/;
#
package # Hide from PAUSE
- DBIx::Class::SQLAHacks::MySQL;
+ DBIx::Class::SQLMaker::MySQL;
-use base qw( DBIx::Class::SQLAHacks );
+use base qw( DBIx::Class::SQLMaker );
use Carp::Clan qw/^DBIx::Class|^SQL::Abstract/;
#
package # Hide from PAUSE
- DBIx::Class::SQLAHacks::Oracle;
+ DBIx::Class::SQLMaker::Oracle;
use warnings;
use strict;
-use base qw( DBIx::Class::SQLAHacks );
+use base qw( DBIx::Class::SQLMaker );
use Carp::Clan qw/^DBIx::Class|^SQL::Abstract/;
sub new {
}
1;
-
-__END__
-
-=pod
-
-=head1 NAME
-
-DBIx::Class::SQLAHacks::Oracle - adds hierarchical query support for Oracle to SQL::Abstract
-
-=head1 DESCRIPTION
-
-See L<DBIx::Class::Storage::DBI::Oracle::Generic> for more information about
-how to use hierarchical queries with DBIx::Class.
-
-=cut
package # Hide from PAUSE
- DBIx::Class::SQLAHacks::OracleJoins;
+ DBIx::Class::SQLMaker::OracleJoins;
-use base qw( DBIx::Class::SQLAHacks );
+use base qw( DBIx::Class::SQLMaker );
use Carp::Clan qw/^DBIx::Class|^SQL::Abstract/;
sub select {
=head1 NAME
-DBIx::Class::SQLAHacks::OracleJoins - Pre-ANSI Joins-via-Where-Clause Syntax
+DBIx::Class::SQLMaker::OracleJoins - Pre-ANSI Joins-via-Where-Clause Syntax
=head1 PURPOSE
=item select ($\@$;$$@)
-Replaces DBIx::Class::SQLAHacks's select() method, which calls _oracle_joins()
+Replaces DBIx::Class::SQLMaker's select() method, which calls _oracle_joins()
to modify the column and table list before calling SUPER::select().
=item _recurse_from ($$\@)
=item L<DBIx::Class::Storage::DBI::Oracle::WhereJoins> - Storage class using this
-=item L<DBIx::Class::SQLAHacks> - Parent module
+=item L<DBIx::Class::SQLMaker> - Parent module
=item L<DBIx::Class> - Duh
package # Hide from PAUSE
- DBIx::Class::SQLAHacks::SQLite;
+ DBIx::Class::SQLMaker::SQLite;
-use base qw( DBIx::Class::SQLAHacks );
+use base qw( DBIx::Class::SQLMaker );
use Carp::Clan qw/^DBIx::Class|^SQL::Abstract/;
#
=head2 sql_maker
Returns a C<sql_maker> object - normally an object of class
-C<DBIx::Class::SQLAHacks>.
+C<DBIx::Class::SQLMaker>.
=cut
use base qw/DBIx::Class::Storage::DBIHacks DBIx::Class::Storage/;
use mro 'c3';
-use Carp::Clan qw/^DBIx::Class/;
+use Carp::Clan qw/^DBIx::Class|^Try::Tiny/;
use DBI;
use DBIx::Class::Storage::DBI::Cursor;
use DBIx::Class::Storage::Statistics;
use File::Path 'make_path';
use namespace::clean;
+
# default cursor class, overridable in connect_info attributes
__PACKAGE__->cursor_class('DBIx::Class::Storage::DBI::Cursor');
-__PACKAGE__->mk_group_accessors('inherited' => qw/sql_maker_class/);
-# default
-__PACKAGE__->sql_maker_class('DBIx::Class::SQLAHacks');
+__PACKAGE__->mk_group_accessors('inherited' => qw/sql_maker_class sql_limit_dialect/);
+__PACKAGE__->sql_maker_class('DBIx::Class::SQLMaker');
__PACKAGE__->mk_group_accessors('simple' => qw/
_connect_info _dbi_connect_info _dbic_connect_attributes _driver_determined
=item limit_dialect
-Sets the limit dialect. This is useful for JDBC-bridge among others
-where the remote SQL-dialect cannot be determined by the name of the
-driver alone. See also L<SQL::Abstract::Limit>.
+Sets a specific SQL::Abstract::Limit-style limit dialect, overriding the
+default L</sql_limit_dialect> setting of the storage (if any). For a list
+of available limit dialects see L<DBIx::Class::SQLMaker::LimitDialects>.
=item quote_char
return $self->_dbh;
}
-sub _sql_maker_args {
- my ($self) = @_;
-
- return (
- bindtype=>'columns',
- array_datatypes => 1,
- limit_dialect => $self->_get_dbh,
- %{$self->_sql_maker_opts}
- );
-}
-
sub sql_maker {
my ($self) = @_;
unless ($self->_sql_maker) {
my $sql_maker_class = $self->sql_maker_class;
$self->ensure_class_loaded ($sql_maker_class);
- $self->_sql_maker($sql_maker_class->new( $self->_sql_maker_args ));
+
+ my %opts = %{$self->_sql_maker_opts||{}};
+ my $dialect =
+ $opts{limit_dialect}
+ ||
+ $self->sql_limit_dialect
+ ||
+ do {
+ my $s_class = (ref $self) || $self;
+ carp (
+ "Your storage class ($s_class) does not set sql_limit_dialect and you "
+ . 'have not supplied an explicit limit_dialect in your connection_info. '
+ . 'DBIC will attempt to use the GenericSubQ dialect, which works on most '
+ . 'databases but can be (and often is) painfully slow.'
+ );
+
+ 'GenericSubQ';
+ }
+ ;
+
+ $self->_sql_maker($sql_maker_class->new(
+ bindtype=>'columns',
+ array_datatypes => 1,
+ limit_dialect => $dialect,
+ %opts,
+ ));
}
return $self->_sql_maker;
}
}
}
- # adjust limits
+ # Sanity check the attributes (SQLMaker does it too, but
+ # in case of a software_limit we'll never reach there)
+ if (defined $attrs->{offset}) {
+ $self->throw_exception('A supplied offset attribute must be a non-negative integer')
+ if ( $attrs->{offset} =~ /\D/ or $attrs->{offset} < 0 );
+ }
+ $attrs->{offset} ||= 0;
+
if (defined $attrs->{rows}) {
- $self->throw_exception("rows attribute must be positive if present")
- unless $attrs->{rows} > 0;
+ $self->throw_exception("The rows attribute must be a positive integer if present")
+ if ( $attrs->{rows} =~ /\D/ or $attrs->{rows} <= 0 );
}
- elsif (defined $attrs->{offset}) {
+ elsif ($attrs->{offset}) {
# MySQL actually recommends this approach. I cringe.
$attrs->{rows} = $sql_maker->__max_int;
}
return @row;
}
+=head2 sql_limit_dialect
+
+This is an accessor for the default SQL limit dialect used by a particular
+storage driver. Can be overriden by supplying an explicit L</limit_dialect>
+to L<DBIx::Class::Schema/connect>. For a list of available limit dialects
+see L<DBIx::Class::SQLMaker::LimitDialects>.
+
=head2 sth
=over 4
use base qw/DBIx::Class::Storage::DBI/;
use mro 'c3';
+__PACKAGE__->sql_limit_dialect ('RowNumberOver');
+
sub _dbh_last_insert_id {
my ($self, $dbh, $source, $col) = @_;
sub datetime_parser_type { "DateTime::Format::DB2"; }
-sub _sql_maker_opts {
- my ( $self, $opts ) = @_;
-
- if ( $opts ) {
- $self->{_sql_maker_opts} = { %$opts };
- }
-
- return { limit_dialect => 'RowNumberOver', %{$self->{_sql_maker_opts}||{}} };
-}
-
1;
=head1 NAME
use Context::Preserve 'preserve_context';
use namespace::clean;
+__PACKAGE__->sql_limit_dialect ('SkipFirst');
+
__PACKAGE__->mk_group_accessors('simple' => '__last_insert_id');
=head1 NAME
shift->__last_insert_id;
}
-sub _sql_maker_opts {
- my ( $self, $opts ) = @_;
-
- if ( $opts ) {
- $self->{_sql_maker_opts} = { %$opts };
- }
-
- return { limit_dialect => 'SkipFirst', %{$self->{_sql_maker_opts}||{}} };
-}
-
sub _svp_begin {
my ($self, $name) = @_;
=head1 DESCRIPTION
This class implements autoincrements for Firebird using C<RETURNING> as well as
-L<auto_nextval|DBIx::Class::ResultSource/auto_nextval> sets the limit dialect to
-C<FIRST X SKIP X> and provides L<DBIx::Class::InflateColumn::DateTime> support.
+L<auto_nextval|DBIx::Class::ResultSource/auto_nextval> and provides
+L<DBIx::Class::InflateColumn::DateTime> support.
You need to use either the
L<disable_sth_caching|DBIx::Class::Storage::DBI/disable_sth_caching> option or
# set default
__PACKAGE__->_use_insert_returning (1);
+__PACKAGE__->sql_limit_dialect ('FirstSkip');
sub _sequence_fetch {
my ($self, $nextval, $sequence) = @_;
return undef;
}
-# this sub stolen from DB2
-
-sub _sql_maker_opts {
- my ( $self, $opts ) = @_;
-
- if ( $opts ) {
- $self->{_sql_maker_opts} = { %$opts };
- }
-
- return { limit_dialect => 'FirstSkip', %{$self->{_sql_maker_opts}||{}} };
-}
-
sub _svp_begin {
my ($self, $name) = @_;
_identity _identity_method
/);
-__PACKAGE__->sql_maker_class('DBIx::Class::SQLAHacks::MSSQL');
+__PACKAGE__->sql_maker_class('DBIx::Class::SQLMaker::MSSQL');
sub _set_identity_insert {
my ($self, $table) = @_;
#
# MSSQL is retarded wrt ordered subselects. One needs to add a TOP
-# to *all* subqueries, but one also can't use TOP 100 PERCENT
+# to *all* subqueries, but one also *can't* use TOP 100 PERCENT
# http://sqladvice.com/forums/permalink/18496/22931/ShowThread.aspx#22931
#
sub _select_args_to_query {
sub sqlt_type { 'SQLServer' }
-sub sql_maker {
+sub sql_limit_dialect {
my $self = shift;
- unless ($self->_sql_maker) {
- unless ($self->{_sql_maker_opts}{limit_dialect}) {
- my $have_rno = 0;
+ my $supports_rno = 0;
- if (exists $self->_server_info->{normalized_dbms_version}) {
- $have_rno = 1 if $self->_server_info->{normalized_dbms_version} >= 9;
- }
- else {
- # User is connecting via DBD::Sybase and has no permission to run
- # stored procedures like xp_msver, or version detection failed for some
- # other reason.
- # So, we use a query to check if RNO is implemented.
- try {
- $self->_get_dbh->selectrow_array('SELECT row_number() OVER (ORDER BY rand())');
- $have_rno = 1;
- };
- }
-
- $self->{_sql_maker_opts} = {
- limit_dialect => ($have_rno ? 'RowNumberOver' : 'Top'),
- %{$self->{_sql_maker_opts}||{}}
- };
- }
-
- my $maker = $self->next::method (@_);
+ if (exists $self->_server_info->{normalized_dbms_version}) {
+ $supports_rno = 1 if $self->_server_info->{normalized_dbms_version} >= 9;
+ }
+ else {
+ # User is connecting via DBD::Sybase and has no permission to run
+ # stored procedures like xp_msver, or version detection failed for some
+ # other reason.
+ # So, we use a query to check if RNO is implemented.
+ try {
+ $self->_get_dbh->selectrow_array('SELECT row_number() OVER (ORDER BY rand())');
+ $supports_rno = 1;
+ };
}
- return $self->_sql_maker;
+ return $supports_rno ? 'RowNumberOver' : 'Top';
}
sub _ping {
my $ERR_MSG_START = __PACKAGE__ . ' failed: ';
+__PACKAGE__->sql_limit_dialect ('Top');
+
sub insert {
my $self = shift;
my ( $source, $to_insert ) = @_;
use base qw/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"
+;
+
+# 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) = @_;
use Try::Tiny;
use namespace::clean;
+__PACKAGE__->sql_limit_dialect ('RowNum');
+
=head1 NAME
DBIx::Class::Storage::DBI::Oracle::Generic - Oracle Support for DBIx::Class
use base qw/DBIx::Class::Storage::DBI/;
use mro 'c3';
-__PACKAGE__->sql_maker_class('DBIx::Class::SQLAHacks::Oracle');
+__PACKAGE__->sql_maker_class('DBIx::Class::SQLMaker::Oracle');
sub deployment_statements {
my $self = shift;;
use base qw( DBIx::Class::Storage::DBI::Oracle::Generic );
use mro 'c3';
-__PACKAGE__->sql_maker_class('DBIx::Class::SQLAHacks::OracleJoins');
+__PACKAGE__->sql_maker_class('DBIx::Class::SQLMaker::OracleJoins');
1;
=head1 METHODS
-See L<DBIx::Class::SQLAHacks::OracleJoins> for implementation details.
+See L<DBIx::Class::SQLMaker::OracleJoins> for implementation details.
=head1 BUGS
=over
-=item L<DBIx::Class::SQLAHacks>
+=item L<DBIx::Class::SQLMaker>
-=item L<DBIx::Class::SQLAHacks::OracleJoins>
+=item L<DBIx::Class::SQLMaker::OracleJoins>
=item L<DBIx::Class::Storage::DBI::Oracle::Generic>
use Context::Preserve 'preserve_context';
use namespace::clean;
+__PACKAGE__->sql_limit_dialect ('LimitOffset');
+
# Ask for a DBD::Pg with array support
warn __PACKAGE__.": DBD::Pg 2.9.2 or greater is strongly recommended\n"
if ($DBD::Pg::VERSION < 2.009002); # pg uses (used?) version::qv()
_dbh
_select_args
_dbh_execute_array
- _sql_maker_args
_sql_maker
_query_start
_sqlt_version_error
get_dbms_capability
set_dbms_capability
+ sql_limit_dialect
+
_dbh_details
_use_insert_returning
use Try::Tiny;
use namespace::clean;
-__PACKAGE__->mk_group_accessors(simple => qw/
- _identity
-/);
+__PACKAGE__->mk_group_accessors(simple => qw/_identity/);
+__PACKAGE__->sql_limit_dialect ('RowNumberOver');
=head1 NAME
=head1 DESCRIPTION
-This class implements autoincrements for Sybase SQL Anywhere, selects the
-RowNumberOver limit implementation and provides
+This class implements autoincrements for Sybase SQL Anywhere and provides
L<DBIx::Class::InflateColumn::DateTime> support.
You need the C<DBD::SQLAnywhere> driver that comes with the SQL Anywhere
return $self->next::method(@_);
}
-# this sub stolen from DB2
-
-sub _sql_maker_opts {
- my ( $self, $opts ) = @_;
-
- if ( $opts ) {
- $self->{_sql_maker_opts} = { %$opts };
- }
-
- return { limit_dialect => 'RowNumberOver', %{$self->{_sql_maker_opts}||{}} };
-}
-
# this sub stolen from MSSQL
sub build_datetime_parser {
use File::Copy;
use File::Spec;
-__PACKAGE__->sql_maker_class('DBIx::Class::SQLAHacks::SQLite');
+__PACKAGE__->sql_maker_class('DBIx::Class::SQLMaker::SQLite');
+__PACKAGE__->sql_limit_dialect ('LimitOffset');
sub backup
{
use Try::Tiny;
use namespace::clean;
+__PACKAGE__->sql_limit_dialect ('RowCountOrGenericSubQ');
+
__PACKAGE__->mk_group_accessors('simple' =>
qw/_identity _blob_log_on_update _writer_storage _is_extra_storage
_bulk_storage _is_bulk_storage _began_bulk_work
};
}
-sub _sql_maker_opts {
- my ( $self, $opts ) = @_;
-
- if ( $opts ) {
- $self->{_sql_maker_opts} = { %$opts };
- }
-
- return { limit_dialect => 'RowCountOrGenericSubQ', %{$self->{_sql_maker_opts}||{}} };
-}
-
sub disconnect {
my $self = shift;
=item *
-Adaptive Server Anywhere (ASA) support, with possible SQLA::Limit support.
+Adaptive Server Anywhere (ASA) support
=item *
/;
use mro 'c3';
-__PACKAGE__->sql_maker_class('DBIx::Class::SQLAHacks::MySQL');
+__PACKAGE__->sql_maker_class('DBIx::Class::SQLMaker::MySQL');
+__PACKAGE__->sql_limit_dialect ('LimitXY');
sub with_deferred_fk_checks {
my ($self, $sub) = @_;
my $schema2 = DBICTest::Schema->connect($dsn, $user, $pass);
$schema2->resultset("Artist")->find(4);
-isa_ok($schema2->storage->sql_maker, 'DBIx::Class::SQLAHacks::MySQL');
+isa_ok($schema2->storage->sql_maker, 'DBIx::Class::SQLMaker::MySQL');
done_testing;
ok (!$s->storage->_dbh, 'still not connected');
}
+# test LIMIT support
+{
+ my $schema = DBICTest::Schema->connect($dsn, $user, $pass);
+ drop_test_schema($schema);
+ create_test_schema($schema);
+ for (1..6) {
+ $schema->resultset('Artist')->create({ name => 'Artist ' . $_ });
+ }
+ my $it = $schema->resultset('Artist')->search( {},
+ { rows => 3,
+ offset => 2,
+ order_by => 'artistid' }
+ );
+ is( $it->count, 3, "LIMIT count ok" ); # ask for 3 rows out of 6 artists
+ is( $it->next->name, "Artist 3", "iterator->next ok" );
+ $it->next;
+ $it->next;
+ $it->next;
+ is( $it->next, undef, "next past end of resultset ok" );
+}
+
# check if we indeed do support stuff
my $test_server_supports_insert_returning = do {
my $v = DBICTest::Schema->connect($dsn, $user, $pass)
my $have_rno = $version >= 9 ? 1 : 0;
- local $storage->{_sql_maker} = undef;
- local $storage->{_sql_maker_opts} = undef;
-
local $storage->{_dbh_details}{info} = {}; # delete cache
- $storage->sql_maker;
-
my $rno_detected =
- ($storage->{_sql_maker_opts}{limit_dialect} eq 'RowNumberOver') ? 1 : 0;
+ ($storage->sql_limit_dialect eq 'RowNumberOver') ? 1 : 0;
ok (($have_rno == $rno_detected),
'row_number() over support detected correctly');
my $orig_debug = $schema->storage->debug;
# test the abstract join => SQL generator
-my $sa = new DBIx::Class::SQLAHacks;
+my $sa = new DBIx::Class::SQLMaker;
my @j = (
{ child => 'person' },
);
}
-# Make sure the carp/croak override in SQLA works (via SQLAHacks)
+# Make sure the carp/croak override in SQLA works (via SQLMaker)
my $file = quotemeta (__FILE__);
throws_ok (sub {
$schema->resultset ('Artist')->search ({}, { order_by => { -asc => 'stuff', -desc => 'staff' } } )->as_query;
--- /dev/null
+use strict;
+use warnings;
+
+use Test::More;
+
+use lib qw(t/lib);
+use DBICTest::Schema;
+use DBIC::SqlMakerTest;
+
+# This is legacy stuff from SQL::Absract::Limit
+# Keep it around just in case someone is using it
+
+{
+ package DBICTest::SQLMaker::CustomDialect;
+ use base qw/DBIx::Class::SQLMaker/;
+ sub emulate_limit {
+ my ($self, $sql, $rs_attrs, $limit, $offset) = @_;
+ return sprintf ('shiny sproc ((%s), %d, %d)',
+ $sql,
+ $limit || 0,
+ $offset || 0,
+ );
+ }
+}
+
+my $s = DBICTest::Schema->connect ('dbi:SQLite::memory:');
+$s->storage->sql_maker_class ('DBICTest::SQLMaker::CustomDialect');
+
+my $rs = $s->resultset ('CD');
+is_same_sql_bind (
+ $rs->search ({}, { rows => 1, offset => 3,columns => [
+ { id => 'foo.id' },
+ { 'bar.id' => 'bar.id' },
+ { bleh => \ 'TO_CHAR (foo.womble, "blah")' },
+ ]})->as_query,
+ '(
+ shiny sproc (
+ (
+ SELECT foo.id, bar.id, TO_CHAR (foo.womble, "blah")
+ FROM cd me
+ ),
+ 1,
+ 3
+ )
+ )',
+ [],
+ 'Rownum subsel aliasing works correctly'
+);
+
+done_testing;
use Data::Dumper::Concise;
use lib qw(t/lib);
use DBIC::SqlMakerTest;
-use DBIx::Class::SQLAHacks::Oracle;
+use DBIx::Class::SQLMaker::Oracle;
#
# Offline test for connect_by
# TODO: NOCYCLE parameter doesn't work
);
-my $sqla_oracle = DBIx::Class::SQLAHacks::Oracle->new( quote_char => '"', name_sep => '.' );
-isa_ok($sqla_oracle, 'DBIx::Class::SQLAHacks::Oracle');
+my $sqla_oracle = DBIx::Class::SQLMaker::Oracle->new( quote_char => '"', name_sep => '.' );
+isa_ok($sqla_oracle, 'DBIx::Class::SQLMaker::Oracle');
for my $case (@handle_tests) {
use Test::More;
use lib qw(t/lib);
-use DBIx::Class::SQLAHacks::OracleJoins;
+use DBIx::Class::SQLMaker::OracleJoins;
use DBICTest;
use DBIC::SqlMakerTest;
-my $sa = new DBIx::Class::SQLAHacks::OracleJoins;
+my $sa = new DBIx::Class::SQLMaker::OracleJoins;
# search with undefined or empty $cond
# test some specific components whose parents are exempt below
'DBIx::Class::Relationship::Base' => {},
+ 'DBIx::Class::SQLMaker::LimitDialects' => {},
# internals
- 'DBIx::Class::SQLAHacks*' => { skip => 1 },
+ 'DBIx::Class::SQLMaker*' => { skip => 1 },
'DBIx::Class::Storage::DBI*' => { skip => 1 },
'SQL::Translator::*' => { skip => 1 },
projects / dbsrgits/DBIx-Class.git / commitdiff