X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=dbsrgits%2FDBIx-Class.git;a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FResultSet.pm;h=25344b7f2714c78a1cc67d05bbcc3279a4c69c47;hp=5d960658253b4c06f6058db21e19135919142770;hb=450e6dbf39a2620b3b9c939e8cce3c16eec766d6;hpb=0d5e6c6c1d33e60058dd1cd32b50a67cee5ad381 diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm index 5d96065..25344b7 100644 --- a/lib/DBIx/Class/ResultSet.pm +++ b/lib/DBIx/Class/ResultSet.pm @@ -2,10 +2,7 @@ package DBIx::Class::ResultSet; use strict; use warnings; -use overload - '0+' => "count", - 'bool' => "_bool", - fallback => 1; +use base qw/DBIx::Class/; use Carp::Clan qw/^DBIx::Class/; use DBIx::Class::Exception; use Data::Page; @@ -13,8 +10,14 @@ use Storable; use DBIx::Class::ResultSetColumn; use DBIx::Class::ResultSourceHandle; use List::Util (); -use Scalar::Util (); -use base qw/DBIx::Class/; +use Scalar::Util qw/blessed weaken/; +use Try::Tiny; +use namespace::clean; + +use overload + '0+' => "count", + 'bool' => "_bool", + fallback => 1; __PACKAGE__->mk_group_accessors('simple' => qw/_result_class _source_handle/); @@ -25,6 +28,10 @@ DBIx::Class::ResultSet - Represents a query used for fetching a set of results. =head1 SYNOPSIS my $users_rs = $schema->resultset('User'); + while( $user = $users_rs->next) { + print $user->username; + } + my $registered_users_rs = $schema->resultset('User')->search({ registered => 1 }); my @cds_in_2005 = $schema->resultset('CD')->search({ year => 2005 })->all(); @@ -53,7 +60,12 @@ represents. The query that the ResultSet represents is B executed against the database when these methods are called: -L L L L L L +L, L, L, L, L, L. + +If a resultset is used in a numeric context it returns the L. +However, if it is used in a boolean context it is B true. So if +you want to check if a resultset has any results, you must use C. =head1 EXAMPLES @@ -97,7 +109,7 @@ attributes with the same keys need resolving. L, L, L, L attributes are merged into the existing ones from the original resultset. -The L, L attribute, and any search conditions are +The L and L attributes, and any search conditions, are merged with an SQL C to the existing condition from the original resultset. @@ -138,13 +150,6 @@ Which is the same as: See: L, L, L, L, L. -=head1 OVERLOADING - -If a resultset is used in a numeric context it returns the L. -However, if it is used in a booleand context it is always true. So if -you want to check if a resultset has any results use C. -C will always be true. - =head1 METHODS =head2 new @@ -195,7 +200,6 @@ sub new { my $self = { _source_handle => $source, cond => $attrs->{where}, - count => undef, pager => undef, attrs => $attrs }; @@ -245,7 +249,17 @@ For more help on using joins with search, see L. sub search { my $self = shift; my $rs = $self->search_rs( @_ ); - return (wantarray ? $rs->all : $rs); + + my $want = wantarray; + if ($want) { + return $rs->all; + } + elsif (defined $want) { + return $rs; + } + else { + $self->throw_exception ('->search is *not* a mutator, calling it in void context makes no sense'); + } } =head2 search_rs @@ -268,105 +282,101 @@ sub search_rs { # Special-case handling for (undef, undef). if ( @_ == 2 && !defined $_[1] && !defined $_[0] ) { - pop(@_); pop(@_); + @_ = (); } - my $attrs = {}; - $attrs = pop(@_) if @_ > 1 and ref $_[$#_] eq 'HASH'; - my $our_attrs = { %{$self->{attrs}} }; - my $having = delete $our_attrs->{having}; - my $where = delete $our_attrs->{where}; - - my $rows; + my $call_attrs = {}; + $call_attrs = pop(@_) if ( + @_ > 1 and ( ! defined $_[-1] or ref $_[-1] eq 'HASH' ) + ); + # see if we can keep the cache (no $rs changes) + my $cache; my %safe = (alias => 1, cache => 1); + if ( ! List::Util::first { !$safe{$_} } keys %$call_attrs and ( + ! defined $_[0] + or + ref $_[0] eq 'HASH' && ! keys %{$_[0]} + or + ref $_[0] eq 'ARRAY' && ! @{$_[0]} + )) { + $cache = $self->get_cache; + } - unless ( - (@_ && defined($_[0])) # @_ == () or (undef) - || - (keys %$attrs # empty attrs or only 'safe' attrs - && List::Util::first { !$safe{$_} } keys %$attrs) - ) { - # no search, effectively just a clone - $rows = $self->get_cache; + my $old_attrs = { %{$self->{attrs}} }; + my $old_having = delete $old_attrs->{having}; + my $old_where = delete $old_attrs->{where}; + + # reset the selector list + if (List::Util::first { exists $call_attrs->{$_} } qw{columns select as}) { + delete @{$old_attrs}{qw{select as columns +select +as +columns include_columns}}; } - my $new_attrs = { %{$our_attrs}, %{$attrs} }; + my $new_attrs = { %{$old_attrs}, %{$call_attrs} }; # merge new attrs into inherited - 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}); + foreach my $key (qw/join prefetch +select +as +columns include_columns bind/) { + next unless exists $call_attrs->{$key}; + $new_attrs->{$key} = $self->_merge_attr($old_attrs->{$key}, $call_attrs->{$key}); } - if (List::Util::first { exists $new_attrs->{$_} } qw{select as columns}) { - delete $new_attrs->{$_} for (qw{+select +as +columns}); - } + # rip apart the rest of @_, parse a condition + my $call_cond = do { - my $cond = (@_ - ? ( - (@_ == 1 || ref $_[0] eq "HASH") - ? ( - (ref $_[0] eq 'HASH') - ? ( - (keys %{ $_[0] } > 0) - ? shift - : undef - ) - : shift - ) - : ( - (@_ % 2) - ? $self->throw_exception("Odd number of arguments to search") - : {@_} - ) - ) - : undef - ); + 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 (defined $where) { - $new_attrs->{where} = ( - defined $new_attrs->{where} - ? { '-and' => [ - map { - ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_ - } $where, $new_attrs->{where} - ] - } - : $where); - } + } if @_; - if (defined $cond) { - $new_attrs->{where} = ( - defined $new_attrs->{where} - ? { '-and' => [ - map { - ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_ - } $cond, $new_attrs->{where} - ] - } - : $cond); + carp 'search( %condition ) is deprecated, use search( \%condition ) instead' + if (@_ > 1 and ! $self->result_source->result_class->isa('DBIx::Class::CDBICompat') ); + + for ($old_where, $call_cond) { + if (defined $_) { + $new_attrs->{where} = $self->_stack_cond ( + $_, $new_attrs->{where} + ); + } } - if (defined $having) { - $new_attrs->{having} = ( - defined $new_attrs->{having} - ? { '-and' => [ - map { - ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_ - } $having, $new_attrs->{having} - ] - } - : $having); + if (defined $old_having) { + $new_attrs->{having} = $self->_stack_cond ( + $old_having, $new_attrs->{having} + ) } my $rs = (ref $self)->new($self->result_source, $new_attrs); - $rs->set_cache($rows) if ($rows); + $rs->set_cache($cache) if ($cache); return $rs; } +sub _stack_cond { + my ($self, $left, $right) = @_; + if (defined $left xor defined $right) { + return defined $left ? $left : $right; + } + elsif (defined $left) { + return { -and => [ map + { ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_ } + ($left, $right) + ]}; + } + + return undef; +} + =head2 search_literal =over 4 @@ -413,25 +423,56 @@ sub search_literal { =over 4 -=item Arguments: @values | \%cols, \%attrs? +=item Arguments: \%columns_values | @pk_values, \%attrs? =item Return Value: $row_object | undef =back -Finds a row based on its primary key or unique constraint. For example, to find -a row by its primary key: +Finds and returns a single row based on supplied criteria. Takes either a +hashref with the same format as L (including inference of foreign +keys from related objects), or a list of primary key values in the same +order as the L +declaration on the L. + +In either case an attempt is made to combine conditions already existing on +the resultset with the condition passed to this method. + +To aid with preparing the correct query for the storage you may supply the +C attribute, which is the name of a +L (the +unique constraint corresponding to the +L is always named +C). If the C attribute has been supplied, and DBIC is unable +to construct a query that satisfies the named unique constraint fully ( +non-NULL values for each column member of the constraint) an exception is +thrown. + +If no C is specified, the search is carried over all unique constraints +which are fully defined by the available condition. + +If no such constraint is found, C currently defaults to a simple +C<< search->(\%column_values) >> which may or may not do what you expect. +Note that this fallback behavior may be deprecated in further versions. If +you need to search with arbitrary conditions - use L. If the query +resulting from this fallback produces more than one row, a warning to the +effect is issued, though only the first row is constructed and returned as +C<$row_object>. - my $cd = $schema->resultset('CD')->find(5); +In addition to C, L recognizes and applies standard +L in the same way as L does. -You can also find a row by a specific unique constraint using the C -attribute. For example: +Note that if you have extra concerns about the correctness of the resulting +query you need to specify the C attribute and supply the entire condition +as an argument to find (since it is not always possible to perform the +combination of the resultset condition with the supplied one, especially if +the resultset condition contains literal sql). - my $cd = $schema->resultset('CD')->find('Massive Attack', 'Mezzanine', { - key => 'cd_artist_title' - }); +For example, to find a row by its primary key: -Additionally, you can specify the columns explicitly by name: + my $cd = $schema->resultset('CD')->find(5); + +You can also find a row by a specific unique constraint: my $cd = $schema->resultset('CD')->find( { @@ -441,24 +482,7 @@ Additionally, you can specify the columns explicitly by name: { key => 'cd_artist_title' } ); -If the C is specified as C, it searches only on the primary key. - -If no C is specified, it searches on all unique constraints defined on the -source for which column data is provided, including the primary key. - -If your table does not have a primary key, you B provide a value for the -C attribute matching one of the unique constraints on the source. - -In addition to C, L recognizes and applies standard -L in the same way as L does. - -Note: If your query does not return only one row, a warning is generated: - - Query returned more than one row - -See also L and L. For information on how to -declare unique constraints, see -L. +See also L and L. =cut @@ -466,75 +490,96 @@ sub find { my $self = shift; my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {}); - # Default to the primary key, but allow a specific key - my @cols = exists $attrs->{key} - ? $self->result_source->unique_constraint_columns($attrs->{key}) - : $self->result_source->primary_columns; - $self->throw_exception( - "Can't find unless a primary key is defined or unique constraint is specified" - ) unless @cols; + my $rsrc = $self->result_source; - # Parse out a hashref from input - my $input_query; + # Parse out the condition from input + my $call_cond; if (ref $_[0] eq 'HASH') { - $input_query = { %{$_[0]} }; - } - elsif (@_ == @cols) { - $input_query = {}; - @{$input_query}{@cols} = @_; + $call_cond = { %{$_[0]} }; } else { - # Compatibility: Allow e.g. find(id => $value) - carp "Find by key => value deprecated; please use a hashref instead"; - $input_query = {@_}; - } - - my (%related, $info); - - KEY: foreach my $key (keys %$input_query) { - if (ref($input_query->{$key}) - && ($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( - $info->{cond}, $val, $key - ); - die "Can't handle OR join condition in find" if ref($rel_q) eq 'ARRAY'; + my $constraint = exists $attrs->{key} ? $attrs->{key} : 'primary'; + my @c_cols = $rsrc->unique_constraint_columns($constraint); + + $self->throw_exception( + "No constraint columns, maybe a malformed '$constraint' constraint?" + ) unless @c_cols; + + $self->throw_exception ( + 'find() expects either a column/value hashref, or a list of values ' + . "corresponding to the columns of the specified unique constraint '$constraint'" + ) unless @c_cols == @_; + + $call_cond = {}; + @{$call_cond}{@c_cols} = @_; + } + + my %related; + for my $key (keys %$call_cond) { + if ( + my $keyref = ref($call_cond->{$key}) + and + my $relinfo = $rsrc->relationship_info($key) + ) { + my $val = delete $call_cond->{$key}; + + next if $keyref eq 'ARRAY'; # has_many for multi_create + + my $rel_q = $rsrc->_resolve_condition( + $relinfo->{cond}, $val, $key + ); + die "Can't handle complex relationship conditions in find" if ref($rel_q) ne 'HASH'; @related{keys %$rel_q} = values %$rel_q; } } - if (my @keys = keys %related) { - @{$input_query}{@keys} = values %related; - } + # relationship conditions take precedence (?) + @{$call_cond}{keys %related} = values %related; - # Build the final query: Default to the disjunction of the unique queries, - # but allow the input query in case the ResultSet defines the query or the - # user is abusing find my $alias = exists $attrs->{alias} ? $attrs->{alias} : $self->{attrs}{alias}; - my $query; + my $final_cond; if (exists $attrs->{key}) { - my @unique_cols = $self->result_source->unique_constraint_columns($attrs->{key}); - my $unique_query = $self->_build_unique_query($input_query, \@unique_cols); - $query = $self->_add_alias($unique_query, $alias); + $final_cond = $self->_qualify_cond_columns ( + + $self->_build_unique_cond ( + $attrs->{key}, + $call_cond, + ), + + $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 + # as there can be only one row in the database that would satisfy the # relationship } else { - my @unique_queries = $self->_unique_queries($input_query, $attrs); - $query = @unique_queries - ? [ map { $self->_add_alias($_, $alias) } @unique_queries ] - : $self->_add_alias($input_query, $alias); + # no key was specified - fall down to heuristics mode: + # run through all unique queries registered on the resultset, and + # 'OR' all qualifying queries together + my (@unique_queries, %seen_column_combinations); + for my $c_name ($rsrc->unique_constraint_names) { + next if $seen_column_combinations{ + join "\x00", sort $rsrc->unique_constraint_columns($c_name) + }++; + + push @unique_queries, try { + $self->_build_unique_cond ($c_name, $call_cond) + } || (); + } + + $final_cond = @unique_queries + ? [ map { $self->_qualify_cond_columns($_, $alias) } @unique_queries ] + : $self->_non_unique_find_fallback ($call_cond, $attrs) + ; } - # Run the query - my $rs = $self->search ($query, {result_class => $self->result_class, %$attrs}); + # Run the query, passing the result_class since it should propagate for find + my $rs = $self->search ($final_cond, {result_class => $self->result_class, %$attrs}); if (keys %{$rs->_resolved_attrs->{collapse}}) { my $row = $rs->next; carp "Query returned more than one row" if $rs->next; @@ -545,71 +590,65 @@ sub find { } } -# _add_alias +# This is a stop-gap method as agreed during the discussion on find() cleanup: +# http://lists.scsys.co.uk/pipermail/dbix-class/2010-October/009535.html +# +# It is invoked when find() is called in legacy-mode with insufficiently-unique +# condition. It is provided for overrides until a saner way forward is devised # -# Add the specified alias to the specified query hash. A copy is made so the -# original query is not modified. +# *NOTE* This is not a public method, and it's *GUARANTEED* to disappear down +# the road. Please adjust your tests accordingly to catch this situation early +# DBIx::Class::ResultSet->can('_non_unique_find_fallback') is reasonable +# +# The method will not be removed without an adequately complete replacement +# for strict-mode enforcement +sub _non_unique_find_fallback { + my ($self, $cond, $attrs) = @_; + + return $self->_qualify_cond_columns( + $cond, + exists $attrs->{alias} + ? $attrs->{alias} + : $self->{attrs}{alias} + ); +} -sub _add_alias { - my ($self, $query, $alias) = @_; - my %aliased = %$query; - foreach my $col (grep { ! m/\./ } keys %aliased) { - $aliased{"$alias.$col"} = delete $aliased{$col}; +sub _qualify_cond_columns { + my ($self, $cond, $alias) = @_; + + my %aliased = %$cond; + for (keys %aliased) { + $aliased{"$alias.$_"} = delete $aliased{$_} + if $_ !~ /\./; } return \%aliased; } -# _unique_queries -# -# Build a list of queries which satisfy unique constraints. +sub _build_unique_cond { + my ($self, $constraint_name, $extra_cond) = @_; -sub _unique_queries { - my ($self, $query, $attrs) = @_; + my @c_cols = $self->result_source->unique_constraint_columns($constraint_name); - my @constraint_names = exists $attrs->{key} - ? ($attrs->{key}) - : $self->result_source->unique_constraint_names; - - my $where = $self->_collapse_cond($self->{attrs}{where} || {}); - my $num_where = scalar keys %$where; - - my (@unique_queries, %seen_column_combinations); - foreach my $name (@constraint_names) { - my @constraint_cols = $self->result_source->unique_constraint_columns($name); - - my $constraint_sig = join "\x00", sort @constraint_cols; - next if $seen_column_combinations{$constraint_sig}++; - - my $unique_query = $self->_build_unique_query($query, \@constraint_cols); + # combination may fail if $self->{cond} is non-trivial + my ($final_cond) = try { + $self->_merge_with_rscond ($extra_cond) + } catch { + +{ %$extra_cond } + }; - my $num_cols = scalar @constraint_cols; - my $num_query = scalar keys %$unique_query; + # trim out everything not in $columns + $final_cond = { map { $_ => $final_cond->{$_} } @c_cols }; - my $total = $num_query + $num_where; - if ($num_query && ($num_query == $num_cols || $total == $num_cols)) { - # The query is either unique on its own or is unique in combination with - # the existing where clause - push @unique_queries, $unique_query; - } + if (my @missing = grep { ! defined $final_cond->{$_} } (@c_cols) ) { + $self->throw_exception( sprintf ( "Unable to satisfy requested constraint '%s', no values for column(s): %s", + $constraint_name, + join (', ', map { "'$_'" } @missing), + ) ); } - return @unique_queries; -} - -# _build_unique_query -# -# Constrain the specified query hash based on the specified column names. - -sub _build_unique_query { - my ($self, $query, $unique_cols) = @_; - - return { - map { $_ => $query->{$_} } - grep { exists $query->{$_} } - @$unique_cols - }; + return $final_cond; } =head2 search_related @@ -638,7 +677,7 @@ sub search_related { =head2 search_related_rs This method works exactly the same as search_related, except that -it guarantees a restultset, even in list context. +it guarantees a resultset, even in list context. =cut @@ -677,15 +716,15 @@ sub cursor { =item Arguments: $cond? -=item Return Value: $row_object? +=item Return Value: $row_object | undef =back my $cd = $schema->resultset('CD')->single({ year => 2001 }); Inflates the first result without creating a cursor if the resultset has -any records in it; if not returns nothing. Used by L as a lean version of -L. +any records in it; if not returns C. Used by L as a lean version +of L. While this method can take an optional search condition (just like L) being a fast-code-path it does not recognize search attributes. If you need to @@ -696,7 +735,7 @@ L returned. =item B -As of 0.08100, this method enforces the assumption that the preceeding +As of 0.08100, this method enforces the assumption that the preceding query returns only one row. If more than one row is returned, you will receive a warning: @@ -740,12 +779,6 @@ sub single { } } -# XXX: Disabled since it doesn't infer uniqueness in all cases -# unless ($self->_is_unique_query($attrs->{where})) { -# carp "Query not guaranteed to return a single row" -# . "; please declare your unique constraints or use search instead"; -# } - my @data = $self->result_source->storage->select_single( $attrs->{from}, $attrs->{select}, $attrs->{where}, $attrs @@ -755,38 +788,6 @@ sub single { } -# _is_unique_query -# -# Try to determine if the specified query is guaranteed to be unique, based on -# the declared unique constraints. - -sub _is_unique_query { - my ($self, $query) = @_; - - my $collapsed = $self->_collapse_query($query); - my $alias = $self->{attrs}{alias}; - - foreach my $name ($self->result_source->unique_constraint_names) { - my @unique_cols = map { - "$alias.$_" - } $self->result_source->unique_constraint_columns($name); - - # Count the values for each unique column - my %seen = map { $_ => 0 } @unique_cols; - - foreach my $key (keys %$collapsed) { - my $aliased = $key =~ /\./ ? $key : "$alias.$key"; - next unless exists $seen{$aliased}; # Additional constraints are okay - $seen{$aliased} = scalar keys %{ $collapsed->{$key} }; - } - - # If we get 0 or more than 1 value for a column, it's not necessarily unique - return 1 unless grep { $_ != 1 } values %seen; - } - - return 0; -} - # _collapse_query # # Recursively collapse the query, accumulating values for each column. @@ -908,7 +909,7 @@ sub slice { $attrs->{offset} = $self->{attrs}{offset} || 0; $attrs->{offset} += $min; $attrs->{rows} = ($max ? ($max - $min + 1) : 1); - return $self->search(undef(), $attrs); + return $self->search(undef, $attrs); #my $slice = (ref $self)->new($self->result_source, $attrs); #return (wantarray ? $slice->all : $slice); } @@ -919,7 +920,7 @@ sub slice { =item Arguments: none -=item Return Value: $result? +=item Return Value: $result | undef =back @@ -945,6 +946,7 @@ sub next { return $cache->[$self->{all_cache_position}++]; } if ($self->{attrs}{cache}) { + delete $self->{pager}; $self->{all_cache_position} = 1; return ($self->all)[0]; } @@ -1002,7 +1004,7 @@ sub _collapse_result { # without having to contruct the full hash if (keys %collapse) { - my %pri = map { ($_ => 1) } $self->result_source->primary_columns; + my %pri = map { ($_ => 1) } $self->result_source->_pri_cols; foreach my $i (0 .. $#construct_as) { next if defined($construct_as[$i][0]); # only self table if (delete $pri{$construct_as[$i][1]}) { @@ -1133,8 +1135,14 @@ in the original source class will not run. sub result_class { my ($self, $result_class) = @_; if ($result_class) { - $self->ensure_class_loaded($result_class); + unless (ref $result_class) { # don't fire this for an object + $self->ensure_class_loaded($result_class); + } $self->_result_class($result_class); + # THIS LINE WOULD BE A BUG - this accessor specifically exists to + # permit the user to set result class on one result set only; it only + # chains if provided to search() + #$self->{attrs}{result_class} = $result_class if ref $self; } $self->_result_class; } @@ -1230,12 +1238,11 @@ sub _count_rs { $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/); + # take off any limits, record_filter is cdbi, and no point of ordering nor locking a count + delete @{$tmp_attrs}{qw/rows offset order_by record_filter for/}; # overwrite the selector (supplied by the storage) - $tmp_attrs->{select} = $rsrc->storage->_count_select ($rsrc, $tmp_attrs); + $tmp_attrs->{select} = $rsrc->storage->_count_select ($rsrc, $attrs); $tmp_attrs->{as} = 'count'; my $tmp_rs = $rsrc->resultset_class->new($rsrc, $tmp_attrs)->get_column ('count'); @@ -1250,37 +1257,54 @@ sub _count_subq_rs { my ($self, $attrs) = @_; my $rsrc = $self->result_source; - $attrs ||= $self->_resolved_attrs_copy; + $attrs ||= $self->_resolved_attrs; 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 select _prefetch_select as order_by/; + # extra selectors do not go in the subquery and there is no point of ordering it, nor locking it + delete @{$sub_attrs}{qw/collapse select _prefetch_select as order_by for/}; # if we multi-prefetch we group_by primary keys only as this is what we would # get out of the rs via ->next/->all. We *DO WANT* to clobber old group_by regardless if ( keys %{$attrs->{collapse}} ) { - $sub_attrs->{group_by} = [ map { "$attrs->{alias}.$_" } ($rsrc->primary_columns) ] + $sub_attrs->{group_by} = [ map { "$attrs->{alias}.$_" } ($rsrc->_pri_cols) ] } - $sub_attrs->{select} = $rsrc->storage->_subq_count_select ($rsrc, $sub_attrs); + # Calculate subquery selector + if (my $g = $sub_attrs->{group_by}) { - # this is so that the query can be simplified e.g. - # * ordering can be thrown away in things like Top limit - $sub_attrs->{-for_count_only} = 1; + my $sql_maker = $rsrc->storage->sql_maker; - my $sub_rs = $rsrc->resultset_class->new ($rsrc, $sub_attrs); + # necessary as the group_by may refer to aliased functions + my $sel_index; + for my $sel (@{$attrs->{select}}) { + $sel_index->{$sel->{-as}} = $sel + if (ref $sel eq 'HASH' and $sel->{-as}); + } - $attrs->{from} = [{ - -alias => 'count_subq', - -source_handle => $rsrc->handle, - count_subq => $sub_rs->as_query, - }]; + for my $g_part (@$g) { + my $colpiece = $sel_index->{$g_part} || $g_part; - # the subquery replaces this - delete $attrs->{$_} for qw/where bind collapse group_by having having_bind rows offset/; + # disqualify join-based group_by's. Arcane but possible query + # also horrible horrible hack to alias a column (not a func.) + # (probably need to introduce SQLA syntax) + if ($colpiece =~ /\./ && $colpiece !~ /^$attrs->{alias}\./) { + my $as = $colpiece; + $as =~ s/\./__/; + $colpiece = \ sprintf ('%s AS %s', map { $sql_maker->_quote ($_) } ($colpiece, $as) ); + } + push @{$sub_attrs->{select}}, $colpiece; + } + } + else { + my @pcols = map { "$attrs->{alias}.$_" } ($rsrc->primary_columns); + $sub_attrs->{select} = @pcols ? \@pcols : [ 1 ]; + } - return $self->_count_rs ($attrs); + return $rsrc->resultset_class + ->new ($rsrc, $sub_attrs) + ->as_subselect_rs + ->search ({}, { columns => { count => $rsrc->storage->_count_select ($rsrc, $attrs) } }) + ->get_column ('count'); } sub _bool { @@ -1381,12 +1405,12 @@ sub reset { =item Arguments: none -=item Return Value: $object? +=item Return Value: $object | undef =back -Resets the resultset and returns an object for the first result (if the -resultset returns anything). +Resets the resultset and returns an object for the first result (or C +if the resultset is empty). =cut @@ -1411,15 +1435,16 @@ sub _rs_update_delete { my $cond = $rsrc->schema->storage->_strip_cond_qualifiers ($self->{cond}); my $needs_group_by_subq = $self->_has_resolved_attr (qw/collapse group_by -join/); - my $needs_subq = $needs_group_by_subq || (not defined $cond) || $self->_has_resolved_attr(qw/row offset/); + my $needs_subq = $needs_group_by_subq || (not defined $cond) || $self->_has_resolved_attr(qw/rows 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) ]; + + delete $attrs->{$_} for qw/collapse _collapse_order_by select _prefetch_select as/; + $attrs->{columns} = [ map { "$attrs->{alias}.$_" } ($self->result_source->_pri_cols) ]; if ($needs_group_by_subq) { # make sure no group_by was supplied, or if there is one - make sure it matches @@ -1452,7 +1477,6 @@ sub _rs_update_delete { } my $subrs = (ref $self)->new($rsrc, $attrs); - return $self->result_source->storage->_subq_update_delete($subrs, $op, $values); } else { @@ -1475,8 +1499,16 @@ sub _rs_update_delete { =back Sets the specified columns in the resultset to the supplied values in a -single query. Return value will be true if the update succeeded or false -if no records were updated; exact type of success value is storage-dependent. +single query. Note that this will not run any accessor/set_column/update +triggers, nor will it update any row object instances derived from this +resultset (this includes the contents of the L +if any). See L if you need to execute any on-update +triggers or cascades defined either by you or a +L. + +The return value is a pass through of what the underlying +storage backend returned, and may vary. See L for the most +common case. =cut @@ -1498,8 +1530,9 @@ sub update { =back -Fetches all objects and updates them one at a time. Note that C -will run DBIC cascade triggers, while L will not. +Fetches all objects and updates them one at a time via +L. Note that C will run DBIC defined +triggers, while L will not. =cut @@ -1507,9 +1540,10 @@ sub update_all { my ($self, $values) = @_; $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; - } + + my $guard = $self->result_source->schema->txn_scope_guard; + $_->update($values) for $self->all; + $guard->commit; return 1; } @@ -1523,12 +1557,16 @@ sub update_all { =back -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. +Deletes the rows matching this resultset in a single query. Note that this +will not run any delete triggers, nor will it alter the +L status of any row object instances +derived from this resultset (this includes the contents of the +L if any). See L if you need to +execute any on-delete triggers or cascades defined either by you or a +L. -Return value will be the amount of rows deleted; exact type of return value -is storage-dependent. +The return value is a pass through of what the underlying storage backend +returned, and may vary. See L for the most common case. =cut @@ -1550,8 +1588,9 @@ sub delete { =back -Fetches all objects and deletes them one at a time. Note that C -will run DBIC cascade triggers, while L will not. +Fetches all objects and deletes them one at a time via +L. Note that C will run DBIC defined +triggers, while L will not. =cut @@ -1560,7 +1599,9 @@ sub delete_all { $self->throw_exception('delete_all does not accept any arguments') if @_; + my $guard = $self->result_source->schema->txn_scope_guard; $_->delete for $self->all; + $guard->commit; return 1; } @@ -1596,7 +1637,7 @@ Example: Assuming an Artist Class that has many CDs Classes relating: ], }, { artistid => 5, name => 'Angsty-Whiny Girl', cds => [ - { title => 'My parents sold me to a record company' ,year => 2005 }, + { title => 'My parents sold me to a record company', year => 2005 }, { title => 'Why Am I So Ugly?', year => 2006 }, { title => 'I Got Surgery and am now Popular', year => 2007 } ], @@ -1624,7 +1665,7 @@ example: [qw/artistid name/], [100, 'A Formally Unknown Singer'], [101, 'A singer that jumped the shark two albums ago'], - [102, 'An actually cool singer.'], + [102, 'An actually cool singer'], ]); Please note an important effect on your data when choosing between void and @@ -1696,7 +1737,7 @@ sub populate { } ## inherit the data locked in the conditions of the resultset - my ($rs_data) = $self->_merge_cond_with_data({}); + my ($rs_data) = $self->_merge_with_rscond({}); delete @{$rs_data}{@columns}; my @inherit_cols = keys %$rs_data; my @inherit_data = values %$rs_data; @@ -1775,11 +1816,116 @@ C on the L object. =cut +# make a wizard good for both a scalar and a hashref +my $mk_lazy_count_wizard = sub { + require Variable::Magic; + + my $stash = { total_rs => shift }; + my $slot = shift; # only used by the hashref magic + + my $magic = Variable::Magic::wizard ( + data => sub { $stash }, + + (!$slot) + ? ( + # the scalar magic + get => sub { + # set value lazily, and dispell for good + ${$_[0]} = $_[1]{total_rs}->count; + Variable::Magic::dispell (${$_[0]}, $_[1]{magic_selfref}); + return 1; + }, + set => sub { + # an explicit set implies dispell as well + # the unless() is to work around "fun and giggles" below + Variable::Magic::dispell (${$_[0]}, $_[1]{magic_selfref}) + unless (caller(2))[3] eq 'DBIx::Class::ResultSet::pager'; + return 1; + }, + ) + : ( + # the uvar magic + fetch => sub { + if ($_[2] eq $slot and !$_[1]{inactive}) { + my $cnt = $_[1]{total_rs}->count; + $_[0]->{$slot} = $cnt; + + # attempting to dispell in a fetch handle (works in store), seems + # to invariable segfault on 5.10, 5.12, 5.13 :( + # so use an inactivator instead + #Variable::Magic::dispell (%{$_[0]}, $_[1]{magic_selfref}); + $_[1]{inactive}++; + } + return 1; + }, + store => sub { + if (! $_[1]{inactive} and $_[2] eq $slot) { + #Variable::Magic::dispell (%{$_[0]}, $_[1]{magic_selfref}); + $_[1]{inactive}++ + unless (caller(2))[3] eq 'DBIx::Class::ResultSet::pager'; + } + return 1; + }, + ), + ); + + $stash->{magic_selfref} = $magic; + weaken ($stash->{magic_selfref}); # this fails on 5.8.1 + + return $magic; +}; + +# the tie class for 5.8.1 +{ + package # hide from pause + DBIx::Class::__DBIC_LAZY_RS_COUNT__; + use base qw/Tie::Hash/; + + sub FIRSTKEY { my $dummy = scalar keys %{$_[0]{data}}; each %{$_[0]{data}} } + sub NEXTKEY { each %{$_[0]{data}} } + sub EXISTS { exists $_[0]{data}{$_[1]} } + sub DELETE { delete $_[0]{data}{$_[1]} } + sub CLEAR { %{$_[0]{data}} = () } + sub SCALAR { scalar %{$_[0]{data}} } + + sub TIEHASH { + $_[1]{data} = {%{$_[1]{selfref}}}; + %{$_[1]{selfref}} = (); + Scalar::Util::weaken ($_[1]{selfref}); + return bless ($_[1], $_[0]); + }; + + sub FETCH { + if ($_[1] eq $_[0]{slot}) { + my $cnt = $_[0]{data}{$_[1]} = $_[0]{total_rs}->count; + untie %{$_[0]{selfref}}; + %{$_[0]{selfref}} = %{$_[0]{data}}; + return $cnt; + } + else { + $_[0]{data}{$_[1]}; + } + } + + sub STORE { + $_[0]{data}{$_[1]} = $_[2]; + if ($_[1] eq $_[0]{slot}) { + untie %{$_[0]{selfref}}; + %{$_[0]{selfref}} = %{$_[0]{data}}; + } + $_[2]; + } +} + sub pager { my ($self) = @_; return $self->{pager} if $self->{pager}; + if ($self->get_cache) { + $self->throw_exception ('Pagers on cached resultsets are not supported'); + } + my $attrs = $self->{attrs}; $self->throw_exception("Can't create pager for non-paged rs") unless $self->{attrs}{page}; @@ -1789,13 +1935,69 @@ sub pager { # 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; + my $total_rs = (ref $self)->new($self->result_source, $count_attrs); + - return $self->{pager} = Data::Page->new( - $total_count, +### the following may seem awkward and dirty, but it's a thought-experiment +### necessary for future development of DBIx::DS. Do *NOT* change this code +### before talking to ribasushi/mst + + my $pager = Data::Page->new( + 0, #start with an empty set $attrs->{rows}, - $self->{attrs}{page} + $self->{attrs}{page}, ); + + my $data_slot = 'total_entries'; + + # Since we are interested in a cached value (once it's set - it's set), every + # technique will detach from the magic-host once the time comes to fire the + # ->count (or in the segfaulting case of >= 5.10 it will deactivate itself) + + if ($] < 5.008003) { + # 5.8.1 throws 'Modification of a read-only value attempted' when one tries + # to weakref the magic container :( + # tested on 5.8.1 + tie (%$pager, 'DBIx::Class::__DBIC_LAZY_RS_COUNT__', + { slot => $data_slot, total_rs => $total_rs, selfref => $pager } + ); + } + elsif ($] < 5.010) { + # We can use magic on the hash value slot. It's interesting that the magic is + # attached to the hash-slot, and does *not* stop working once I do the dummy + # assignments after the cast() + # tested on 5.8.3 and 5.8.9 + my $magic = $mk_lazy_count_wizard->($total_rs); + Variable::Magic::cast ( $pager->{$data_slot}, $magic ); + + # this is for fun and giggles + $pager->{$data_slot} = -1; + $pager->{$data_slot} = 0; + + # this does not work for scalars, but works with + # uvar magic below + #my %vals = %$pager; + #%$pager = (); + #%{$pager} = %vals; + } + else { + # And the uvar magic + # works on 5.10.1, 5.12.1 and 5.13.4 in its current form, + # however see the wizard maker for more notes + my $magic = $mk_lazy_count_wizard->($total_rs, $data_slot); + Variable::Magic::cast ( %$pager, $magic ); + + # still works + $pager->{$data_slot} = -1; + $pager->{$data_slot} = 0; + + # this now works + my %vals = %$pager; + %$pager = (); + %{$pager} = %vals; + } + + return $self->{pager} = $pager; } =head2 page @@ -1843,7 +2045,7 @@ sub new_result { $self->throw_exception( "new_result needs a hash" ) unless (ref $values eq 'HASH'); - my ($merged_cond, $cols_from_relations) = $self->_merge_cond_with_data($values); + my ($merged_cond, $cols_from_relations) = $self->_merge_with_rscond($values); my %new = ( %$merged_cond, @@ -1857,13 +2059,13 @@ sub new_result { return $self->result_class->new(\%new); } -# _merge_cond_with_data +# _merge_with_rscond # # Takes a simple hash of K/V data and returns its copy merged with the # condition already present on the resultset. Additionally returns an # arrayref of value/condition names, which were inferred from related # objects (this is needed for in-memory related objects) -sub _merge_cond_with_data { +sub _merge_with_rscond { my ($self, $data) = @_; my (%new_data, @cols_from_relations); @@ -1889,11 +2091,13 @@ sub _merge_cond_with_data { my %implied = %{$self->_remove_alias($collapsed_cond, $alias)}; while ( my($col, $value) = each %implied ) { - if (ref($value) eq 'HASH' && keys(%$value) && (keys %$value)[0] eq '=') { + my $vref = ref $value; + if ($vref eq 'HASH' && keys(%$value) && (keys %$value)[0] eq '=') { $new_data{$col} = $value->{'='}; - next; } - $new_data{$col} = $value if $self->_is_deterministic_value($value); + elsif( !$vref or $vref eq 'SCALAR' or blessed($value) ) { + $new_data{$col} = $value; + } } } @@ -1905,20 +2109,6 @@ sub _merge_cond_with_data { return (\%new_data, \@cols_from_relations); } -# _is_deterministic_value -# -# Make an effor to strip non-deterministic values from the condition, -# to make sure new_result chokes less - -sub _is_deterministic_value { - my $self = shift; - my $value = shift; - my $ref_type = ref $value; - return 1 if $ref_type eq '' || $ref_type eq 'SCALAR'; - return 1 if Scalar::Util::blessed($value); - return 0; -} - # _has_resolved_attr # # determines if the resultset defines at least one @@ -2076,17 +2266,18 @@ sub as_query { $cd->cd_to_producer->find_or_new({ producer => $producer }, { key => 'primary }); -Find an existing record from this resultset, based on its primary -key, or a unique constraint. If none exists, instantiate a new result -object and return it. The object will not be saved into your storage -until you call L on it. +Find an existing record from this resultset using L. if none exists, +instantiate a new result object and return it. The object will not be saved +into your storage until you call L on it. -You most likely want this method when looking for existing rows using -a unique constraint that is not the primary key, or looking for -related rows. +You most likely want this method when looking for existing rows using a unique +constraint that is not the primary key, or looking for related rows. -If you want objects to be saved immediately, use L -instead. +If you want objects to be saved immediately, use L instead. + +B: Make sure to read the documentation of L and understand the +significance of the C attribute, as its lack may skew your search, and +subsequently result in spurious new objects. B: Take care when using C with a table having columns with default values that you intend to be automatically @@ -2131,7 +2322,7 @@ To create related objects, pass a hashref of related-object column values B. If the relationship is of type C (L) - pass an arrayref of hashrefs. The process will correctly identify columns holding foreign keys, and will -transparrently populate them from the keys of the corresponding relation. +transparently populate them from the keys of the corresponding relation. This can be applied recursively, and will work correctly for a structure with an arbitrary depth and width, as long as the relationships actually exists and the correct column data has been supplied. @@ -2162,7 +2353,7 @@ or C resultset. Note Arrayref. ); Example of creating a new row and also creating a row in a related -Cresultset. Note Hashref. +C resultset. Note Hashref. $cd_rs->create({ title=>"Music for Silly Walks", @@ -2228,6 +2419,10 @@ constraint. For example: { key => 'cd_artist_title' } ); +B: Make sure to read the documentation of L and understand the +significance of the C attribute, as its lack may skew your search, and +subsequently result in spurious row creation. + B: Because find_or_create() reads from the database and then possibly inserts based on the result, this method is subject to a race condition. Another process could create a record in the table after @@ -2261,16 +2456,15 @@ sub find_or_create { =item Arguments: \%col_values, { key => $unique_constraint }? -=item Return Value: $rowobject +=item Return Value: $row_object =back $resultset->update_or_create({ col => $val, ... }); -First, searches for an existing row matching one of the unique constraints -(including the primary key) on the source of this resultset. If a row is -found, updates it with the other given column values. Otherwise, creates a new -row. +Like L, but if a row is found it is immediately updated via +C<< $found_row->update (\%col_values) >>. + Takes an optional C attribute to search on a specific unique constraint. For example: @@ -2289,17 +2483,12 @@ For example: producer => $producer, name => 'harry', }, { - key => 'primary, + key => 'primary', }); - -If no C is specified, it searches on all unique constraints defined on the -source, including the primary key. - -If the C is specified as C, it searches only on the primary key. - -See also L and L. For information on how to declare -unique constraints, see L. +B: Make sure to read the documentation of L and understand the +significance of the C attribute, as its lack may skew your search, and +subsequently result in spurious row creation. B: Take care when using C with a table having columns with default values that you intend to be automatically @@ -2307,6 +2496,9 @@ supplied by the database (e.g. an auto_increment primary key column). In normal usage, the value of such columns should NOT be included at all in the call to C, even when set to C. +See also L and L. For information on how to declare +unique constraints, see L. + =cut sub update_or_create { @@ -2335,13 +2527,9 @@ sub update_or_create { $resultset->update_or_new({ col => $val, ... }); -First, searches for an existing row matching one of the unique constraints -(including the primary key) on the source of this resultset. If a row is -found, updates it with the other given column values. Otherwise, instantiate -a new result object and return it. The object will not be saved into your storage -until you call L on it. +Like L but if a row is found it is immediately updated via +C<< $found_row->update (\%col_values) >>. -Takes an optional C attribute to search on a specific unique constraint. For example: # In your application @@ -2362,13 +2550,17 @@ For example: $cd->insert; } +B: Make sure to read the documentation of L and understand the +significance of the C attribute, as its lack may skew your search, and +subsequently result in spurious new objects. + B: Take care when using C with a table having columns with default values that you intend to be automatically supplied by the database (e.g. an auto_increment primary key column). In normal usage, the value of such columns should NOT be included at all in the call to C, even when set to C. -See also L, L and L. +See also L, L and L. =cut @@ -2392,7 +2584,7 @@ sub update_or_new { =item Arguments: none -=item Return Value: \@cache_objects? +=item Return Value: \@cache_objects | undef =back @@ -2440,7 +2632,7 @@ sub set_cache { =item Arguments: none -=item Return Value: [] +=item Return Value: undef =back @@ -2469,6 +2661,23 @@ sub is_paged { return !!$self->{attrs}{page}; } +=head2 is_ordered + +=over 4 + +=item Arguments: none + +=item Return Value: true, if the resultset has been ordered with C. + +=back + +=cut + +sub is_ordered { + my ($self) = @_; + return scalar $self->result_source->storage->_extract_order_columns($self->{attrs}{order_by}); +} + =head2 related_resultset =over 4 @@ -2509,7 +2718,7 @@ sub related_resultset { # (the select/as attrs were deleted in the beginning), we need to flip all # left joins to inner, so we get the expected results # read the comment on top of the actual function to see what this does - $attrs->{from} = $rsrc->schema->storage->_straight_join_to_node ($attrs->{from}, $alias); + $attrs->{from} = $rsrc->schema->storage->_inner_join_to_node ($attrs->{from}, $alias); #XXX - temp fix for result_class bug. There likely is a more elegant fix -groditi @@ -2592,6 +2801,78 @@ sub current_source_alias { return ($self->{attrs} || {})->{alias} || 'me'; } +=head2 as_subselect_rs + +=over 4 + +=item Arguments: none + +=item Return Value: $resultset + +=back + +Act as a barrier to SQL symbols. The resultset provided will be made into a +"virtual view" by including it as a subquery within the from clause. From this +point on, any joined tables are inaccessible to ->search on the resultset (as if +it were simply where-filtered without joins). For example: + + my $rs = $schema->resultset('Bar')->search({'x.name' => 'abc'},{ join => 'x' }); + + # 'x' now pollutes the query namespace + + # So the following works as expected + my $ok_rs = $rs->search({'x.other' => 1}); + + # But this doesn't: instead of finding a 'Bar' related to two x rows (abc and + # def) we look for one row with contradictory terms and join in another table + # (aliased 'x_2') which we never use + my $broken_rs = $rs->search({'x.name' => 'def'}); + + my $rs2 = $rs->as_subselect_rs; + + # doesn't work - 'x' is no longer accessible in $rs2, having been sealed away + my $not_joined_rs = $rs2->search({'x.other' => 1}); + + # works as expected: finds a 'table' row related to two x rows (abc and def) + my $correctly_joined_rs = $rs2->search({'x.name' => 'def'}); + +Another example of when one might use this would be to select a subset of +columns in a group by clause: + + my $rs = $schema->resultset('Bar')->search(undef, { + group_by => [qw{ id foo_id baz_id }], + })->as_subselect_rs->search(undef, { + columns => [qw{ id foo_id }] + }); + +In the above example normally columns would have to be equal to the group by, +but because we isolated the group by into a subselect the above works. + +=cut + +sub as_subselect_rs { + my $self = shift; + + my $attrs = $self->_resolved_attrs; + + my $fresh_rs = (ref $self)->new ( + $self->result_source + ); + + # these pieces will be locked in the subquery + delete $fresh_rs->{cond}; + delete @{$fresh_rs->{attrs}}{qw/where bind/}; + + return $fresh_rs->search( {}, { + from => [{ + $attrs->{alias} => $self->as_query, + -alias => $attrs->{alias}, + -source_handle => $self->result_source->handle, + }], + alias => $attrs->{alias}, + }); +} + # 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 @@ -2614,7 +2895,7 @@ sub _chain_relationship { # ->_resolve_join as otherwise they get lost - captainL my $join = $self->_merge_attr( $attrs->{join}, $attrs->{prefetch} ); - delete @{$attrs}{qw/join prefetch collapse distinct select as columns +select +as +columns/}; + delete @{$attrs}{qw/join prefetch collapse group_by distinct select as columns +select +as +columns/}; my $seen = { %{ (delete $attrs->{seen_join}) || {} } }; @@ -2640,7 +2921,7 @@ sub _chain_relationship { -alias => $attrs->{alias}, $attrs->{alias} => $rs_copy->as_query, }]; - delete @{$attrs}{@force_subq_attrs, 'where'}; + delete @{$attrs}{@force_subq_attrs, qw/where bind/}; $seen->{-relation_chain_depth} = 0; } elsif ($attrs->{from}) { #shallow copy suffices @@ -2856,22 +3137,9 @@ sub _resolved_attrs { carp ("Useless use of distinct on a grouped resultset ('distinct' is ignored when a 'group_by' is present)"); } else { - $attrs->{group_by} = [ grep { !ref($_) || (ref($_) ne 'HASH') } @{$attrs->{select}} ]; - - # add any order_by parts that are not already present in the group_by - # we need to be careful not to add any named functions/aggregates - # i.e. select => [ ... { count => 'foo', -as 'foocount' } ... ] - my %already_grouped = map { $_ => 1 } (@{$attrs->{group_by}}); - - my $storage = $self->result_source->schema->storage; - - my $rs_column_list = $storage->_resolve_column_info ($attrs->{from}); - - for my $chunk ($storage->_parse_order_by($attrs->{order_by})) { - if ($rs_column_list->{$chunk} && not $already_grouped{$chunk}++) { - push @{$attrs->{group_by}}, $chunk; - } - } + $attrs->{group_by} = $source->storage->_group_over_selection ( + @{$attrs}{qw/from select order_by/} + ); } } @@ -3125,6 +3393,15 @@ it and sets C as normal. (You may also use the C attribute, as in earlier versions of DBIC.) +Essentially C does the same as L and L. + + columns => [ 'foo', { bar => 'baz' } ] + +is the same as + + select => [qw/foo baz/], + as => [qw/foo bar/] + =head2 +columns =over 4 @@ -3174,23 +3451,27 @@ names: select => [ 'name', { count => 'employeeid' }, - { sum => 'salary' } + { max => { length => 'name' }, -as => 'longest_name' } ] }); -When you use function/stored procedure names and do not supply an C -attribute, the column names returned are storage-dependent. E.g. MySQL would -return a column named C in the above example. + # Equivalent SQL + SELECT name, COUNT( employeeid ), MAX( LENGTH( name ) ) AS longest_name FROM employee -B You will almost always need a corresponding 'as' entry when you use -'select'. +B You will almost always need a corresponding L attribute when you +use L, to instruct DBIx::Class how to store the result of the column. +Also note that the L attribute has nothing to do with the SQL-side 'AS' +identifier aliasing. You can however alias a function, so you can use it in +e.g. an C clause. This is done via the C<-as> B but adds columns to the selection. +L but adds columns to the default selection, instead of specifying +an explicit list. =back @@ -3210,25 +3491,26 @@ Indicates additional column names for those added via L. See L. =back -Indicates column names for object inflation. That is, C -indicates the name that the column can be accessed as via the -C method (or via the object accessor, B). It has nothing to do with the SQL code C, -usually when C for details. $rs = $schema->resultset('Employee')->search(undef, { select => [ 'name', - { count => 'employeeid' } + { count => 'employeeid' }, + { max => { length => 'name' }, -as => 'longest_name' } ], - as => ['name', 'employee_count'], + as => [qw/ + name + employee_count + max_name_length + /], }); - my $employee = $rs->first(); # get the first Employee - If the object against which the search is performed already has an accessor matching a column name specified in C, the value can be retrieved using the accessor as normal: @@ -3243,16 +3525,6 @@ use C instead: You can create your own accessors if required - see L for details. -Please note: This will NOT insert an C into the SQL -statement produced, it is used for internal access only. Thus -attempting to use the accessor in an C clause or similar -will fail miserably. - -To get around this limitation, you can supply literal SQL to your -C