no warnings qw/redefine/;
no strict qw/refs/;
for my $f (qw/carp croak/) {
+
my $orig = \&{"SQL::Abstract::$f"};
*{"SQL::Abstract::$f"} = sub {
local $Carp::CarpLevel = 1; # even though Carp::Clan ignores this, $orig will not
- if (Carp::longmess() =~ /DBIx::Class::SQLAHacks::[\w]+\(\) called/) {
+ if (Carp::longmess() =~ /DBIx::Class::SQLAHacks::[\w]+ .+? called \s at/x) {
__PACKAGE__->can($f)->(@_);
}
else {
$order = { %$order }; #copy
- my $req_order = [ $self->_order_by_chunks ($order->{order_by}) ];
- my $limit_order = [ @$req_order ? @$req_order : $self->_order_by_chunks ($order->{_virtual_order_by}) ];
+ my $req_order = $order->{order_by};
+ my $limit_order =
+ scalar $self->_order_by_chunks ($req_order) # examine normalized version, collapses nesting
+ ? $req_order
+ : $order->{_virtual_order_by}
+ ;
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->{$_} for qw/order_by _virtual_order_by/;
+ my $grpby_having = $self->_order_by ($order);
+
+ # short circuit for counts - the ordering complexity is needless
+ if ($self->{_dbic_rs_attrs}{-for_count_only}) {
+ return "SELECT TOP $rows $inner_select $sql $grpby_having $order_by_outer";
+ }
+
# we can't really adjust the order_by columns, as introspection is lacking
# resort to simple substitution
for my $col (keys %outer_col_aliases) {
}
- # generate the rest
- delete $order->{$_} for qw/order_by _virtual_order_by/;
- my $grpby_having = $self->_order_by ($order);
-
-
my $inner_lim = $rows + $offset;
$sql = "SELECT TOP $inner_lim $inner_select $sql $grpby_having $order_by_inner";
SELECT TOP $rows $outer_select FROM
(
$sql
- ) AS inner_sel
+ ) AS me
$order_by_outer
SQL
$sql = <<"SQL";
SELECT $outer_select FROM
- ( $sql ) AS outer_sel
+ ( $sql ) AS me
$order_by_requested;
SQL
return unless $col;
- # record unqialified name, undef (no adjustment) if a duplicate is found
+ # record unqualified name, undef (no adjustment) if a duplicate is found
if (exists $register->{$col}) {
$register->{$col} = undef;
}
? ' AS col'.$self->{rownum_hack_count}++
: '')
} @$fields);
- } elsif ($ref eq 'HASH') {
- foreach my $func (keys %$fields) {
- if ($func eq 'distinct') {
- my $_fields = $fields->{$func};
- if (ref $_fields eq 'ARRAY' && @{$_fields} > 1) {
- croak (
- 'The select => { distinct => ... } syntax is not supported for multiple columns.'
- .' Instead please use { group_by => [ qw/' . (join ' ', @$_fields) . '/ ] }'
- .' or { select => [ qw/' . (join ' ', @$_fields) . '/ ], distinct => 1 }'
- );
- }
- else {
- $_fields = @{$_fields}[0] if ref $_fields eq 'ARRAY';
- carp (
- 'The select => { distinct => ... } syntax will be deprecated in DBIC version 0.09,'
- ." please use { group_by => '${_fields}' } or { select => '${_fields}', distinct => 1 }"
- );
- }
+ }
+ elsif ($ref eq 'HASH') {
+ my %hash = %$fields;
+ my ($select, $as);
+
+ if ($hash{-select}) {
+ $select = $self->_recurse_fields (delete $hash{-select});
+ $as = $self->_quote (delete $hash{-as});
+ }
+ else {
+ my ($func, $args) = each %hash;
+ delete $hash{$func};
+
+ 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 }'
+ );
}
- return $self->_sqlcase($func)
- .'( '.$self->_recurse_fields($fields->{$func}).' )';
+ $select = sprintf ('%s( %s )',
+ $self->_sqlcase($func),
+ $self->_recurse_fields($args)
+ );
}
+
+ # there should be nothing left
+ if (keys %hash) {
+ croak "Malformed select argument - too many keys in hash: " . join (',', keys %$fields );
+ }
+
+ $select .= " AS $as" if $as;
+ return $select;
}
# Is the second check absolutely necessary?
elsif ( $ref eq 'REF' and ref($$fields) eq 'ARRAY' ) {
my $ret = '';
- if (defined $arg->{group_by}) {
- $ret = $self->_sqlcase(' group by ')
- .$self->_recurse_fields($arg->{group_by}, { no_rownum_hack => 1 });
+ if (my $g = $self->_recurse_fields($arg->{group_by}, { no_rownum_hack => 1 }) ) {
+ $ret = $self->_sqlcase(' group by ') . $g;
}
if (defined $arg->{having}) {