my $new_attrs = { %{$our_attrs}, %{$attrs} };
# merge new attrs into inherited
- foreach my $key (qw/join prefetch +select +as/) {
+ foreach my $key (qw/join prefetch +select +as bind/) {
next unless exists $attrs->{$key};
$new_attrs->{$key} = $self->_merge_attr($our_attrs->{$key}, $attrs->{$key});
}
with to find the number of elements. If passed arguments, does a search
on the resultset and counts the results of that.
-Note: When using C<count> with C<group_by>, L<DBIx::Class> emulates C<GROUP BY>
-using C<COUNT( DISTINCT( columns ) )>. Some databases (notably SQLite) do
-not support C<DISTINCT> with multiple columns. If you are using such a
-database, you should only use columns from the main table in your C<group_by>
-clause.
-
=cut
sub count {
sub _count { # Separated out so pager can get the full count
my $self = shift;
- my $select = { count => '*' };
-
my $attrs = { %{$self->_resolved_attrs} };
- if (my $group_by = delete $attrs->{group_by}) {
- delete $attrs->{having};
- my @distinct = (ref $group_by ? @$group_by : ($group_by));
- # todo: try CONCAT for multi-column pk
- my @pk = $self->result_source->primary_columns;
- if (@pk == 1) {
- my $alias = $attrs->{alias};
- foreach my $column (@distinct) {
- if ($column =~ qr/^(?:\Q${alias}.\E)?$pk[0]$/) {
- @distinct = ($column);
- last;
- }
- }
- }
- $select = { count => { distinct => \@distinct } };
+ if (my $group_by = $attrs->{group_by}) {
+ delete $attrs->{order_by};
+
+ $attrs->{select} = $group_by;
+ $attrs->{from} = [ { 'mesub' => (ref $self)->new($self->result_source, $attrs)->cursor->as_query } ];
+ delete $attrs->{where};
}
- $attrs->{select} = $select;
+ $attrs->{select} = { count => '*' };
$attrs->{as} = [qw/count/];
- # offset, order by and page are not needed to count. record_filter is cdbi
- delete $attrs->{$_} for qw/rows offset order_by page pager record_filter/;
+ # offset, order by, group by, where and page are not needed to count. record_filter is cdbi
+ delete $attrs->{$_} for qw/rows offset order_by group_by page pager record_filter/;
my $tmp_rs = (ref $self)->new($self->result_source, $attrs);
my ($count) = $tmp_rs->cursor->next;
# No-op. No condition, we're updating/deleting everything
return $cond unless ref $full_cond;
- if (ref $full_cond eq 'ARRAY') {
- $cond = [
- map {
- my %hash;
- foreach my $key (keys %{$_}) {
- $key =~ /([^.]+)$/;
- $hash{$1} = $_->{$key};
- }
- \%hash;
- } @{$full_cond}
- ];
- }
- elsif (ref $full_cond eq 'HASH') {
- if ((keys %{$full_cond})[0] eq '-and') {
- $cond->{-and} = [];
-
- my @cond = @{$full_cond->{-and}};
- for (my $i = 0; $i < @cond; $i++) {
- my $entry = $cond[$i];
-
- my $hash;
- if (ref $entry eq 'HASH') {
- $hash = $self->_cond_for_update_delete($entry);
- }
- else {
- $entry =~ /([^.]+)$/;
- $hash->{$1} = $cond[++$i];
- }
-
- push @{$cond->{-and}}, $hash;
- }
- }
- else {
- foreach my $key (keys %{$full_cond}) {
- $key =~ /([^.]+)$/;
- $cond->{$1} = $full_cond->{$key};
- }
- }
- }
- else {
- $self->throw_exception(
- "Can't update/delete on resultset with condition unless hash or array"
- );
+ foreach my $pk ($self->result_source->primary_columns) {
+ $cond->{$pk} = { -in => $self->get_column($pk)->as_query };
}
return $cond;
$self->throw_exception("Values for update must be a hash")
unless ref $values eq 'HASH';
- carp( 'WARNING! Currently $rs->update() does not generate proper SQL'
- . ' on joined resultsets, and may affect rows well outside of the'
- . ' contents of $rs. Use at your own risk' )
- if ( $self->{attrs}{seen_join} );
-
my $cond = $self->_cond_for_update_delete;
-
+
return $self->result_source->storage->update(
$self->result_source, $values, $cond
);
delete may not generate correct SQL for a query with joins or a resultset
chained from a related resultset. In this case it will generate a warning:-
- WARNING! Currently $rs->delete() does not generate proper SQL on
- joined resultsets, and may delete rows well outside of the contents
- of $rs. Use at your own risk
-
In these cases you may find that delete_all is more appropriate, or you
need to respecify your query in a way that can be expressed without a join.
my ($self) = @_;
$self->throw_exception("Delete should not be passed any arguments")
if $_[1];
- carp( 'WARNING! Currently $rs->delete() does not generate proper SQL'
- . ' on joined resultsets, and may delete rows well outside of the'
- . ' contents of $rs. Use at your own risk' )
- if ( $self->{attrs}{seen_join} );
+
my $cond = $self->_cond_for_update_delete;
$self->result_source->storage->delete($self->result_source, $cond);
use base qw/SQL::Abstract::Limit/;
sub new {
my $self = shift->SUPER::new(@_);
+ # 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})
$self;
}
+
+
+ # Some databases (sqlite) do not handle multiple parenthesis
+ # around in/between arguments. A tentative x IN ( ( 1, 2 ,3) )
+ # is interpreted as x IN 1 or something similar.
+ #
+ # Since we currently do not have access to the SQLA AST, resort
+ # to barbaric mutilation of any SQL supplied in literal form
+
+ sub _strip_outer_paren {
+ my ($self, $arg) = @_;
+
+ use Data::Dumper;
+
+ return $self->_SWITCH_refkind ($arg, {
+ ARRAYREFREF => sub {
+ $$arg->[0] = __strip_outer_paren ($$arg->[0]);
+ return $arg;
+ },
+ SCALARREF => sub {
+ return \__strip_outer_paren( $$arg );
+ },
+ FALLBACK => sub {
+ return $arg
+ },
+ });
+ }
+
+ sub __strip_outer_paren {
+ my $sql = shift;
+
+ if ($sql and not ref $sql) {
+ while ($sql =~ /^ \s* \( (.*) \) \s* $/x ) {
+ $sql = $1;
+ }
+ }
+
+ return $sql;
+ }
+
+ sub _where_field_IN {
+ my ($self, $lhs, $op, $rhs) = @_;
+ $rhs = $self->_strip_outer_paren ($rhs);
+ return $self->SUPER::_where_field_IN ($lhs, $op, $rhs);
+ }
+
+ sub _where_field_BETWEEN {
+ my ($self, $lhs, $op, $rhs) = @_;
+ $rhs = $self->_strip_outer_paren ($rhs);
+ return $self->SUPER::_where_field_BETWEEN ($lhs, $op, $rhs);
+ }
+
+
+
# DB2 is the only remaining DB using this. Even though we are not sure if
# RowNumberOver is still needed here (should be part of SQLA) leave the
# code in place
sub select {
my ($self, $table, $fields, $where, $order, @rest) = @_;
+ local $self->{having_bind} = [];
+ local $self->{from_bind} = [];
+
if (ref $table eq 'SCALAR') {
$table = $$table;
}
@rest = (-1) unless defined $rest[0];
die "LIMIT 0 Does Not Compute" if $rest[0] == 0;
# and anyway, SQL::Abstract::Limit will cause a barf if we don't first
- local $self->{having_bind} = [];
- my ($sql, @ret) = $self->SUPER::select(
+ my ($sql, @where_bind) = $self->SUPER::select(
$table, $self->_recurse_fields($fields), $where, $order, @rest
);
$sql .=
) :
''
;
- return wantarray ? ($sql, @ret, @{$self->{having_bind}}) : $sql;
+ return wantarray ? ($sql, @{$self->{from_bind}}, @where_bind, @{$self->{having_bind}}) : $sql;
}
sub insert {
}
# Is the second check absolutely necessary?
elsif ( $ref eq 'REF' and ref($$fields) eq 'ARRAY' ) {
- return $self->_bind_to_sql( $fields );
+ return $self->_fold_sqlbind( $fields );
}
else {
Carp::croak($ref . qq{ unexpected in _recurse_fields()})
return join('', @sqlf);
}
-sub _bind_to_sql {
- my $self = shift;
- my $arr = shift;
- my $sql = shift @$$arr;
- $sql =~ s/\?/$self->_quote((shift @$$arr)->[1])/eg;
- return $sql
+sub _fold_sqlbind {
+ my ($self, $sqlbind) = @_;
+ 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->_bind_to_sql($_)
- : $self->_quote($_))
+ return join(' ', map { (ref $_ eq 'SCALAR' ? $$_
+ : ref $_ eq 'REF' ? $self->_fold_sqlbind($_)
+ : $self->_quote($_))
} reverse each %{$self->_skip_options($from)});
}
projects / dbsrgits/DBIx-Class.git / commitdiff