# ANSI standard Limit/Offset implementation. DB2 and MSSQL use this
sub _RowNumberOver {
- my ($self, $sql, $order, $rows, $offset ) = @_;
+ my ($self, $sql, $rs_attrs, $rows, $offset ) = @_;
# get the select to make the final amount of columns equal the original one
my ($select) = $sql =~ /^ \s* SELECT \s+ (.+?) \s+ FROM/ix
or croak "Unrecognizable SELECT: $sql";
- # get the order_by only (or make up an order if none exists)
+ # make up an order if none exists
my $order_by = $self->_order_by(
- (delete $order->{order_by}) || $self->_rno_default_order
+ (delete $rs_attrs->{order_by}) || $self->_rno_default_order
);
# whatever is left of the order_by
- my $group_having = $self->_order_by($order);
+ my $group_having = $self->_parse_rs_attrs($rs_attrs);
- my $qalias = $self->_quote ($self->{_dbic_rs_attrs}{alias});
+ my $qalias = $self->_quote ($rs_attrs->{alias});
$sql = sprintf (<<EOS, $offset + 1, $offset + $rows, );
# Informix specific limit, almost like LIMIT/OFFSET
sub _SkipFirst {
- my ($self, $sql, $order, $rows, $offset) = @_;
+ my ($self, $sql, $rs_attrs, $rows, $offset) = @_;
$sql =~ s/^ \s* SELECT \s+ //ix
or croak "Unrecognizable SELECT: $sql";
,
sprintf ('FIRST %d ', $rows),
$sql,
- $self->_order_by ($order),
+ $self->_parse_rs_attrs ($rs_attrs),
);
}
# Firebird specific limit, reverse of _SkipFirst for Informix
sub _FirstSkip {
- my ($self, $sql, $order, $rows, $offset) = @_;
+ my ($self, $sql, $rs_attrs, $rows, $offset) = @_;
$sql =~ s/^ \s* SELECT \s+ //ix
or croak "Unrecognizable SELECT: $sql";
: ''
,
$sql,
- $self->_order_by ($order),
+ $self->_parse_rs_attrs ($rs_attrs),
);
}
# Crappy Top based Limit/Offset support. Legacy from MSSQL.
sub _Top {
- my ( $self, $sql, $order, $rows, $offset ) = @_;
+ my ( $self, $sql, $rs_attrs, $rows, $offset ) = @_;
# mangle the input sql so it can be properly aliased in the outer queries
$sql =~ s/^ \s* SELECT \s+ (.+?) \s+ (?=FROM)//ix
my @sql_select = split (/\s*,\s*/, $sql_select);
# we can't support subqueries (in fact MSSQL can't) - croak
- if (@sql_select != @{$self->{_dbic_rs_attrs}{select}}) {
+ if (@sql_select != @{$rs_attrs->{select}}) {
croak (sprintf (
'SQL SELECT did not parse cleanly - retrieved %d comma separated elements, while '
. 'the resultset select attribure contains %d elements: %s',
scalar @sql_select,
- scalar @{$self->{_dbic_rs_attrs}{select}},
+ scalar @{$rs_attrs->{select}},
$sql_select,
));
}
my $esc_name_sep = "\Q$name_sep\E";
my $col_re = qr/ ^ (?: (.+) $esc_name_sep )? ([^$esc_name_sep]+) $ /x;
- my $rs_alias = $self->{_dbic_rs_attrs}{alias};
+ my $rs_alias = $rs_attrs->{alias};
my $quoted_rs_alias = $self->_quote ($rs_alias);
# construct the new select lists, rename(alias) some columns if necessary
my (@outer_select, @inner_select, %seen_names, %col_aliases, %outer_col_aliases);
- for (@{$self->{_dbic_rs_attrs}{select}}) {
+ for (@{$rs_attrs->{select}}) {
next if ref $_;
my ($table, $orig_colname) = ( $_ =~ $col_re );
next unless $table;
for my $i (0 .. $#sql_select) {
- my $colsel_arg = $self->{_dbic_rs_attrs}{select}[$i];
+ my $colsel_arg = $rs_attrs->{select}[$i];
my $colsel_sql = $sql_select[$i];
# this may or may not work (in case of a scalarref or something)
%outer_col_aliases = (%outer_col_aliases, %col_aliases);
# deal with order
- croak '$order supplied to SQLAHacks limit emulators must be a hash'
- if (ref $order ne 'HASH');
+ croak '$order/attr container supplied to SQLAHacks limit emulators must be a hash'
+ if (ref $rs_attrs ne 'HASH');
- $order = { %$order }; #copy
-
- my $req_order = $order->{order_by};
+ my $req_order = $rs_attrs->{order_by};
# examine normalized version, collapses nesting
- my $limit_order;
- if (scalar $self->_order_by_chunks ($req_order)) {
- $limit_order = $req_order;
- }
- else {
- $limit_order = [ map
+ my $limit_order = scalar $self->_order_by_chunks ($req_order)
+ ? $req_order
+ : [ map
{ join ('', $rs_alias, $name_sep, $_ ) }
- ( $self->{_dbic_rs_attrs}{_source_handle}->resolve->primary_columns )
- ];
- }
+ ( $rs_attrs->{_rsroot_source_handle}->resolve->primary_columns )
+ ]
+ ;
my ( $order_by_inner, $order_by_outer ) = $self->_order_directions($limit_order);
my $order_by_requested = $self->_order_by ($req_order);
# generate the rest
- delete $order->{order_by};
- my $grpby_having = $self->_order_by ($order);
+ delete $rs_attrs->{order_by};
+ my $grpby_having = $self->_parse_rs_attrs ($rs_attrs);
# short circuit for counts - the ordering complexity is needless
- if ($self->{_dbic_rs_attrs}{-for_count_only}) {
+ if ($rs_attrs->{-for_count_only}) {
return "SELECT TOP $rows $inner_select $sql $grpby_having $order_by_outer";
}
return $self->{_cached_syntax} ||= $self->SUPER::_find_syntax($syntax);
}
-my $for_syntax = {
- update => 'FOR UPDATE',
- shared => 'FOR SHARE',
-};
# Quotes table names, handles "limit" dialects (e.g. where rownum between x and
-# y), supports SELECT ... FOR UPDATE and SELECT ... FOR SHARE.
+# y)
sub select {
- my ($self, $table, $fields, $where, $order, @rest) = @_;
+ my ($self, $table, $fields, $where, $rs_attrs, @rest) = @_;
$self->{"${_}_bind"} = [] for (qw/having from order/);
@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
+
my ($sql, @where_bind) = $self->SUPER::select(
- $table, $self->_recurse_fields($fields), $where, $order, @rest
+ $table, $self->_recurse_fields($fields), $where, $rs_attrs, @rest
);
- if (my $for = delete $self->{_dbic_rs_attrs}{for}) {
- $sql .= " $for_syntax->{$for}" if $for_syntax->{$for};
- }
-
return wantarray ? ($sql, @{$self->{from_bind}}, @where_bind, @{$self->{having_bind}}, @{$self->{order_bind}} ) : $sql;
}
sub _emulate_limit {
my $self = shift;
+ # my ( $syntax, $sql, $order, $rows, $offset ) = @_;
+
if ($_[3] == -1) {
- return $_[1].$self->_order_by($_[2]);
+ return $_[1] . $self->_parse_rs_attrs($_[2]);
} else {
return $self->SUPER::_emulate_limit(@_);
}
}
}
-sub _order_by {
+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) = @_;
- if (ref $arg eq 'HASH' and keys %$arg and not grep { $_ =~ /^-(?:desc|asc)/i } keys %$arg ) {
+ my $sql = '';
- my $ret = '';
+ if (my $g = $self->_recurse_fields($arg->{group_by}, { no_rownum_hack => 1 }) ) {
+ $sql .= $self->_sqlcase(' group by ') . $g;
+ }
- if (my $g = $self->_recurse_fields($arg->{group_by}, { no_rownum_hack => 1 }) ) {
- $ret = $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->{having}) {
- my ($frag, @bind) = $self->_recurse_where($arg->{having});
- push(@{$self->{having_bind}}, @bind);
- $ret .= $self->_sqlcase(' having ').$frag;
- }
+ if (defined $arg->{order_by}) {
+ $sql .= $self->_order_by ($arg->{order_by});
+ }
- if (defined $arg->{order_by}) {
- my ($frag, @bind) = $self->SUPER::_order_by($arg->{order_by});
- push(@{$self->{order_bind}}, @bind);
- $ret .= $frag;
- }
+ if (my $for = $arg->{for}) {
+ $sql .= " $for_syntax->{$for}" if $for_syntax->{$for};
+ }
+
+ return $sql;
+}
+
+sub _order_by {
+ my ($self, $arg) = @_;
- return $ret;
+ # 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);
+ push @{$self->{order_bind}}, @bind;
return $sql;
}
}
sub _select {
my $self = shift;
-
- # localization is neccessary as
- # 1) there is no infrastructure to pass this around before SQLA2
- # 2) _select_args sets it and _prep_for_execute consumes it
- my $sql_maker = $self->sql_maker;
- local $sql_maker->{_dbic_rs_attrs};
-
- return $self->_execute($self->_select_args(@_));
+ $self->_execute($self->_select_args(@_));
}
sub _select_args_to_query {
my $self = shift;
- # localization is neccessary as
- # 1) there is no infrastructure to pass this around before SQLA2
- # 2) _select_args sets it and _prep_for_execute consumes it
- my $sql_maker = $self->sql_maker;
- local $sql_maker->{_dbic_rs_attrs};
-
- # my ($op, $bind, $ident, $bind_attrs, $select, $cond, $order, $rows, $offset)
+ # my ($op, $bind, $ident, $bind_attrs, $select, $cond, $rs_attrs, $rows, $offset)
# = $self->_select_args($ident, $select, $cond, $attrs);
my ($op, $bind, $ident, $bind_attrs, @args) =
$self->_select_args(@_);
- # my ($sql, $prepared_bind) = $self->_prep_for_execute($op, $bind, $ident, [ $select, $cond, $order, $rows, $offset ]);
+ # my ($sql, $prepared_bind) = $self->_prep_for_execute($op, $bind, $ident, [ $select, $cond, $rs_attrs, $rows, $offset ]);
my ($sql, $prepared_bind) = $self->_prep_for_execute($op, $bind, $ident, \@args);
$prepared_bind ||= [];
sub _select_args {
my ($self, $ident, $select, $where, $attrs) = @_;
+ my $sql_maker = $self->sql_maker;
my ($alias2source, $rs_alias) = $self->_resolve_ident_sources ($ident);
- my $sql_maker = $self->sql_maker;
- $sql_maker->{_dbic_rs_attrs} = {
+ $attrs = {
%$attrs,
select => $select,
from => $ident,
where => $where,
$rs_alias && $alias2source->{$rs_alias}
- ? ( _source_handle => $alias2source->{$rs_alias}->handle )
+ ? ( _rsroot_source_handle => $alias2source->{$rs_alias}->handle )
: ()
,
};
# invoked, and that's just bad...
###
- my $order = { map
- { $attrs->{$_} ? ( $_ => $attrs->{$_} ) : () }
- (qw/order_by group_by having/ )
- };
-
- return ('select', $attrs->{bind}, $ident, $bind_attrs, $select, $where, $order, @limit);
+ return ('select', $attrs->{bind}, $ident, $bind_attrs, $select, $where, $attrs, @limit);
}
# Returns a counting SELECT for a simple count
projects / dbsrgits/DBIx-Class.git / commitdiff