X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FResultSet.pm;h=545f99309a714a342448d388e34f9bd86e83d4eb;hb=f9080e4502d65c87e9c2486ca6a76b166cf1ca8f;hp=88066824ce09e70136239b695446f3a97ec88494;hpb=44e95db4537a7ace8aee44bcf74b8b9d79c03b6b;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm index 8806682..545f993 100644 --- a/lib/DBIx/Class/ResultSet.pm +++ b/lib/DBIx/Class/ResultSet.pm @@ -4,7 +4,6 @@ use strict; use warnings; use base qw/DBIx::Class/; use DBIx::Class::Carp; -use DBIx::Class::Exception; use DBIx::Class::ResultSetColumn; use Scalar::Util qw/blessed weaken/; use Try::Tiny; @@ -354,20 +353,36 @@ always return a resultset, even in list context. sub search_rs { my $self = shift; - # Special-case handling for (undef, undef). - if ( @_ == 2 && !defined $_[1] && !defined $_[0] ) { - @_ = (); - } + my $rsrc = $self->result_source; + my ($call_cond, $call_attrs); - my $call_attrs = {}; - if (@_ > 1) { - if (ref $_[-1] eq 'HASH') { - # copy for _normalize_selection - $call_attrs = { %{ pop @_ } }; - } - elsif (! defined $_[-1] ) { - pop @_; # search({}, undef) + # Special-case handling for (undef, undef) or (undef) + # Note that (foo => undef) is valid deprecated syntax + @_ = () if not scalar grep { defined $_ } @_; + + # just a cond + if (@_ == 1) { + $call_cond = shift; + } + # fish out attrs in the ($condref, $attr) case + elsif (@_ == 2 and ( ! defined $_[0] or (ref $_[0]) ne '') ) { + ($call_cond, $call_attrs) = @_; + } + elsif (@_ % 2) { + $self->throw_exception('Odd number of arguments to search') + } + # legacy search + elsif (@_) { + carp_unique 'search( %condition ) is deprecated, use search( \%condition ) instead' + unless $rsrc->result_class->isa('DBIx::Class::CDBICompat'); + + for my $i (0 .. $#_) { + next if $i % 2; + $self->throw_exception ('All keys in condition key/value pairs must be plain scalars') + if (! defined $_[$i] or ref $_[$i] ne ''); } + + $call_cond = { @_ }; } # see if we can keep the cache (no $rs changes) @@ -383,8 +398,6 @@ sub search_rs { $cache = $self->get_cache; } - my $rsrc = $self->result_source; - my $old_attrs = { %{$self->{attrs}} }; my $old_having = delete $old_attrs->{having}; my $old_where = delete $old_attrs->{where}; @@ -392,7 +405,10 @@ sub search_rs { my $new_attrs = { %$old_attrs }; # take care of call attrs (only if anything is changing) - if (keys %$call_attrs) { + if ($call_attrs and keys %$call_attrs) { + + # copy for _normalize_selection + $call_attrs = { %$call_attrs }; my @selector_attrs = qw/select as columns cols +select +as +columns include_columns/; @@ -439,28 +455,6 @@ sub search_rs { } - # rip apart the rest of @_, parse a condition - my $call_cond = do { - - if (ref $_[0] eq 'HASH') { - (keys %{$_[0]}) ? $_[0] : undef - } - elsif (@_ == 1) { - $_[0] - } - elsif (@_ % 2) { - $self->throw_exception('Odd number of arguments to search') - } - else { - +{ @_ } - } - - } if @_; - - if( @_ > 1 and ! $rsrc->result_class->isa('DBIx::Class::CDBICompat') ) { - carp_unique 'search( %condition ) is deprecated, use search( \%condition ) instead'; - } - for ($old_where, $call_cond) { if (defined $_) { $new_attrs->{where} = $self->_stack_cond ( @@ -993,13 +987,14 @@ L for more information. =cut sub cursor { - my ($self) = @_; - - my $attrs = $self->_resolved_attrs_copy; + my $self = shift; - return $self->{cursor} - ||= $self->result_source->storage->select($attrs->{from}, $attrs->{select}, - $attrs->{where},$attrs); + return $self->{cursor} ||= do { + my $attrs = { %{$self->_resolved_attrs } }; + $self->result_source->storage->select( + $attrs->{from}, $attrs->{select}, $attrs->{where}, $attrs + ); + }; } =head2 single @@ -1051,7 +1046,7 @@ sub single { $self->throw_exception('single() only takes search conditions, no attributes. You want ->search( $cond, $attrs )->single()'); } - my $attrs = $self->_resolved_attrs_copy; + my $attrs = { %{$self->_resolved_attrs} }; if (keys %{$attrs->{collapse}}) { $self->throw_exception( @@ -1460,7 +1455,7 @@ sub count { return $self->search(@_)->count if @_ and defined $_[0]; return scalar @{ $self->get_cache } if $self->get_cache; - my $attrs = $self->_resolved_attrs_copy; + my $attrs = { %{ $self->_resolved_attrs } }; # this is a little optimization - it is faster to do the limit # adjustments in software, instead of a subquery @@ -1725,7 +1720,6 @@ another query. sub reset { my ($self) = @_; - delete $self->{_attrs} if exists $self->{_attrs}; $self->{all_cache_position} = 0; $self->cursor->reset; return $self; @@ -1760,152 +1754,146 @@ sub first { sub _rs_update_delete { my ($self, $op, $values) = @_; - my $cond = $self->{cond}; my $rsrc = $self->result_source; my $storage = $rsrc->schema->storage; my $attrs = { %{$self->_resolved_attrs} }; + my $join_classifications; my $existing_group_by = delete $attrs->{group_by}; - my $needs_subq = defined $existing_group_by; - # simplify the joinmap and maybe decide if a subquery is necessary - my $relation_classifications = {}; + # do we need a subquery for any reason? + my $needs_subq = ( + defined $existing_group_by + or + # if {from} is unparseable wrap a subq + ref($attrs->{from}) ne 'ARRAY' + or + # limits call for a subq + $self->_has_resolved_attr(qw/rows offset/) + ); - if (ref($attrs->{from}) eq 'ARRAY') { - # if we already know we need a subq, no point of classifying relations - if (!$needs_subq and @{$attrs->{from}} > 1) { - $attrs->{from} = $storage->_prune_unused_joins ($attrs->{from}, $attrs->{select}, $cond, $attrs); + # simplify the joinmap, so we can further decide if a subq is necessary + if (!$needs_subq and @{$attrs->{from}} > 1) { + $attrs->{from} = $storage->_prune_unused_joins ($attrs->{from}, $attrs->{select}, $self->{cond}, $attrs); - $relation_classifications = $storage->_resolve_aliastypes_from_select_args ( + # check if there are any joins left after the prune + if ( @{$attrs->{from}} > 1 ) { + $join_classifications = $storage->_resolve_aliastypes_from_select_args ( [ @{$attrs->{from}}[1 .. $#{$attrs->{from}}] ], $attrs->{select}, - $cond, + $self->{cond}, $attrs ); + + # any non-pruneable joins imply subq + $needs_subq = scalar keys %{ $join_classifications->{restricting} || {} }; } } - else { - $needs_subq ||= 1; # if {from} is unparseable assume the worst - } + # check if the head is composite (by now all joins are thrown out unless $needs_subq) + $needs_subq ||= ( + (ref $attrs->{from}[0]) ne 'HASH' + or + ref $attrs->{from}[0]{ $attrs->{from}[0]{-alias} } + ); + + my ($cond, $guard); # do we need anything like a subquery? - if ( - ! $needs_subq - and - ! keys %{ $relation_classifications->{restricting} || {} } - and - ! $self->_has_resolved_attr(qw/rows offset/) # limits call for a subq - ) { + if (! $needs_subq) { # Most databases do not allow aliasing of tables in UPDATE/DELETE. Thus # a condition containing 'me' or other table prefixes will not work # at all. Tell SQLMaker to dequalify idents via a gross hack. - my $cond = do { + $cond = do { my $sqla = $rsrc->storage->sql_maker; local $sqla->{_dequalify_idents} = 1; \[ $sqla->_recurse_where($self->{cond}) ]; }; - return $rsrc->storage->$op( - $rsrc, - $op eq 'update' ? $values : (), - $cond, - ); } - - # we got this far - means it is time to wrap a subquery - my $idcols = $rsrc->_identifying_column_set || $self->throw_exception( - sprintf( - "Unable to perform complex resultset %s() without an identifying set of columns on source '%s'", - $op, - $rsrc->source_name, - ) - ); - - # make a new $rs selecting only the PKs (that's all we really need for the subq) - delete $attrs->{$_} for qw/collapse _collapse_order_by select _prefetch_selector_range as/; - $attrs->{columns} = [ map { "$attrs->{alias}.$_" } @$idcols ]; - $attrs->{group_by} = \ ''; # FIXME - this is an evil hack, it causes the optimiser to kick in and throw away the LEFT joins - my $subrs = (ref $self)->new($rsrc, $attrs); - - if (@$idcols == 1) { - return $storage->$op ( - $rsrc, - $op eq 'update' ? $values : (), - { $idcols->[0] => { -in => $subrs->as_query } }, - ); - } - elsif ($storage->_use_multicolumn_in) { - # This is hideously ugly, but SQLA does not understand multicol IN expressions - my $sql_maker = $storage->sql_maker; - my ($sql, @bind) = @${$subrs->as_query}; - $sql = sprintf ('(%s) IN %s', # the as_query already comes with a set of parenthesis - join (', ', map { $sql_maker->_quote ($_) } @$idcols), - $sql, + else { + # we got this far - means it is time to wrap a subquery + my $idcols = $rsrc->_identifying_column_set || $self->throw_exception( + sprintf( + "Unable to perform complex resultset %s() without an identifying set of columns on source '%s'", + $op, + $rsrc->source_name, + ) ); - return $storage->$op ( - $rsrc, - $op eq 'update' ? $values : (), - \[$sql, @bind], - ); - } - else { + # make a new $rs selecting only the PKs (that's all we really need for the subq) + delete $attrs->{$_} for qw/collapse _collapse_order_by select _prefetch_selector_range as/; + $attrs->{columns} = [ map { "$attrs->{alias}.$_" } @$idcols ]; + $attrs->{group_by} = \ ''; # FIXME - this is an evil hack, it causes the optimiser to kick in and throw away the LEFT joins + my $subrs = (ref $self)->new($rsrc, $attrs); - # if all else fails - get all primary keys and operate over a ORed set - # wrap in a transaction for consistency - # this is where the group_by starts to matter - if ( - $existing_group_by - or - keys %{ $relation_classifications->{multiplying} || {} } - ) { - # make sure if there is a supplied group_by it matches the columns compiled above - # perfectly. Anything else can not be sanely executed on most databases so croak - # right then and there - if ($existing_group_by) { - my @current_group_by = map - { $_ =~ /\./ ? $_ : "$attrs->{alias}.$_" } - @$existing_group_by - ; - - if ( - join ("\x00", sort @current_group_by) - ne - join ("\x00", sort @{$attrs->{columns}} ) - ) { - $self->throw_exception ( - "You have just attempted a $op operation on a resultset which does group_by" - . ' on columns other than the primary keys, while DBIC internally needs to retrieve' - . ' the primary keys in a subselect. All sane RDBMS engines do not support this' - . ' kind of queries. Please retry the operation with a modified group_by or' - . ' without using one at all.' - ); + if (@$idcols == 1) { + $cond = { $idcols->[0] => { -in => $subrs->as_query } }; + } + elsif ($storage->_use_multicolumn_in) { + # no syntax for calling this properly yet + # !!! EXPERIMENTAL API !!! WILL CHANGE !!! + $cond = $storage->sql_maker->_where_op_multicolumn_in ( + $idcols, # how do I convey a list of idents...? can binds reside on lhs? + $subrs->as_query + ), + } + else { + # if all else fails - get all primary keys and operate over a ORed set + # wrap in a transaction for consistency + # this is where the group_by/multiplication starts to matter + if ( + $existing_group_by + or + keys %{ $join_classifications->{multiplying} || {} } + ) { + # make sure if there is a supplied group_by it matches the columns compiled above + # perfectly. Anything else can not be sanely executed on most databases so croak + # right then and there + if ($existing_group_by) { + my @current_group_by = map + { $_ =~ /\./ ? $_ : "$attrs->{alias}.$_" } + @$existing_group_by + ; + + if ( + join ("\x00", sort @current_group_by) + ne + join ("\x00", sort @{$attrs->{columns}} ) + ) { + $self->throw_exception ( + "You have just attempted a $op operation on a resultset which does group_by" + . ' on columns other than the primary keys, while DBIC internally needs to retrieve' + . ' the primary keys in a subselect. All sane RDBMS engines do not support this' + . ' kind of queries. Please retry the operation with a modified group_by or' + . ' without using one at all.' + ); + } } - } - $subrs = $subrs->search({}, { group_by => $attrs->{columns} }); - } + $subrs = $subrs->search({}, { group_by => $attrs->{columns} }); + } - my $guard = $storage->txn_scope_guard; + $guard = $storage->txn_scope_guard; - my @op_condition; - for my $row ($subrs->cursor->all) { - push @op_condition, { map - { $idcols->[$_] => $row->[$_] } - (0 .. $#$idcols) - }; + $cond = []; + for my $row ($subrs->cursor->all) { + push @$cond, { map + { $idcols->[$_] => $row->[$_] } + (0 .. $#$idcols) + }; + } } + } - my $res = $storage->$op ( - $rsrc, - $op eq 'update' ? $values : (), - \@op_condition, - ); + my $res = $storage->$op ( + $rsrc, + $op eq 'update' ? $values : (), + $cond, + ); - $guard->commit; + $guard->commit if $guard; - return $res; - } + return $res; } =head2 update @@ -2117,10 +2105,7 @@ sub populate { return unless @$data; if(defined wantarray) { - my @created; - foreach my $item (@$data) { - push(@created, $self->create($item)); - } + my @created = map { $self->create($_) } @$data; return wantarray ? @created : \@created; } else { @@ -2175,14 +2160,12 @@ sub populate { ## inherit the data locked in the conditions of the resultset my ($rs_data) = $self->_merge_with_rscond({}); delete @{$rs_data}{@columns}; - my @inherit_cols = keys %$rs_data; - my @inherit_data = values %$rs_data; ## do bulk insert on current row $rsrc->storage->insert_bulk( $rsrc, - [@columns, @inherit_cols], - [ map { [ @$_{@columns}, @inherit_data ] } @$data ], + [@columns, keys %$rs_data], + [ map { [ @$_{@columns}, values %$rs_data ] } @$data ], ); ## do the has_many relationships @@ -2531,7 +2514,7 @@ This is generally used as the RHS for a subquery. sub as_query { my $self = shift; - my $attrs = $self->_resolved_attrs_copy; + my $attrs = { %{ $self->_resolved_attrs } }; # For future use: # @@ -3113,9 +3096,7 @@ source alias of the current result set: =cut sub current_source_alias { - my ($self) = @_; - - return ($self->{attrs} || {})->{alias} || 'me'; + return (shift->{attrs} || {})->{alias} || 'me'; } =head2 as_subselect_rs @@ -3297,12 +3278,6 @@ sub _chain_relationship { return {%$attrs, from => $from, seen_join => $seen}; } -# too many times we have to do $attrs = { %{$self->_resolved_attrs} } -sub _resolved_attrs_copy { - my $self = shift; - return { %{$self->_resolved_attrs (@_)} }; -} - sub _resolved_attrs { my $self = shift; return $self->{_attrs} if $self->{_attrs};