X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FResultSet.pm;h=c220dd92b957bf7c7b23f671c1536af3f68c1291;hb=7d7d697500011de9ac151b6303f27e56f696cec6;hp=c8a2d7748529504efef2eba6dc0173669d335dae;hpb=86cc339a6d3fd0dfd144f511c893affa897c19a2;p=dbsrgits%2FDBIx-Class-Historic.git diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm index c8a2d77..c220dd9 100644 --- a/lib/DBIx/Class/ResultSet.pm +++ b/lib/DBIx/Class/ResultSet.pm @@ -46,27 +46,13 @@ A new ResultSet is returned from calling L on an existing ResultSet. The new one will contain all the conditions of the original, plus any new conditions added in the C call. -A ResultSet is also an iterator. L is used to return all the -Ls the ResultSet represents. +A ResultSet also incorporates an implicit iterator. L and L +can be used to walk through all the Ls the ResultSet +represents. The query that the ResultSet represents is B executed against the database when these methods are called: - -=over - -=item L - -=item L - -=item L - -=item L - -=item L - -=item L - -=back +L L L L L L =head1 EXAMPLES @@ -674,7 +660,8 @@ L for more information. sub cursor { my ($self) = @_; - my $attrs = { %{$self->_resolved_attrs} }; + my $attrs = $self->_resolved_attrs_copy; + return $self->{cursor} ||= $self->result_source->storage->select($attrs->{from}, $attrs->{select}, $attrs->{where},$attrs); @@ -725,7 +712,8 @@ sub single { $self->throw_exception('single() only takes search conditions, no attributes. You want ->search( $cond, $attrs )->single()'); } - my $attrs = { %{$self->_resolved_attrs} }; + my $attrs = $self->_resolved_attrs_copy; + if ($where) { if (defined $attrs->{where}) { $attrs->{where} = { @@ -752,6 +740,7 @@ sub single { return (@data ? ($self->_construct_object(@data))[0] : undef); } + # _is_unique_query # # Try to determine if the specified query is guaranteed to be unique, based on @@ -870,10 +859,10 @@ instead. An example conversion is: sub search_like { my $class = shift; - carp join ("\n", - 'search_like() is deprecated and will be removed in 0.09.', - 'Instead use ->search({ x => { -like => "y%" } })', - '(note the outer pair of {}s - they are important!)' + carp ( + 'search_like() is deprecated and will be removed in DBIC version 0.09.' + .' Instead use ->search({ x => { -like => "y%" } })' + .' (note the outer pair of {}s - they are important!)' ); my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {}); my $query = ref $_[0] eq 'HASH' ? { %{shift()} }: {@_}; @@ -1145,8 +1134,8 @@ sub result_class { =back Performs an SQL C with the same query as the resultset was built -with to find the number of elements. If passed arguments, does a search -on the resultset and counts the results of that. +with to find the number of elements. Passing arguments is equivalent to +C<< $rs->search ($cond, \%attrs)->count >> =cut @@ -1155,74 +1144,15 @@ sub count { return $self->search(@_)->count if @_ and defined $_[0]; return scalar @{ $self->get_cache } if $self->get_cache; - my @subq_attrs = qw/prefetch collapse distinct group_by having/; - my $attrs = $self->_resolved_attrs; - - # if we are not paged - we are simply asking for a limit - if (not $attrs->{page} and not $attrs->{software_limit}) { - push @subq_attrs, qw/rows offset/; - } - - return $self->_has_attr (@subq_attrs) - ? $self->_count_subq - : $self->_count_simple -} - -sub _count_subq { - my $self = shift; - - my $attrs = { %{$self->_resolved_attrs} }; - - # copy for the subquery, we need to do some adjustments to it too - my $sub_attrs = { %$attrs }; - - # these can not go in the subquery either - delete $sub_attrs->{$_} for qw/prefetch collapse select +select as +as columns +columns/; - - # force a group_by and the same set of columns (most databases require this) - $sub_attrs->{columns} = $sub_attrs->{group_by} ||= [ map { "$attrs->{alias}.$_" } ($self->result_source->primary_columns) ]; - - $attrs->{from} = [{ - count_subq => (ref $self)->new ($self->result_source, $sub_attrs )->as_query - }]; + my $meth = $self->_has_attr (qw/prefetch collapse distinct group_by/) + ? 'count_grouped' + : 'count' + ; - # the subquery replaces this - delete $attrs->{$_} for qw/where bind prefetch collapse distinct group_by having having_bind/; - - return $self->__count ($attrs); -} - -sub _count_simple { - my $self = shift; - - my $count = $self->__count; - return 0 unless $count; - - # need to take offset from resolved attrs - - my $attrs = $self->_resolved_attrs; - - $count -= $attrs->{offset} if $attrs->{offset}; - $count = $attrs->{rows} if $attrs->{rows} and $attrs->{rows} < $count; - $count = 0 if ($count < 0); - return $count; -} - -sub __count { - my ($self, $attrs) = @_; - - $attrs ||= { %{$self->_resolved_attrs} }; - - # take off any column specs, any pagers, record_filter is cdbi, and no point of ordering a count - delete $attrs->{$_} for (qw/columns +columns select +select as +as rows offset page pager order_by record_filter/); - - $attrs->{select} = { count => '*' }; - $attrs->{as} = [qw/count/]; - - my $tmp_rs = (ref $self)->new($self->result_source, $attrs); - my ($count) = $tmp_rs->cursor->next; + my $attrs = $self->_resolved_attrs_copy; + my $rsrc = $self->result_source; - return $count; + return $rsrc->storage->$meth ($rsrc, $attrs); } sub _bool { @@ -1352,7 +1282,7 @@ sub _rs_update_delete { if ($needs_group_by_subq or $needs_subq) { # make a new $rs selecting only the PKs (that's all we really need) - my $attrs = $self->_resolved_attrs; + my $attrs = $self->_resolved_attrs_copy; delete $attrs->{$_} for qw/prefetch collapse select +select as +as columns +columns/; $attrs->{columns} = [ map { "$attrs->{alias}.$_" } ($self->result_source->primary_columns) ]; @@ -1388,7 +1318,7 @@ sub _rs_update_delete { my $subrs = (ref $self)->new($rsrc, $attrs); - return $self->result_source->storage->subq_update_delete($subrs, $op, $values); + return $self->result_source->storage->_subq_update_delete($subrs, $op, $values); } else { return $rsrc->storage->$op( @@ -1513,7 +1443,7 @@ sub update_all { =item Arguments: none -=item Return Value: 1 +=item Return Value: $storage_rv =back @@ -1521,11 +1451,8 @@ Deletes the contents of the resultset from its result source. Note that this will not run DBIC cascade triggers. See L if you need triggers to run. See also L. -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:- - -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. +Return value will be the amount of rows deleted; exact type of return value +is storage-dependent. =cut @@ -1654,13 +1581,19 @@ sub populate { ## do the belongs_to relationships foreach my $index (0..$#$data) { - if( grep { !defined $data->[$index]->{$_} } @pks ) { - my @ret = $self->populate($data); - return; + + # delegate to create() for any dataset without primary keys with specified relationships + if (grep { !defined $data->[$index]->{$_} } @pks ) { + for my $r (@rels) { + if (grep { ref $data->[$index]{$r} eq $_ } qw/HASH ARRAY/) { # a related set must be a HASH or AoH + my @ret = $self->populate($data); + return; + } + } } foreach my $rel (@rels) { - next unless $data->[$index]->{$rel} && ref $data->[$index]->{$rel} eq "HASH"; + next unless ref $data->[$index]->{$rel} eq "HASH"; my $result = $self->related_resultset($rel)->create($data->[$index]->{$rel}); my ($reverse) = keys %{$self->result_source->reverse_relationship_info($rel)}; my $related = $result->result_source->_resolve_condition( @@ -1992,7 +1925,16 @@ B: This feature is still experimental. =cut -sub as_query { return shift->cursor->as_query(@_) } +sub as_query { + my $self = shift; + + my $attrs = $self->_resolved_attrs_copy; + + my ($sqlbind, $bind_attrs) = $self->result_source->storage + ->_select_args_to_query ($attrs->{from}, $attrs->{select}, $attrs->{where}, $attrs); + + return $sqlbind; +} =head2 find_or_new @@ -2033,8 +1975,10 @@ sub find_or_new { my $self = shift; my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {}); my $hash = ref $_[0] eq 'HASH' ? shift : {@_}; - my $exists = $self->find($hash, $attrs); - return defined $exists ? $exists : $self->new_result($hash); + if (keys %$hash and my $row = $self->find($hash, $attrs) ) { + return $row; + } + return $self->new_result($hash); } =head2 create @@ -2164,8 +2108,10 @@ sub find_or_create { my $self = shift; my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {}); my $hash = ref $_[0] eq 'HASH' ? shift : {@_}; - my $exists = $self->find($hash, $attrs); - return defined $exists ? $exists : $self->create($hash); + if (keys %$hash and my $row = $self->find($hash, $attrs) ) { + return $row; + } + return $self->create($hash); } =head2 update_or_create @@ -2490,10 +2436,17 @@ sub _resolve_from { my $source = $self->result_source; my $attrs = $self->{attrs}; - my $from = $attrs->{from} - || [ { $attrs->{alias} => $source->from } ]; + my $from = [ @{ + $attrs->{from} + || + [{ + -result_source => $source, + -alias => $attrs->{alias}, + $attrs->{alias} => $source->from, + }] + }]; - my $seen = { %{$attrs->{seen_join}||{}} }; + my $seen = { %{$attrs->{seen_join} || {} } }; # we need to take the prefetch the attrs into account before we # ->_resolve_join as otherwise they get lost - captainL @@ -2510,6 +2463,12 @@ sub _resolve_from { return ($from,$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}; @@ -2590,7 +2549,11 @@ sub _resolved_attrs { push( @{ $attrs->{as} }, @$adds ); } - $attrs->{from} ||= [ { $self->{attrs}{alias} => $source->from } ]; + $attrs->{from} ||= [ { + -result_source => $source, + -alias => $self->{attrs}{alias}, + $self->{attrs}{alias} => $source->from, + } ]; if ( exists $attrs->{join} || exists $attrs->{prefetch} ) { my $join = delete $attrs->{join} || {}; @@ -2610,8 +2573,6 @@ sub _resolved_attrs { } - $attrs->{group_by} ||= $attrs->{select} - if delete $attrs->{distinct}; if ( $attrs->{order_by} ) { $attrs->{order_by} = ( ref( $attrs->{order_by} ) eq 'ARRAY' @@ -2623,6 +2584,14 @@ sub _resolved_attrs { $attrs->{order_by} = []; } + # If the order_by is otherwise empty - we will use this for TOP limit + # emulation and the like. + # Although this is needed only if the order_by is not defined, it is + # actually cheaper to just populate this rather than properly examining + # order_by (stuf like [ {} ] and the like) + $attrs->{_virtual_order_by} = [ $self->result_source->primary_columns ]; + + my $collapse = $attrs->{collapse} || {}; if ( my $prefetch = delete $attrs->{prefetch} ) { $prefetch = $self->_merge_attr( {}, $prefetch ); @@ -2638,6 +2607,11 @@ sub _resolved_attrs { } push( @{ $attrs->{order_by} }, @pre_order ); } + + if (delete $attrs->{distinct}) { + $attrs->{group_by} ||= [ grep { !ref($_) || (ref($_) ne 'HASH') } @{$attrs->{select}} ]; + } + $attrs->{collapse} = $collapse; if ( $attrs->{page} and not defined $attrs->{offset} ) { @@ -2660,7 +2634,7 @@ sub _joinpath_aliases { my $p = $paths; $p = $p->{$_} ||= {} for @{$j->[0]{-join_path}}; - push @{$p->{-join_aliases} }, $j->[0]{-join_alias}; + push @{$p->{-join_aliases} }, $j->[0]{-alias}; } return $paths;