X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FResultSet.pm;h=f8bed0e25d60a1670f31d9ee11f9104dba623a8e;hb=f685632da1dcff2c4d671f0c4b7338cbd8753b58;hp=7611945b3069f4e2ef47c1892d00d1c1f42c5563;hpb=038af71cf6f6c77cb1380378d4887a7da03fe2b2;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm index 7611945..f8bed0e 100644 --- a/lib/DBIx/Class/ResultSet.pm +++ b/lib/DBIx/Class/ResultSet.pm @@ -46,29 +46,15 @@ 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: +L L L L L L -=over - -=item L - -=item L - -=item L - -=item L - -=item L - -=item L - -=back - -=head1 EXAMPLES +=head1 EXAMPLES =head2 Chaining resultsets @@ -193,7 +179,7 @@ sub new { return $class->new_result(@_) if ref $class; my ($source, $attrs) = @_; - $source = $source->handle + $source = $source->handle unless $source->isa('DBIx::Class::ResultSourceHandle'); $attrs = { %{$attrs||{}} }; @@ -296,7 +282,7 @@ sub search_rs { unless ( (@_ && defined($_[0])) # @_ == () or (undef) - || + || (keys %$attrs # empty attrs or only 'safe' attrs && List::Util::first { !$safe{$_} } keys %$attrs) ) { @@ -393,7 +379,7 @@ Pass a literal chunk of SQL to be added to the conditional part of the resultset query. CAVEAT: C is provided for Class::DBI compatibility and should -only be used in that context. C is a convenience method. +only be used in that context. C is a convenience method. It is equivalent to calling $schema->search(\[]), but if you want to ensure columns are bound correctly, use C. @@ -403,14 +389,14 @@ Example of how to use C instead of C my @cds = $cd_rs->search(\[ 'cdid = ? AND (artist = ? OR artist = ?)', [ 'cdid', 2 ], [ 'artist', 1 ], [ 'artist', 2 ] ]); -See L and +See L and L for searching techniques that do not require C. =cut sub search_literal { - my ($self, $sql, @bind) = @_; + my ($self, $sql, @bind) = @_; my $attr; if ( @bind && ref($bind[-1]) eq 'HASH' ) { $attr = pop @bind; @@ -505,7 +491,7 @@ sub find { && ($info = $self->result_source->relationship_info($key))) { my $val = delete $input_query->{$key}; next KEY if (ref($val) eq 'ARRAY'); # has_many for multi_create - my $rel_q = $self->result_source->resolve_condition( + my $rel_q = $self->result_source->_resolve_condition( $info->{cond}, $val, $key ); die "Can't handle OR join condition in find" if ref($rel_q) eq 'ARRAY'; @@ -527,6 +513,14 @@ sub find { my $unique_query = $self->_build_unique_query($input_query, \@unique_cols); $query = $self->_add_alias($unique_query, $alias); } + elsif ($self->{attrs}{accessor} and $self->{attrs}{accessor} eq 'single') { + # This means that we got here after a merger of relationship conditions + # in ::Relationship::Base::search_related (the row method), and furthermore + # the relationship is of the 'single' type. This means that the condition + # provided by the relationship (already attached to $self) is sufficient, + # as there can be only one row in the databse that would satisfy the + # relationship + } else { my @unique_queries = $self->_unique_queries($input_query, $attrs); $query = @unique_queries @@ -535,27 +529,14 @@ sub find { } # Run the query - if (keys %$attrs) { - my $rs = $self->search($query, $attrs); - if (keys %{$rs->_resolved_attrs->{collapse}}) { - my $row = $rs->next; - carp "Query returned more than one row" if $rs->next; - return $row; - } - else { - return $rs->single; - } + my $rs = $self->search ($query, $attrs); + if (keys %{$rs->_resolved_attrs->{collapse}}) { + my $row = $rs->next; + carp "Query returned more than one row" if $rs->next; + return $row; } else { - if (keys %{$self->_resolved_attrs->{collapse}}) { - my $rs = $self->search($query); - my $row = $rs->next; - carp "Query returned more than one row" if $rs->next; - return $row; - } - else { - return $self->single($query); - } + return $rs->single; } } @@ -674,7 +655,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); @@ -711,10 +693,14 @@ a warning: Query returned more than one row -In this case, you should be using L or L instead, or if you really -know what you are doing, use the L attribute to explicitly limit the size +In this case, you should be using L or L instead, or if you really +know what you are doing, use the L attribute to explicitly limit the size of the resultset. +This method will also throw an exception if it is called on a resultset prefetching +has_many, as such a prefetch implies fetching multiple rows from the database in +order to assemble the resulting object. + =back =cut @@ -725,7 +711,14 @@ 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 (keys %{$attrs->{collapse}}) { + $self->throw_exception( + 'single() can not be used on resultsets prefetching has_many. Use find( \%cond ) or next() instead' + ); + } + if ($where) { if (defined $attrs->{where}) { $attrs->{where} = { @@ -752,6 +745,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 @@ -796,19 +790,16 @@ sub _collapse_query { if (ref $query eq 'ARRAY') { foreach my $subquery (@$query) { next unless ref $subquery; # -or -# warn "ARRAY: " . Dumper $subquery; $collapsed = $self->_collapse_query($subquery, $collapsed); } } elsif (ref $query eq 'HASH') { if (keys %$query and (keys %$query)[0] eq '-and') { foreach my $subquery (@{$query->{-and}}) { -# warn "HASH: " . Dumper $subquery; $collapsed = $self->_collapse_query($subquery, $collapsed); } } else { -# warn "LEAF: " . Dumper $query; foreach my $col (keys %$query) { my $value = $query->{$col}; $collapsed->{$col}{$value}++; @@ -873,10 +864,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()} }: {@_}; @@ -966,7 +957,9 @@ sub next { sub _construct_object { my ($self, @row) = @_; - my $info = $self->_collapse_result($self->{_attrs}{as}, \@row); + + my $info = $self->_collapse_result($self->{_attrs}{as}, \@row) + or return (); my @new = $self->result_class->inflate_result($self->result_source, @$info); @new = $self->{_attrs}{record_filter}->(@new) if exists $self->{_attrs}{record_filter}; @@ -976,6 +969,14 @@ sub _construct_object { sub _collapse_result { my ($self, $as_proto, $row) = @_; + # if the first row that ever came in is totally empty - this means we got + # hit by a smooth^Wempty left-joined resultset. Just noop in that case + # instead of producing a {} + # + # Note the double-defined - $row may be [ 0, '' ] + # + return undef unless ( defined List::Util::first { defined $_ } (@$row) ); + my @copy = @$row; # 'foo' => [ undef, 'foo' ] @@ -1019,7 +1020,7 @@ sub _collapse_result { do { # no need to check anything at the front, we always want the first row my %const; - + foreach my $this_as (@construct_as) { $const{$this_as->[0]||''}{$this_as->[1]} = shift(@copy); } @@ -1066,7 +1067,7 @@ sub _collapse_result { foreach my $p (@parts) { $target = $target->[1]->{$p} ||= []; $cur .= ".${p}"; - if ($cur eq ".${key}" && (my @ckey = @{$collapse{$cur}||[]})) { + if ($cur eq ".${key}" && (my @ckey = @{$collapse{$cur}||[]})) { # collapsing at this point and on final part my $pos = $collapse_pos{$cur}; CK: foreach my $ck (@ckey) { @@ -1117,8 +1118,8 @@ is derived. =back -An accessor for the class to use when creating row objects. Defaults to -C<< result_source->result_class >> - which in most cases is the name of the +An accessor for the class to use when creating row objects. Defaults to +C<< result_source->result_class >> - which in most cases is the name of the L<"table"|DBIx::Class::Manual::Glossary/"ResultSource"> class. Note that changing the result_class will also remove any components @@ -1148,8 +1149,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 @@ -1157,41 +1158,220 @@ sub count { my $self = shift; return $self->search(@_)->count if @_ and defined $_[0]; return scalar @{ $self->get_cache } if $self->get_cache; - my $count = $self->_count; - return 0 unless $count; - # need to take offset from resolved attrs + my $attrs = $self->_resolved_attrs_copy; + + # this is a little optimization - it is faster to do the limit + # adjustments in software, instead of a subquery + my $rows = delete $attrs->{rows}; + my $offset = delete $attrs->{offset}; - $count -= $self->{_attrs}{offset} if $self->{_attrs}{offset}; - $count = $self->{attrs}{rows} if - $self->{attrs}{rows} and $self->{attrs}{rows} < $count; + my $crs; + if ($self->_has_resolved_attr (qw/collapse group_by/)) { + $crs = $self->_count_subq_rs ($attrs); + } + else { + $crs = $self->_count_rs ($attrs); + } + my $count = $crs->next; + + $count -= $offset if $offset; + $count = $rows if $rows and $rows < $count; $count = 0 if ($count < 0); + return $count; } -sub _count { # Separated out so pager can get the full count +=head2 count_rs + +=over 4 + +=item Arguments: $cond, \%attrs?? + +=item Return Value: $count_rs + +=back + +Same as L but returns a L object. +This can be very handy for subqueries: + + ->search( { amount => $some_rs->count_rs->as_query } ) + +As with regular resultsets the SQL query will be executed only after +the resultset is accessed via L or L. That would return +the same single value obtainable via L. + +=cut + +sub count_rs { my $self = shift; - my $attrs = { %{$self->_resolved_attrs} }; + return $self->search(@_)->count_rs if @_; + + # this may look like a lack of abstraction (count() does about the same) + # but in fact an _rs *must* use a subquery for the limits, as the + # software based limiting can not be ported if this $rs is to be used + # in a subquery itself (i.e. ->as_query) + if ($self->_has_resolved_attr (qw/collapse group_by offset rows/)) { + return $self->_count_subq_rs; + } + else { + return $self->_count_rs; + } +} + +# +# returns a ResultSetColumn object tied to the count query +# +sub _count_rs { + my ($self, $attrs) = @_; + + my $rsrc = $self->result_source; + $attrs ||= $self->_resolved_attrs; + + my $tmp_attrs = { %$attrs }; + + # take off any limits, record_filter is cdbi, and no point of ordering a count + delete $tmp_attrs->{$_} for (qw/select as rows offset order_by record_filter/); + + # overwrite the selector (supplied by the storage) + $tmp_attrs->{select} = $rsrc->storage->_count_select ($rsrc, $tmp_attrs); + $tmp_attrs->{as} = 'count'; - if (my $group_by = $attrs->{group_by}) { - delete $attrs->{order_by}; + # read the comment on top of the actual function to see what this does + $tmp_attrs->{from} = $self->_switch_to_inner_join_if_needed ( + $tmp_attrs->{from}, $tmp_attrs->{alias} + ); + + my $tmp_rs = $rsrc->resultset_class->new($rsrc, $tmp_attrs)->get_column ('count'); + + return $tmp_rs; +} + +# +# same as above but uses a subquery +# +sub _count_subq_rs { + my ($self, $attrs) = @_; - $attrs->{select} = $group_by; - $attrs->{from} = [ { 'mesub' => (ref $self)->new($self->result_source, $attrs)->cursor->as_query } ]; - delete $attrs->{where}; + my $rsrc = $self->result_source; + $attrs ||= $self->_resolved_attrs_copy; + + my $sub_attrs = { %$attrs }; + + # extra selectors do not go in the subquery and there is no point of ordering it + delete $sub_attrs->{$_} for qw/collapse prefetch_select select as order_by/; + + # if we prefetch, we group_by primary keys only as this is what we would get out of the rs via ->next/->all + # clobber old group_by regardless + if ( keys %{$attrs->{collapse}} ) { + $sub_attrs->{group_by} = [ map { "$attrs->{alias}.$_" } ($rsrc->primary_columns) ] } - $attrs->{select} = { count => '*' }; - $attrs->{as} = [qw/count/]; + $sub_attrs->{select} = $rsrc->storage->_subq_count_select ($rsrc, $sub_attrs); + + # read the comment on top of the actual function to see what this does + $sub_attrs->{from} = $self->_switch_to_inner_join_if_needed ( + $sub_attrs->{from}, $sub_attrs->{alias} + ); - # 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/; + $attrs->{from} = [{ + count_subq => $rsrc->resultset_class->new ($rsrc, $sub_attrs )->as_query + }]; - my $tmp_rs = (ref $self)->new($self->result_source, $attrs); - my ($count) = $tmp_rs->cursor->next; - return $count; + # the subquery replaces this + delete $attrs->{$_} for qw/where bind collapse group_by having having_bind rows offset/; + + return $self->_count_rs ($attrs); } + +# The DBIC relationship chaining implementation is pretty simple - every +# new related_relationship is pushed onto the {from} stack, and the {select} +# window simply slides further in. This means that when we count somewhere +# in the middle, we got to make sure that everything in the join chain is an +# actual inner join, otherwise the count will come back with unpredictable +# results (a resultset may be generated with _some_ rows regardless of if +# the relation which the $rs currently selects has rows or not). E.g. +# $artist_rs->cds->count - normally generates: +# SELECT COUNT( * ) FROM artist me LEFT JOIN cd cds ON cds.artist = me.artistid +# which actually returns the number of artists * (number of cds || 1) +# +# So what we do here is crawl {from}, determine if the current alias is at +# the top of the stack, and if not - make sure the chain is inner-joined down +# to the root. +# +sub _switch_to_inner_join_if_needed { + my ($self, $from, $alias) = @_; + + return $from if ( + ref $from ne 'ARRAY' + || + ref $from->[0] ne 'HASH' + || + ! $from->[0]{-alias} + || + $from->[0]{-alias} eq $alias + ); + + # this would be the case with a subquery - we'll never find + # the target as it is not in the parseable part of {from} + return $from if @$from == 1; + + my (@switch_idx, $found_target); + + JOINSCAN: + for my $i (1 .. $#$from) { + + push @switch_idx, $i; + my $j = $from->[$i]; + my $jalias = $j->[0]{-alias}; + + # we found our current target - delete any siblings (same level joins) + # and bail out + if ($jalias eq $alias) { + $found_target++; + + my $cur_depth = $j->[0]{-relation_chain_depth}; + # we are -1, so look at -2 + while (@switch_idx > 1 + && $from->[$switch_idx[-2]][0]{-relation_chain_depth} == $cur_depth + ) { + splice @switch_idx, -2, 1; + } + + last JOINSCAN; + } + } + + # something else went wrong + return $from unless $found_target; + + # So it looks like we will have to switch some stuff around. + # local() is useless here as we will be leaving the scope + # anyway, and deep cloning is just too fucking expensive + # So replace the inner hashref manually + my @new_from; + my $sw_idx = { map { $_ => 1 } @switch_idx }; + + for my $i (0 .. $#$from) { + if ($sw_idx->{$i}) { + my %attrs = %{$from->[$i][0]}; + delete $attrs{-join_type}; + + push @new_from, [ + \%attrs, + @{$from->[$i]}[ 1 .. $#{$from->[$i]} ], + ]; + } + else { + push @new_from, $from->[$i]; + } + } + + return \@new_from; +} + + sub _bool { return 1; } @@ -1238,13 +1418,12 @@ sub all { my @obj; - # TODO: don't call resolve here if (keys %{$self->_resolved_attrs->{collapse}}) { -# if ($self->{attrs}{prefetch}) { - # Using $self->cursor->all is really just an optimisation. - # If we're collapsing has_many prefetches it probably makes - # very little difference, and this is cleaner than hacking - # _construct_object to survive the approach + # Using $self->cursor->all is really just an optimisation. + # If we're collapsing has_many prefetches it probably makes + # very little difference, and this is cleaner than hacking + # _construct_object to survive the approach + $self->cursor->reset; my @row = $self->cursor->next; while (@row) { push(@obj, $self->_construct_object(@row)); @@ -1257,6 +1436,7 @@ sub all { } $self->set_cache(\@obj) if $self->{attrs}{cache}; + return @obj; } @@ -1271,6 +1451,8 @@ sub all { =back Resets the resultset's cursor, so you can iterate through the elements again. +Implicitly resets the storage cursor, so a subsequent L will trigger +another query. =cut @@ -1301,6 +1483,72 @@ sub first { return $_[0]->reset->next; } + +# _rs_update_delete +# +# Determines whether and what type of subquery is required for the $rs operation. +# If grouping is necessary either supplies its own, or verifies the current one +# After all is done delegates to the proper storage method. + +sub _rs_update_delete { + my ($self, $op, $values) = @_; + + my $rsrc = $self->result_source; + + my $needs_group_by_subq = $self->_has_resolved_attr (qw/collapse group_by -join/); + my $needs_subq = $self->_has_resolved_attr (qw/row offset/); + + 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_copy; + + delete $attrs->{$_} for qw/collapse select as/; + $attrs->{columns} = [ map { "$attrs->{alias}.$_" } ($self->result_source->primary_columns) ]; + + if ($needs_group_by_subq) { + # make sure no group_by was supplied, or if there is one - make sure it matches + # the columns compiled above perfectly. Anything else can not be sanely executed + # on most databases so croak right then and there + + if (my $g = $attrs->{group_by}) { + my @current_group_by = map + { $_ =~ /\./ ? $_ : "$attrs->{alias}.$_" } + (ref $g eq 'ARRAY' ? @$g : $g ); + + 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.' + ); + } + } + else { + $attrs->{group_by} = $attrs->{columns}; + } + } + + my $subrs = (ref $self)->new($rsrc, $attrs); + + return $self->result_source->storage->_subq_update_delete($subrs, $op, $values); + } + else { + return $rsrc->storage->$op( + $rsrc, + $op eq 'update' ? $values : (), + $self->_cond_for_update_delete, + ); + } +} + + # _cond_for_update_delete # # update/delete require the condition to be modified to handle @@ -1315,8 +1563,44 @@ sub _cond_for_update_delete { # No-op. No condition, we're updating/deleting everything return $cond unless ref $full_cond; - foreach my $pk ($self->result_source->primary_columns) { - $cond->{$pk} = { -in => $self->get_column($pk)->as_query }; + 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"); } return $cond; @@ -1341,14 +1625,10 @@ if no records were updated; exact type of success value is storage-dependent. sub update { my ($self, $values) = @_; - $self->throw_exception("Values for update must be a hash") + $self->throw_exception('Values for update must be a hash') unless ref $values eq 'HASH'; - my $cond = $self->_cond_for_update_delete; - - return $self->result_source->storage->update( - $self->result_source, $values, $cond - ); + return $self->_rs_update_delete ('update', $values); } =head2 update_all @@ -1368,7 +1648,7 @@ will run DBIC cascade triggers, while L will not. sub update_all { my ($self, $values) = @_; - $self->throw_exception("Values for update must be a hash") + $self->throw_exception('Values for update_all must be a hash') unless ref $values eq 'HASH'; foreach my $obj ($self->all) { $obj->set_columns($values)->update; @@ -1382,7 +1662,7 @@ sub update_all { =item Arguments: none -=item Return Value: 1 +=item Return Value: $storage_rv =back @@ -1390,23 +1670,17 @@ 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 sub delete { - my ($self) = @_; - $self->throw_exception("Delete should not be passed any arguments") - if $_[1]; - - my $cond = $self->_cond_for_update_delete; + my $self = shift; + $self->throw_exception('delete does not accept any arguments') + if @_; - $self->result_source->storage->delete($self->result_source, $cond); - return 1; + return $self->_rs_update_delete ('delete'); } =head2 delete_all @@ -1425,7 +1699,10 @@ will run DBIC cascade triggers, while L will not. =cut sub delete_all { - my ($self) = @_; + my $self = shift; + $self->throw_exception('delete_all does not accept any arguments') + if @_; + $_->delete for $self->all; return 1; } @@ -1443,19 +1720,20 @@ For the arrayref of hashrefs style each hashref should be a structure suitable forsubmitting to a $resultset->create(...) method. In void context, C in L is used -to insert the data, as this is a faster method. +to insert the data, as this is a faster method. Otherwise, each set of data is inserted into the database using -L, and a arrayref of the resulting row -objects is returned. +L, and the resulting objects are +accumulated into an array. The array itself, or an array reference +is returned depending on scalar or list context. Example: Assuming an Artist Class that has many CDs Classes relating: my $Artist_rs = $schema->resultset("Artist"); - - ## Void Context Example + + ## Void Context Example $Artist_rs->populate([ - { artistid => 4, name => 'Manufactured Crap', cds => [ + { artistid => 4, name => 'Manufactured Crap', cds => [ { title => 'My First CD', year => 2006 }, { title => 'Yet More Tweeny-Pop crap', year => 2007 }, ], @@ -1467,7 +1745,7 @@ Example: Assuming an Artist Class that has many CDs Classes relating: ], }, ]); - + ## Array Context Example my ($ArtistOne, $ArtistTwo, $ArtistThree) = $Artist_rs->populate([ { name => "Artist One"}, @@ -1477,7 +1755,7 @@ Example: Assuming an Artist Class that has many CDs Classes relating: { title => "Second CD", year => 2008}, ]} ]); - + print $ArtistOne->name; ## response is 'Artist One' print $ArtistThree->cds->count ## reponse is '2' @@ -1493,11 +1771,11 @@ example: ]); Please note an important effect on your data when choosing between void and -wantarray context. Since void context goes straight to C in +wantarray context. Since void context goes straight to C in L this will skip any component that is overriding -c. So if you are using something like L to -create primary keys for you, you will find that your PKs are empty. In this -case you will have to use the wantarray context in order to create those +C. So if you are using something like L to +create primary keys for you, you will find that your PKs are empty. In this +case you will have to use the wantarray context in order to create those values. =cut @@ -1507,40 +1785,46 @@ sub populate { my $data = ref $_[0][0] eq 'HASH' ? $_[0] : ref $_[0][0] eq 'ARRAY' ? $self->_normalize_populate_args($_[0]) : $self->throw_exception('Populate expects an arrayref of hashes or arrayref of arrayrefs'); - + if(defined wantarray) { my @created; foreach my $item (@$data) { push(@created, $self->create($item)); } - return @created; + return wantarray ? @created : \@created; } else { my ($first, @rest) = @$data; my @names = grep {!ref $first->{$_}} keys %$first; my @rels = grep { $self->result_source->has_relationship($_) } keys %$first; - my @pks = $self->result_source->primary_columns; + my @pks = $self->result_source->primary_columns; - ## do the belongs_to relationships + ## 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( + my $related = $result->result_source->_resolve_condition( $result->result_source->relationship_info($reverse)->{cond}, - $self, - $result, + $self, + $result, ); delete $data->[$index]->{$rel}; $data->[$index] = {%{$data->[$index]}, %$related}; - + push @names, keys %$related if $index == 0; } } @@ -1549,8 +1833,8 @@ sub populate { my @values = map { [ @$_{@names} ] } @$data; $self->result_source->storage->insert_bulk( - $self->result_source, - \@names, + $self->result_source, + \@names, \@values, ); @@ -1560,12 +1844,12 @@ sub populate { foreach my $rel (@rels) { next unless $item->{$rel} && ref $item->{$rel} eq "ARRAY"; - my $parent = $self->find(map {{$_=>$item->{$_}} } @pks) + my $parent = $self->find(map {{$_=>$item->{$_}} } @pks) || $self->throw_exception('Cannot find the relating object.'); - + my $child = $parent->$rel; - - my $related = $child->result_source->resolve_condition( + + my $related = $child->result_source->_resolve_condition( $parent->result_source->relationship_info($rel)->{cond}, $child, $parent, @@ -1597,7 +1881,7 @@ sub _normalize_populate_args { foreach my $index (0..$#names) { $result_to_create{$names[$index]} = $$datum[$index]; } - push @results_to_create, \%result_to_create; + push @results_to_create, \%result_to_create; } return \@results_to_create; } @@ -1622,12 +1906,25 @@ C on the L object. sub pager { my ($self) = @_; + + return $self->{pager} if $self->{pager}; + my $attrs = $self->{attrs}; $self->throw_exception("Can't create pager for non-paged rs") unless $self->{attrs}{page}; $attrs->{rows} ||= 10; - return $self->{pager} ||= Data::Page->new( - $self->_count, $attrs->{rows}, $self->{attrs}{page}); + + # throw away the paging flags and re-run the count (possibly + # with a subselect) to get the real total count + my $count_attrs = { %$attrs }; + delete $count_attrs->{$_} for qw/rows offset page pager/; + my $total_count = (ref $self)->new($self->result_source, $count_attrs)->count; + + return $self->{pager} = Data::Page->new( + $total_count, + $attrs->{rows}, + $self->{attrs}{page} + ); } =head2 page @@ -1688,13 +1985,13 @@ sub new_result { $self->throw_exception( "Can't abstract implicit construct, condition not a hash" ) if ($self->{cond} && !(ref $self->{cond} eq 'HASH')); - + my $collapsed_cond = ( $self->{cond} ? $self->_collapse_cond($self->{cond}) : {} ); - + # precendence must be given to passed values over values inherited from # the cond, so the order here is important. my %implied = %{$self->_remove_alias($collapsed_cond, $alias)}; @@ -1719,7 +2016,7 @@ sub new_result { # _is_deterministic_value # -# Make an effor to strip non-deterministic values from the condition, +# Make an effor to strip non-deterministic values from the condition, # to make sure new_result chokes less sub _is_deterministic_value { @@ -1731,6 +2028,59 @@ sub _is_deterministic_value { return 0; } +# _has_resolved_attr +# +# determines if the resultset defines at least one +# of the attributes supplied +# +# used to determine if a subquery is neccessary +# +# supports some virtual attributes: +# -join +# This will scan for any joins being present on the resultset. +# It is not a mere key-search but a deep inspection of {from} +# + +sub _has_resolved_attr { + my ($self, @attr_names) = @_; + + my $attrs = $self->_resolved_attrs; + + my %extra_checks; + + for my $n (@attr_names) { + if (grep { $n eq $_ } (qw/-join/) ) { + $extra_checks{$n}++; + next; + } + + my $attr = $attrs->{$n}; + + next if not defined $attr; + + if (ref $attr eq 'HASH') { + return 1 if keys %$attr; + } + elsif (ref $attr eq 'ARRAY') { + return 1 if @$attr; + } + else { + return 1 if $attr; + } + } + + # a resolved join is expressed as a multi-level from + return 1 if ( + $extra_checks{-join} + and + ref $attrs->{from} eq 'ARRAY' + and + @{$attrs->{from}} > 1 + ); + + return 0; +} + # _collapse_cond # # Recursively collapse the condition. @@ -1743,19 +2093,16 @@ sub _collapse_cond { if (ref $cond eq 'ARRAY') { foreach my $subcond (@$cond) { next unless ref $subcond; # -or -# warn "ARRAY: " . Dumper $subcond; $collapsed = $self->_collapse_cond($subcond, $collapsed); } } elsif (ref $cond eq 'HASH') { if (keys %$cond and (keys %$cond)[0] eq '-and') { foreach my $subcond (@{$cond->{-and}}) { -# warn "HASH: " . Dumper $subcond; $collapsed = $self->_collapse_cond($subcond, $collapsed); } } else { -# warn "LEAF: " . Dumper $cond; foreach my $col (keys %$cond) { my $value = $cond->{$col}; $collapsed->{$col} = $value; @@ -1807,7 +2154,22 @@ 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; + + # For future use: + # + # in list ctx: + # my ($sql, \@bind, \%dbi_bind_attrs) = _select_args_to_query (...) + # $sql also has no wrapping parenthesis in list ctx + # + my $sqlbind = $self->result_source->storage + ->_select_args_to_query ($attrs->{from}, $attrs->{select}, $attrs->{where}, $attrs); + + return $sqlbind; +} =head2 find_or_new @@ -1848,8 +2210,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 @@ -1892,12 +2256,12 @@ Example of creating a new row. name=>"Some Person", email=>"somebody@someplace.com" }); - + Example of creating a new row and also creating rows in a related C or C resultset. Note Arrayref. $artist_rs->create( - { artistid => 4, name => 'Manufactured Crap', cds => [ + { artistid => 4, name => 'Manufactured Crap', cds => [ { title => 'My First CD', year => 2006 }, { title => 'Yet More Tweeny-Pop crap', year => 2007 }, ], @@ -1935,7 +2299,7 @@ sub create { =back $cd->cd_to_producer->find_or_create({ producer => $producer }, - { key => 'primary }); + { key => 'primary' }); Tries to find a record based on its primary key or unique constraints; if none is found, creates one and returns that instead. @@ -1979,8 +2343,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 @@ -2013,10 +2379,10 @@ For example: { key => 'cd_artist_title' } ); - $cd->cd_to_producer->update_or_create({ - producer => $producer, + $cd->cd_to_producer->update_or_create({ + producer => $producer, name => 'harry', - }, { + }, { key => 'primary, }); @@ -2195,14 +2561,14 @@ sub related_resultset { $self->{related_resultsets} ||= {}; return $self->{related_resultsets}{$rel} ||= do { - my $rel_obj = $self->result_source->relationship_info($rel); + my $rel_info = $self->result_source->relationship_info($rel); $self->throw_exception( "search_related: result source '" . $self->result_source->source_name . "' has no such relationship $rel") - unless $rel_obj; - - my ($from,$seen) = $self->_resolve_from($rel); + unless $rel_info; + + my ($from,$seen) = $self->_chain_relationship($rel); my $join_count = $seen->{$rel}; my $alias = ($join_count > 1 ? join('_', $rel, $join_count) : $rel); @@ -2294,32 +2660,68 @@ sub current_source_alias { return ($self->{attrs} || {})->{alias} || 'me'; } -sub _resolve_from { - my ($self, $extra_join) = @_; +# This code is called by search_related, and makes sure there +# is clear separation between the joins before, during, and +# after the relationship. This information is needed later +# in order to properly resolve prefetch aliases (any alias +# with a relation_chain_depth less than the depth of the +# current prefetch is not considered) +sub _chain_relationship { + my ($self, $rel) = @_; my $source = $self->result_source; my $attrs = $self->{attrs}; - - my $from = $attrs->{from} - || [ { $attrs->{alias} => $source->from } ]; - - my $seen = { %{$attrs->{seen_join}||{}} }; - my $join = ($attrs->{join} - ? [ $attrs->{join}, $extra_join ] - : $extra_join); + my $from = [ @{ + $attrs->{from} + || + [{ + -source_handle => $source->handle, + -alias => $attrs->{alias}, + $attrs->{alias} => $source->from, + }] + }]; + + 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 + my $merged = $self->_merge_attr( $attrs->{join}, $attrs->{prefetch} ); + + my @requested_joins = $source->_resolve_join($merged, $attrs->{alias}, $seen); - # we need to take the prefetch the attrs into account before we - # ->resolve_join as otherwise they get lost - captainL - my $merged = $self->_merge_attr( $join, $attrs->{prefetch} ); + push @$from, @requested_joins; - $from = [ - @$from, - ($join ? $source->resolve_join($merged, $attrs->{alias}, $seen) : ()), - ]; + ++$seen->{-relation_chain_depth}; + + # if $self already had a join/prefetch specified on it, the requested + # $rel might very well be already included. What we do in this case + # is effectively a no-op (except that we bump up the chain_depth on + # the join in question so we could tell it *is* the search_related) + my $already_joined; + + # we consider the last one thus reverse + for my $j (reverse @requested_joins) { + if ($rel eq $j->[0]{-join_path}[-1]) { + $j->[0]{-relation_chain_depth}++; + $already_joined++; + last; + } + } + unless ($already_joined) { + push @$from, $source->_resolve_join($rel, $attrs->{alias}, $seen); + } + + ++$seen->{-relation_chain_depth}; 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}; @@ -2338,14 +2740,14 @@ sub _resolved_attrs { ? $_ : { ( - /^\Q${alias}.\E(.+)$/ + /^\Q${alias}.\E(.+)$/ ? "$1" : "$_" ) - => + => ( - /\./ - ? "$_" + /\./ + ? "$_" : "${alias}.$_" ) } @@ -2400,28 +2802,32 @@ sub _resolved_attrs { push( @{ $attrs->{as} }, @$adds ); } - $attrs->{from} ||= [ { $self->{attrs}{alias} => $source->from } ]; + $attrs->{from} ||= [ { + -source_handle => $source->handle, + -alias => $self->{attrs}{alias}, + $self->{attrs}{alias} => $source->from, + } ]; + + if ( $attrs->{join} || $attrs->{prefetch} ) { + + $self->throw_exception ('join/prefetch can not be used with a literal scalarref {from}') + if ref $attrs->{from} ne 'ARRAY'; - if ( exists $attrs->{join} || exists $attrs->{prefetch} ) { my $join = delete $attrs->{join} || {}; if ( defined $attrs->{prefetch} ) { $join = $self->_merge_attr( $join, $attrs->{prefetch} ); - } $attrs->{from} = # have to copy here to avoid corrupting the original [ - @{ $attrs->{from} }, - $source->resolve_join( - $join, $alias, { %{ $attrs->{seen_join} || {} } } - ) + @{ $attrs->{from} }, + $source->_resolve_join( + $join, $alias, { %{ $attrs->{seen_join} || {} } } + ) ]; - } - $attrs->{group_by} ||= $attrs->{select} - if delete $attrs->{distinct}; if ( $attrs->{order_by} ) { $attrs->{order_by} = ( ref( $attrs->{order_by} ) eq 'ARRAY' @@ -2429,38 +2835,76 @@ sub _resolved_attrs { : [ $attrs->{order_by} ] ); } - else { - $attrs->{order_by} = []; + + if ($attrs->{group_by} and ! ref $attrs->{group_by}) { + $attrs->{group_by} = [ $attrs->{group_by} ]; } - my $collapse = $attrs->{collapse} || {}; + # 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 ]; + + + $attrs->{collapse} ||= {}; if ( my $prefetch = delete $attrs->{prefetch} ) { $prefetch = $self->_merge_attr( {}, $prefetch ); - my @pre_order; - my $seen = { %{ $attrs->{seen_join} || {} } }; - foreach my $p ( ref $prefetch eq 'ARRAY' ? @$prefetch : ($prefetch) ) { - - # bring joins back to level of current class - my @prefetch = - $source->resolve_prefetch( $p, $alias, $seen, \@pre_order, $collapse ); - push( @{ $attrs->{select} }, map { $_->[0] } @prefetch ); - push( @{ $attrs->{as} }, map { $_->[1] } @prefetch ); - } - push( @{ $attrs->{order_by} }, @pre_order ); + + my $prefetch_ordering = []; + + my $join_map = $self->_joinpath_aliases ($attrs->{from}, $attrs->{seen_join}); + + my @prefetch = + $source->_resolve_prefetch( $prefetch, $alias, $join_map, $prefetch_ordering, $attrs->{collapse} ); + + $attrs->{prefetch_select} = [ map { $_->[0] } @prefetch ]; + push @{ $attrs->{select} }, @{$attrs->{prefetch_select}}; + push @{ $attrs->{as} }, (map { $_->[1] } @prefetch); + + push( @{ $attrs->{order_by} }, @$prefetch_ordering ); + $attrs->{_collapse_order_by} = \@$prefetch_ordering; } - $attrs->{collapse} = $collapse; - if ( $attrs->{page} ) { - $attrs->{offset} ||= 0; - $attrs->{offset} += ( $attrs->{rows} * ( $attrs->{page} - 1 ) ); + + if (delete $attrs->{distinct}) { + $attrs->{group_by} ||= [ grep { !ref($_) || (ref($_) ne 'HASH') } @{$attrs->{select}} ]; + } + + # if both page and offset are specified, produce a combined offset + # even though it doesn't make much sense, this is what pre 081xx has + # been doing + if (my $page = delete $attrs->{page}) { + $attrs->{offset} = ($attrs->{rows} * ($page - 1)) + + ($attrs->{offset} || 0); } return $self->{_attrs} = $attrs; } +sub _joinpath_aliases { + my ($self, $fromspec, $seen) = @_; + + my $paths = {}; + return $paths unless ref $fromspec eq 'ARRAY'; + + for my $j (@$fromspec) { + + next if ref $j ne 'ARRAY'; + next if $j->[0]{-relation_chain_depth} < ( $seen->{-relation_chain_depth} || 0); + + my $p = $paths; + $p = $p->{$_} ||= {} for @{$j->[0]{-join_path}}; + push @{$p->{-join_aliases} }, $j->[0]{-alias}; + } + + return $paths; +} + sub _rollout_attr { my ($self, $attr) = @_; - + if (ref $attr eq 'HASH') { return $self->_rollout_hash($attr); } elsif (ref $attr eq 'ARRAY') { @@ -2511,7 +2955,7 @@ sub _calculate_score { } } else { return ($a eq $b_key) ? 1 : 0; - } + } } else { if (ref $a eq 'HASH') { my ($a_key) = keys %{$a}; @@ -2527,7 +2971,7 @@ sub _merge_attr { return $import unless defined($orig); return $orig unless defined($import); - + $orig = $self->_rollout_attr($orig); $import = $self->_rollout_attr($import); @@ -2803,19 +3247,19 @@ For example: } ); -You need to use the relationship (not the table) name in conditions, -because they are aliased as such. The current table is aliased as "me", so +You need to use the relationship (not the table) name in conditions, +because they are aliased as such. The current table is aliased as "me", so you need to use me.column_name in order to avoid ambiguity. For example: - # Get CDs from 1984 with a 'Foo' track + # Get CDs from 1984 with a 'Foo' track my $rs = $schema->resultset('CD')->search( - { + { 'me.year' => 1984, 'tracks.name' => 'Foo' }, { join => 'tracks' } ); - + If the same join is supplied twice, it will be aliased to _2 (and similarly for a third time). For e.g. @@ -2868,12 +3312,12 @@ C or C relationships, which saves us two SQL statements in this case. Simple prefetches will be joined automatically, so there is no need -for a C attribute in the above search. +for a C attribute in the above search. C can be used with the following relationship types: C, C (or if you're using C, any relationship declared with an accessor type of 'single' or 'filter'). A more complex example that -prefetches an artists cds, the tracks on those cds, and the tags associted +prefetches an artists cds, the tracks on those cds, and the tags associted with that artist is given below (assuming many-to-many from artists to tags): my $rs = $schema->resultset('Artist')->search( @@ -2885,7 +3329,7 @@ with that artist is given below (assuming many-to-many from artists to tags): ] } ); - + B If you specify a C attribute, the C and C