X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FResultSet.pm;h=4343a4f4ed027939dc86312e04fb0c1e51aba8f5;hb=8ea691c3672ff983feff498248e885ba59ea16a6;hp=e5ce0954091ae0190f05824b15c64f0fdf277a73;hpb=158277126c0e818bcb036f8594acb4bdf0d73202;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm index e5ce095..4343a4f 100644 --- a/lib/DBIx/Class/ResultSet.pm +++ b/lib/DBIx/Class/ResultSet.pm @@ -7,6 +7,7 @@ use overload 'bool' => "_bool", fallback => 1; use Carp::Clan qw/^DBIx::Class/; +use DBIx::Class::Exception; use Data::Page; use Storable; use DBIx::Class::ResultSetColumn; @@ -24,6 +25,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(); @@ -140,7 +145,7 @@ 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 +However, if it is used in a boolean context it is always true. So if you want to check if a resultset has any results use C. C will always be true. @@ -290,10 +295,15 @@ sub search_rs { $rows = $self->get_cache; } + # reset the selector list + if (List::Util::first { exists $attrs->{$_} } qw{columns select as}) { + delete @{$our_attrs}{qw{select as columns +select +as +columns include_columns}}; + } + my $new_attrs = { %{$our_attrs}, %{$attrs} }; # merge new attrs into inherited - foreach my $key (qw/join prefetch +select +as bind/) { + foreach my $key (qw/join prefetch +select +as +columns include_columns bind/) { next unless exists $attrs->{$key}; $new_attrs->{$key} = $self->_merge_attr($our_attrs->{$key}, $attrs->{$key}); } @@ -356,9 +366,9 @@ sub search_rs { } my $rs = (ref $self)->new($self->result_source, $new_attrs); - if ($rows) { - $rs->set_cache($rows); - } + + $rs->set_cache($rows) if ($rows); + return $rs; } @@ -513,6 +523,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 database that would satisfy the + # relationship + } else { my @unique_queries = $self->_unique_queries($input_query, $attrs); $query = @unique_queries @@ -521,27 +539,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; } } @@ -575,12 +580,16 @@ sub _unique_queries { my $where = $self->_collapse_cond($self->{attrs}{where} || {}); my $num_where = scalar keys %$where; - my @unique_queries; + my (@unique_queries, %seen_column_combinations); foreach my $name (@constraint_names) { - my @unique_cols = $self->result_source->unique_constraint_columns($name); - my $unique_query = $self->_build_unique_query($query, \@unique_cols); + my @constraint_cols = $self->result_source->unique_constraint_columns($name); - my $num_cols = scalar @unique_cols; + 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); + + my $num_cols = scalar @constraint_cols; my $num_query = scalar keys %$unique_query; my $total = $num_query + $num_where; @@ -634,7 +643,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 @@ -661,7 +670,6 @@ sub cursor { my ($self) = @_; my $attrs = $self->_resolved_attrs_copy; - $attrs->{_virtual_order_by} = $self->_gen_virtual_order; return $self->{cursor} ||= $self->result_source->storage->select($attrs->{from}, $attrs->{select}, @@ -693,16 +701,20 @@ 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: Query returned more than one row -In this case, you should be using L or L instead, or if you really +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 @@ -714,7 +726,12 @@ sub single { } my $attrs = $self->_resolved_attrs_copy; - $attrs->{_virtual_order_by} = $self->_gen_virtual_order; + + 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}) { @@ -742,31 +759,6 @@ sub single { return (@data ? ($self->_construct_object(@data))[0] : undef); } -# _gen_virtual_order -# -# This is a horrble hack, but seems like the best we can do at this point -# Some limit emulations (Top) require an ordered resultset in order to -# function at all. So supply a PK order if such a condition is detected - -sub _gen_virtual_order { - my $self = shift; - my $attrs = $self->_resolved_attrs_copy; - - if ($attrs->{rows} or $attrs->{offset} ) { - -# This check requires ensure_connected, so probably cheaper to just calculate all the time - -# my $sm = $self->result_source->storage->_sql_maker; -# -# if ($sm->_default_limit_syntax eq 'Top' and not @{$sm->_resolve_order ($attrs->{order_by}) }) { - - return [ $self->result_source->primary_columns ]; - -# } - } - - return undef; -} # _is_unique_query # @@ -979,7 +971,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}; @@ -1013,7 +1007,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]}) { @@ -1144,8 +1138,11 @@ 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); + $self->{attrs}{result_class} = $result_class if ref $self; } $self->_result_class; } @@ -1171,88 +1168,134 @@ sub count { return $self->search(@_)->count if @_ and defined $_[0]; return scalar @{ $self->get_cache } if $self->get_cache; - my @grouped_subq_attrs = qw/prefetch collapse distinct group_by having/; - my @subq_attrs = (); - - my $attrs = $self->_resolved_attrs; - # if we are not paged - we are simply asking for a limit - if (not $attrs->{page} and not $attrs->{software_limit}) { - push @subq_attrs, qw/rows offset/; + 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}; + + 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; - my $need_subq = $self->_has_attr (@subq_attrs); - my $need_group_subq = $self->_has_attr (@grouped_subq_attrs); + $count -= $offset if $offset; + $count = $rows if $rows and $rows < $count; + $count = 0 if ($count < 0); - return ($need_subq || $need_group_subq) - ? $self->_count_subq ($need_group_subq) - : $self->_count_simple + return $count; } -sub _count_subq { - my ($self, $add_group_by) = @_; +=head2 count_rs - my $attrs = $self->_resolved_attrs_copy; +=over 4 - # copy for the subquery, we need to do some adjustments to it too - my $sub_attrs = { %$attrs }; +=item Arguments: $cond, \%attrs?? - # these can not go in the subquery, and there is no point of ordering it - delete $sub_attrs->{$_} for qw/prefetch collapse select +select as +as columns +columns order_by/; +=item Return Value: $count_rs - # if needed force a group_by and the same set of columns (most databases require this) - if ($add_group_by) { +=back - # if we prefetch, we group_by primary keys only as this is what we would get out of the rs via ->next/->all - # simply deleting group_by suffices, as the code below will re-fill it - # Note: we check $attrs, as $sub_attrs has collapse deleted - if (ref $attrs->{collapse} and keys %{$attrs->{collapse}} ) { - delete $sub_attrs->{group_by}; - } +Same as L but returns a L object. +This can be very handy for subqueries: - $sub_attrs->{columns} = $sub_attrs->{group_by} ||= [ map { "$attrs->{alias}.$_" } ($self->result_source->primary_columns) ]; - } + ->search( { amount => $some_rs->count_rs->as_query } ) - $attrs->{from} = [{ - count_subq => (ref $self)->new ($self->result_source, $sub_attrs )->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 - # the subquery replaces this - delete $attrs->{$_} for qw/where bind prefetch collapse distinct group_by having having_bind/; +sub count_rs { + my $self = shift; + return $self->search(@_)->count_rs if @_; - return $self->__count ($attrs); + # 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; + } } -sub _count_simple { - my $self = shift; +# +# returns a ResultSetColumn object tied to the count query +# +sub _count_rs { + my ($self, $attrs) = @_; - my $count = $self->__count; - return 0 unless $count; + my $rsrc = $self->result_source; + $attrs ||= $self->_resolved_attrs; - # need to take offset from resolved attrs + # only take pieces we need for a simple count + my $tmp_attrs = { map + { $_ => $attrs->{$_} } + qw/ alias from where bind join / + }; - my $attrs = $self->_resolved_attrs; + # overwrite the selector (supplied by the storage) + $tmp_attrs->{select} = $rsrc->storage->_count_select ($rsrc, $tmp_attrs); + $tmp_attrs->{as} = 'count'; - $count -= $attrs->{offset} if $attrs->{offset}; - $count = $attrs->{rows} if $attrs->{rows} and $attrs->{rows} < $count; - $count = 0 if ($count < 0); - return $count; + my $tmp_rs = $rsrc->resultset_class->new($rsrc, $tmp_attrs)->get_column ('count'); + + return $tmp_rs; } -sub __count { +# +# same as above but uses a subquery +# +sub _count_subq_rs { my ($self, $attrs) = @_; - $attrs ||= $self->_resolved_attrs_copy; + my $rsrc = $self->result_source; + $attrs ||= $self->_resolved_attrs; - # take off any column specs, any pagers, record_filter is cdbi, and no point of ordering a count - delete $attrs->{$_} for (qw/columns +columns select +select as +as rows offset page pager order_by record_filter/); + my $sub_attrs = { map + { $_ => $attrs->{$_} } + qw/ alias from where bind join group_by having rows offset / + }; - $attrs->{select} = { count => '*' }; - $attrs->{as} = [qw/count/]; + # 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->_pri_cols) ] + } - my $tmp_rs = (ref $self)->new($self->result_source, $attrs); - my ($count) = $tmp_rs->cursor->next; + # Calculate subquery selector + if (my $g = $sub_attrs->{group_by}) { - return $count; + # 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}); + } + + for my $g_part (@$g) { + push @{$sub_attrs->{select}}, $sel_index->{$g_part} || $g_part; + } + } + else { + my @pcols = map { "$attrs->{alias}.$_" } ($rsrc->primary_columns); + $sub_attrs->{select} = @pcols ? \@pcols : [ 1 ]; + } + + 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 { @@ -1301,13 +1344,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)); @@ -1320,6 +1362,7 @@ sub all { } $self->set_cache(\@obj) if $self->{attrs}{cache}; + return @obj; } @@ -1334,6 +1377,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 @@ -1376,16 +1421,20 @@ sub _rs_update_delete { my $rsrc = $self->result_source; - my $needs_group_by_subq = $self->_has_attr (qw/prefetch distinct join seen_join group_by/); - my $needs_subq = $self->_has_attr (qw/row offset page/); + # if a condition exists we need to strip all table qualifiers + # if this is not possible we'll force a subquery below + 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/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/prefetch collapse select +select as +as columns +columns/; - $attrs->{columns} = [ map { "$attrs->{alias}.$_" } ($self->result_source->primary_columns) ]; + delete $attrs->{$_} for qw/collapse 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 @@ -1395,7 +1444,8 @@ sub _rs_update_delete { if (my $g = $attrs->{group_by}) { my @current_group_by = map { $_ =~ /\./ ? $_ : "$attrs->{alias}.$_" } - (ref $g eq 'ARRAY' ? @$g : $g ); + @$g + ; if ( join ("\x00", sort @current_group_by) @@ -1418,76 +1468,17 @@ sub _rs_update_delete { my $subrs = (ref $self)->new($rsrc, $attrs); - return $self->result_source->storage->subq_update_delete($subrs, $op, $values); + return $self->result_source->storage->_subq_update_delete($subrs, $op, $values); } else { return $rsrc->storage->$op( $rsrc, $op eq 'update' ? $values : (), - $self->_cond_for_update_delete, + $cond, ); } } - -# _cond_for_update_delete -# -# update/delete require the condition to be modified to handle -# the differing SQL syntax available. This transforms the $self->{cond} -# appropriately, returning the new condition. - -sub _cond_for_update_delete { - my ($self, $full_cond) = @_; - my $cond = {}; - - $full_cond ||= $self->{cond}; - # No-op. No condition, we're updating/deleting everything - return $cond unless ref $full_cond; - - if (ref $full_cond eq 'ARRAY') { - $cond = [ - map { - my %hash; - foreach my $key (keys %{$_}) { - $key =~ /([^.]+)$/; - $hash{$1} = $_->{$key}; - } - \%hash; - } @{$full_cond} - ]; - } - elsif (ref $full_cond eq 'HASH') { - if ((keys %{$full_cond})[0] eq '-and') { - $cond->{-and} = []; - my @cond = @{$full_cond->{-and}}; - for (my $i = 0; $i < @cond; $i++) { - my $entry = $cond[$i]; - my $hash; - if (ref $entry eq 'HASH') { - $hash = $self->_cond_for_update_delete($entry); - } - else { - $entry =~ /([^.]+)$/; - $hash->{$1} = $cond[++$i]; - } - push @{$cond->{-and}}, $hash; - } - } - else { - foreach my $key (keys %{$full_cond}) { - $key =~ /([^.]+)$/; - $cond->{$1} = $full_cond->{$key}; - } - } - } - else { - $self->throw_exception("Can't update/delete on resultset with condition unless hash or array"); - } - - return $cond; -} - - =head2 update =over 4 @@ -1531,9 +1522,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; } @@ -1543,7 +1535,7 @@ sub update_all { =item Arguments: none -=item Return Value: 1 +=item Return Value: $storage_rv =back @@ -1551,11 +1543,8 @@ Deletes the contents of the resultset from its result source. Note that this will not run DBIC cascade triggers. See L if you need triggers to run. See also L. -delete may not generate correct SQL for a query with joins or a resultset -chained from a related resultset. In this case it will generate a warning:- - -In these cases you may find that delete_all is more appropriate, or you -need to respecify your query in a way that can be expressed without a join. +Return value will be the number of rows deleted; exact type of return value +is storage-dependent. =cut @@ -1587,7 +1576,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; } @@ -1607,8 +1598,9 @@ In void context, C in L is used 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: @@ -1622,7 +1614,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 } ], @@ -1650,7 +1642,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 @@ -1664,33 +1656,48 @@ values. =cut sub populate { - my $self = shift @_; - 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'); + my $self = shift; + + # cruft placed in standalone method + my $data = $self->_normalize_populate_args(@_); 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 $first = $data->[0]; + + # if a column is a registered relationship, and is a non-blessed hash/array, consider + # it relationship data + my (@rels, @columns); + for (keys %$first) { + my $ref = ref $first->{$_}; + $self->result_source->has_relationship($_) && ($ref eq 'ARRAY' or $ref eq 'HASH') + ? push @rels, $_ + : push @columns, $_ + ; + } - my @names = grep {!ref $first->{$_}} keys %$first; - my @rels = grep { $self->result_source->has_relationship($_) } keys %$first; my @pks = $self->result_source->primary_columns; ## 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( @@ -1702,17 +1709,21 @@ sub populate { delete $data->[$index]->{$rel}; $data->[$index] = {%{$data->[$index]}, %$related}; - push @names, keys %$related if $index == 0; + push @columns, keys %$related if $index == 0; } } - ## do bulk insert on current row - my @values = map { [ @$_{@names} ] } @$data; + ## inherit the data locked in the conditions of the resultset + my ($rs_data) = $self->_merge_cond_with_data({}); + delete @{$rs_data}{@columns}; + my @inherit_cols = keys %$rs_data; + my @inherit_data = values %$rs_data; + ## do bulk insert on current row $self->result_source->storage->insert_bulk( $self->result_source, - \@names, - \@values, + [@columns, @inherit_cols], + [ map { [ @$_{@columns}, @inherit_data ] } @$data ], ); ## do the has_many relationships @@ -1721,7 +1732,7 @@ 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; @@ -1741,26 +1752,27 @@ sub populate { } } -=head2 _normalize_populate_args ($args) - -Private method used by L to normalize its incoming arguments. Factored -out in case you want to subclass and accept new argument structures to the -L method. - -=cut +# populate() argumnets went over several incarnations +# What we ultimately support is AoH sub _normalize_populate_args { - my ($self, $data) = @_; - my @names = @{shift(@$data)}; - my @results_to_create; - foreach my $datum (@$data) { - my %result_to_create; - foreach my $index (0..$#names) { - $result_to_create{$names[$index]} = $$datum[$index]; + my ($self, $arg) = @_; + + if (ref $arg eq 'ARRAY') { + if (ref $arg->[0] eq 'HASH') { + return $arg; + } + elsif (ref $arg->[0] eq 'ARRAY') { + my @ret; + my @colnames = @{$arg->[0]}; + foreach my $values (@{$arg}[1 .. $#$arg]) { + push @ret, { map { $colnames[$_] => $values->[$_] } (0 .. $#colnames) }; + } + return \@ret; } - push @results_to_create, \%result_to_create; } - return \@results_to_create; + + $self->throw_exception('Populate expects an arrayref of hashrefs or arrayref of arrayrefs'); } =head2 pager @@ -1849,46 +1861,66 @@ sub new_result { $self->throw_exception( "new_result needs a hash" ) unless (ref $values eq 'HASH'); - my %new; + my ($merged_cond, $cols_from_relations) = $self->_merge_cond_with_data($values); + + my %new = ( + %$merged_cond, + @$cols_from_relations + ? (-cols_from_relations => $cols_from_relations) + : (), + -source_handle => $self->_source_handle, + -result_source => $self->result_source, # DO NOT REMOVE THIS, REQUIRED + ); + + return $self->result_class->new(\%new); +} + +# _merge_cond_with_data +# +# 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 { + my ($self, $data) = @_; + + my (%new_data, @cols_from_relations); + my $alias = $self->{attrs}{alias}; - if ( - defined $self->{cond} - && $self->{cond} eq $DBIx::Class::ResultSource::UNRESOLVABLE_CONDITION - ) { - %new = %{ $self->{attrs}{related_objects} || {} }; # nothing might have been inserted yet - $new{-from_resultset} = [ keys %new ] if keys %new; - } else { + if (! defined $self->{cond}) { + # just massage $data below + } + elsif ($self->{cond} eq $DBIx::Class::ResultSource::UNRESOLVABLE_CONDITION) { + %new_data = %{ $self->{attrs}{related_objects} || {} }; # nothing might have been inserted yet + @cols_from_relations = keys %new_data; + } + elsif (ref $self->{cond} ne 'HASH') { $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}) - : {} + "Can't abstract implicit construct, resultset condition not a hash" ); - + } + else { # 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)}; - while( my($col,$value) = each %implied ){ - if(ref($value) eq 'HASH' && keys(%$value) && (keys %$value)[0] eq '='){ - $new{$col} = $value->{'='}; + my $collapsed_cond = $self->_collapse_cond($self->{cond}); + 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 '=') { + $new_data{$col} = $value->{'='}; next; } - $new{$col} = $value if $self->_is_deterministic_value($value); + $new_data{$col} = $value if $self->_is_deterministic_value($value); } } - %new = ( - %new, - %{ $self->_remove_alias($values, $alias) }, - -source_handle => $self->_source_handle, - -result_source => $self->result_source, # DO NOT REMOVE THIS, REQUIRED + %new_data = ( + %new_data, + %{ $self->_remove_alias($data, $alias) }, ); - return $self->result_class->new(\%new); + return (\%new_data, \@cols_from_relations); } # _is_deterministic_value @@ -1905,22 +1937,31 @@ sub _is_deterministic_value { return 0; } -# _has_attr +# _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_attr { +sub _has_resolved_attr { my ($self, @attr_names) = @_; my $attrs = $self->_resolved_attrs; - my $join_check_req; + my %extra_checks; for my $n (@attr_names) { - ++$join_check_req if $n =~ /join/; + if (grep { $n eq $_ } (qw/-join/) ) { + $extra_checks{$n}++; + next; + } my $attr = $attrs->{$n}; @@ -1937,9 +1978,9 @@ sub _has_attr { } } - # a join can be expressed as a multi-level from + # a resolved join is expressed as a multi-level from return 1 if ( - $join_check_req + $extra_checks{-join} and ref $attrs->{from} eq 'ARRAY' and @@ -2004,7 +2045,7 @@ sub _remove_alias { return \%unaliased; } -=head2 as_query (EXPERIMENTAL) +=head2 as_query =over 4 @@ -2018,11 +2059,24 @@ Returns the SQL query and bind vars associated with the invocant. This is generally used as the RHS for a subquery. -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 @@ -2049,13 +2103,14 @@ 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: C is probably not what you want when creating a -new row in a table that uses primary keys supplied by the -database. Passing in a primary key column with a value of I -will cause L to attempt to search for a row with a value of -I. +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. =cut @@ -2063,8 +2118,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 @@ -2088,12 +2145,15 @@ store. If the appropriate relationships are set up, foreign key fields can also be passed an object representing the foreign row, and the value will be set to its primary key. -To create related objects, pass a hashref for the value if the related -item is a foreign key relationship (L), -and use the name of the relationship as the key. (NOT the name of the field, -necessarily). For C and C relationships, pass an arrayref -of hashrefs containing the data for each of the rows to create in the foreign -tables, again using the relationship name as the key. +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 +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. + Instead of hashrefs of plain related data (key/value pairs), you may also pass new or inserted objects. New objects (not inserted yet, see @@ -2130,6 +2190,19 @@ Cresultset. Note Hashref. } }); +=over + +=item WARNING + +When subclassing ResultSet never attempt to override this method. Since +it is a simple shortcut for C<< $self->new_result($attrs)->insert >>, a +lot of the internals simply never call it, so your override will be +bypassed more often than not. Override either L +or L depending on how early in the +L process you need to intervene. + +=back + =cut sub create { @@ -2150,7 +2223,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. @@ -2179,11 +2252,11 @@ condition. Another process could create a record in the table after the find has completed and before the create has started. To avoid this problem, use find_or_create() inside a transaction. -B: C is probably not what you want when creating -a new row in a table that uses primary keys supplied by the -database. Passing in a primary key column with a value of I -will cause L to attempt to search for a row with a value of -I. +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 and L. For information on how to declare unique constraints, see L. @@ -2194,8 +2267,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 @@ -2232,7 +2307,7 @@ For example: producer => $producer, name => 'harry', }, { - key => 'primary, + key => 'primary', }); @@ -2244,11 +2319,11 @@ 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: C is probably not what you want when -looking for a row in a table that uses primary keys supplied by the -database, unless you actually have a key value. Passing in a primary -key column with a value of I will cause L to attempt to -search for a row with a value of I. +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. =cut @@ -2305,7 +2380,13 @@ For example: $cd->insert; } -See also L, L and L. +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. =cut @@ -2389,6 +2470,40 @@ sub clear_cache { shift->set_cache(undef); } +=head2 is_paged + +=over 4 + +=item Arguments: none + +=item Return Value: true, if the resultset has been paginated + +=back + +=cut + +sub is_paged { + my ($self) = @_; + 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->_parse_order_by($self->{attrs}{order_by}); +} + =head2 related_resultset =over 4 @@ -2410,21 +2525,30 @@ sub related_resultset { $self->{related_resultsets} ||= {}; return $self->{related_resultsets}{$rel} ||= do { - my $rel_obj = $self->result_source->relationship_info($rel); + my $rsrc = $self->result_source; + my $rel_info = $rsrc->relationship_info($rel); $self->throw_exception( - "search_related: result source '" . $self->result_source->source_name . + "search_related: result source '" . $rsrc->source_name . "' has no such relationship $rel") - unless $rel_obj; + unless $rel_info; + + my $attrs = $self->_chain_relationship($rel); + + my $join_count = $attrs->{seen_join}{$rel}; + + my $alias = $self->result_source->storage + ->relname_to_table_alias($rel, $join_count); - my ($from,$seen) = $self->_resolve_from($rel); + # since this is search_related, and we already slid the select window inwards + # (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); - my $join_count = $seen->{$rel}; - my $alias = ($join_count > 1 ? join('_', $rel, $join_count) : $rel); #XXX - temp fix for result_class bug. There likely is a more elegant fix -groditi - my %attrs = %{$self->{attrs}||{}}; - delete @attrs{qw(result_class alias)}; + delete @{$attrs}{qw(result_class alias)}; my $new_cache; @@ -2435,7 +2559,7 @@ sub related_resultset { } } - my $rel_source = $self->result_source->related_source($rel); + my $rel_source = $rsrc->related_source($rel); my $new = do { @@ -2445,20 +2569,14 @@ sub related_resultset { # to work sanely (e.g. RestrictWithObject wants to be able to add # extra query restrictions, and these may need to be $alias.) - my $attrs = $rel_source->resultset_attributes; - local $attrs->{alias} = $alias; + my $rel_attrs = $rel_source->resultset_attributes; + local $rel_attrs->{alias} = $alias; $rel_source->resultset ->search_rs( undef, { - %attrs, - join => undef, - prefetch => undef, - select => undef, - as => undef, - where => $self->{cond}, - seen_join => $seen, - from => $from, + %$attrs, + where => $attrs->{where}, }); }; $new->set_cache($new_cache) if $new_cache; @@ -2509,35 +2627,183 @@ 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 # 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 _resolve_from { - my ($self, $extra_join) = @_; +# +# The increments happen twice per join. An even number means a +# relationship specified via a search_related, whereas an odd +# number indicates a join/prefetch added via attributes +# +# Also this code will wrap the current resultset (the one we +# chain to) in a subselect IFF it contains limiting attributes +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 $attrs = { %{$self->{attrs}||{}} }; # 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 $join = $self->_merge_attr( $attrs->{join}, $attrs->{prefetch} ); - push @$from, $source->_resolve_join($merged, $attrs->{alias}, $seen) if ($merged); + delete @{$attrs}{qw/join prefetch collapse group_by distinct select as columns +select +as +columns/}; - ++$seen->{-relation_chain_depth}; + my $seen = { %{ (delete $attrs->{seen_join}) || {} } }; - push @$from, $source->_resolve_join($extra_join, $attrs->{alias}, $seen); + my $from; + my @force_subq_attrs = qw/offset rows group_by having/; - ++$seen->{-relation_chain_depth}; + if ( + ($attrs->{from} && ref $attrs->{from} ne 'ARRAY') + || + $self->_has_resolved_attr (@force_subq_attrs) + ) { + # Nuke the prefetch (if any) before the new $rs attrs + # are resolved (prefetch is useless - we are wrapping + # a subquery anyway). + my $rs_copy = $self->search; + $rs_copy->{attrs}{join} = $self->_merge_attr ( + $rs_copy->{attrs}{join}, + delete $rs_copy->{attrs}{prefetch}, + ); + + $from = [{ + -source_handle => $source->handle, + -alias => $attrs->{alias}, + $attrs->{alias} => $rs_copy->as_query, + }]; + delete @{$attrs}{@force_subq_attrs, qw/where bind/}; + $seen->{-relation_chain_depth} = 0; + } + elsif ($attrs->{from}) { #shallow copy suffices + $from = [ @{$attrs->{from}} ]; + } + else { + $from = [{ + -source_handle => $source->handle, + -alias => $attrs->{alias}, + $attrs->{alias} => $source->from, + }]; + } + + my $jpath = ($seen->{-relation_chain_depth}) + ? $from->[-1][0]{-join_path} + : []; + + my @requested_joins = $source->_resolve_join( + $join, + $attrs->{alias}, + $seen, + $jpath, + ); - return ($from,$seen); + push @$from, @requested_joins; + + $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) { + my ($last_j) = keys %{$j->[0]{-join_path}[-1]}; + if ($rel eq $last_j) { + $j->[0]{-relation_chain_depth}++; + $already_joined++; + last; + } + } + + unless ($already_joined) { + push @$from, $source->_resolve_join( + $rel, + $attrs->{alias}, + $seen, + $jpath, + ); + } + + $seen->{-relation_chain_depth}++; + + return {%$attrs, from => $from, seen_join => $seen}; } # too many times we have to do $attrs = { %{$self->_resolved_attrs} } @@ -2559,31 +2825,47 @@ sub _resolved_attrs { # build columns (as long as select isn't set) into a set of as/select hashes unless ( $attrs->{select} ) { - @colbits = map { - ( ref($_) eq 'HASH' ) - ? $_ - : { - ( - /^\Q${alias}.\E(.+)$/ - ? "$1" - : "$_" - ) - => - ( - /\./ - ? "$_" - : "${alias}.$_" - ) - } - } ( ref($attrs->{columns}) eq 'ARRAY' ) ? @{ delete $attrs->{columns}} : (delete $attrs->{columns} || $source->columns ); + + my @cols; + if ( ref $attrs->{columns} eq 'ARRAY' ) { + @cols = @{ delete $attrs->{columns}} + } elsif ( defined $attrs->{columns} ) { + @cols = delete $attrs->{columns} + } else { + @cols = $source->columns + } + + for (@cols) { + if ( ref $_ eq 'HASH' ) { + push @colbits, $_ + } else { + my $key = /^\Q${alias}.\E(.+)$/ + ? "$1" + : "$_"; + my $value = /\./ + ? "$_" + : "${alias}.$_"; + push @colbits, { $key => $value }; + } + } } + # add the additional columns on - foreach ( 'include_columns', '+columns' ) { - push @colbits, map { - ( ref($_) eq 'HASH' ) - ? $_ - : { ( split( /\./, $_ ) )[-1] => ( /\./ ? $_ : "${alias}.$_" ) } - } ( ref($attrs->{$_}) eq 'ARRAY' ) ? @{ delete $attrs->{$_} } : delete $attrs->{$_} if ( $attrs->{$_} ); + foreach (qw{include_columns +columns}) { + if ( $attrs->{$_} ) { + my @list = ( ref($attrs->{$_}) eq 'ARRAY' ) + ? @{ delete $attrs->{$_} } + : delete $attrs->{$_}; + for (@list) { + if ( ref($_) eq 'HASH' ) { + push @colbits, $_ + } else { + my $key = ( split /\./, $_ )[-1]; + my $value = ( /\./ ? $_ : "$alias.$_" ); + push @colbits, { $key => $value }; + } + } + } } # start with initial select items @@ -2592,15 +2874,22 @@ sub _resolved_attrs { ( ref $attrs->{select} eq 'ARRAY' ) ? [ @{ $attrs->{select} } ] : [ $attrs->{select} ]; - $attrs->{as} = ( - $attrs->{as} - ? ( - ref $attrs->{as} eq 'ARRAY' - ? [ @{ $attrs->{as} } ] - : [ $attrs->{as} ] + + if ( $attrs->{as} ) { + $attrs->{as} = + ( + ref $attrs->{as} eq 'ARRAY' + ? [ @{ $attrs->{as} } ] + : [ $attrs->{as} ] ) - : [ map { m/^\Q${alias}.\E(.+)$/ ? $1 : $_ } @{ $attrs->{select} } ] - ); + } else { + $attrs->{as} = [ map { + m/^\Q${alias}.\E(.+)$/ + ? $1 + : $_ + } @{ $attrs->{select} } + ] + } } else { @@ -2610,99 +2899,141 @@ sub _resolved_attrs { } # now add colbits to select/as - push( @{ $attrs->{select} }, map { values( %{$_} ) } @colbits ); - push( @{ $attrs->{as} }, map { keys( %{$_} ) } @colbits ); + push @{ $attrs->{select} }, map values %{$_}, @colbits; + push @{ $attrs->{as} }, map keys %{$_}, @colbits; - my $adds; - if ( $adds = delete $attrs->{'+select'} ) { + if ( my $adds = delete $attrs->{'+select'} ) { $adds = [$adds] unless ref $adds eq 'ARRAY'; - push( - @{ $attrs->{select} }, - map { /\./ || ref $_ ? $_ : "${alias}.$_" } @$adds - ); + push @{ $attrs->{select} }, + map { /\./ || ref $_ ? $_ : "$alias.$_" } @$adds; } - if ( $adds = delete $attrs->{'+as'} ) { + if ( my $adds = delete $attrs->{'+as'} ) { $adds = [$adds] unless ref $adds eq 'ARRAY'; - push( @{ $attrs->{as} }, @$adds ); + 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 custom {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->{seen_join} && keys %{$attrs->{seen_join}}) + ? $attrs->{from}[-1][0]{-join_path} + : [] + , + ) ]; - } - if ( $attrs->{order_by} ) { + if ( defined $attrs->{order_by} ) { $attrs->{order_by} = ( ref( $attrs->{order_by} ) eq 'ARRAY' ? [ @{ $attrs->{order_by} } ] - : [ $attrs->{order_by} ] + : [ $attrs->{order_by} || () ] ); } - else { - $attrs->{order_by} = []; - } - my $collapse = $attrs->{collapse} || {}; - if ( my $prefetch = delete $attrs->{prefetch} ) { - $prefetch = $self->_merge_attr( {}, $prefetch ); - my @pre_order; - foreach my $p ( ref $prefetch eq 'ARRAY' ? @$prefetch : ($prefetch) ) { - - # bring joins back to level of current class - my $join_map = $self->_joinpath_aliases ($attrs->{from}, $attrs->{seen_join}); - my @prefetch = - $source->_resolve_prefetch( $p, $alias, $join_map, \@pre_order, $collapse ); - push( @{ $attrs->{select} }, map { $_->[0] } @prefetch ); - push( @{ $attrs->{as} }, map { $_->[1] } @prefetch ); - } - push( @{ $attrs->{order_by} }, @pre_order ); + if ($attrs->{group_by} and ref $attrs->{group_by} ne 'ARRAY') { + $attrs->{group_by} = [ $attrs->{group_by} ]; } + # generate the distinct induced group_by early, as prefetch will be carried via a + # subquery (since a group_by is present) if (delete $attrs->{distinct}) { - $attrs->{group_by} ||= [ grep { !ref($_) || (ref($_) ne 'HASH') } @{$attrs->{select}} ]; - } + if ($attrs->{group_by}) { + 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}} ]; - $attrs->{collapse} = $collapse; + # 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}}); - if ( $attrs->{page} and not defined $attrs->{offset} ) { - $attrs->{offset} = ( $attrs->{rows} * ( $attrs->{page} - 1 ) ); + 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; + } + } + } } - return $self->{_attrs} = $attrs; -} + $attrs->{collapse} ||= {}; + if ( my $prefetch = delete $attrs->{prefetch} ) { + $prefetch = $self->_merge_attr( {}, $prefetch ); + + my $prefetch_ordering = []; + + # this is a separate structure (we don't look in {from} directly) + # as the resolver needs to shift things off the lists to work + # properly (identical-prefetches on different branches) + my $join_map = {}; + if (ref $attrs->{from} eq 'ARRAY') { -sub _joinpath_aliases { - my ($self, $fromspec, $seen) = @_; + my $start_depth = $attrs->{seen_join}{-relation_chain_depth} || 0; - my $paths = {}; - return $paths unless ref $fromspec eq 'ARRAY'; + for my $j ( @{$attrs->{from}}[1 .. $#{$attrs->{from}} ] ) { + next unless $j->[0]{-alias}; + next unless $j->[0]{-join_path}; + next if ($j->[0]{-relation_chain_depth} || 0) < $start_depth; - for my $j (@$fromspec) { + my @jpath = map { keys %$_ } @{$j->[0]{-join_path}}; + + my $p = $join_map; + $p = $p->{$_} ||= {} for @jpath[ ($start_depth/2) .. $#jpath]; #only even depths are actual jpath boundaries + push @{$p->{-join_aliases} }, $j->[0]{-alias}; + } + } - next if ref $j ne 'ARRAY'; - next if $j->[0]{-relation_chain_depth} < ( $seen->{-relation_chain_depth} || 0); + my @prefetch = + $source->_resolve_prefetch( $prefetch, $alias, $join_map, $prefetch_ordering, $attrs->{collapse} ); - my $p = $paths; - $p = $p->{$_} ||= {} for @{$j->[0]{-join_path}}; - push @{$p->{-join_aliases} }, $j->[0]{-join_alias}; + # we need to somehow mark which columns came from prefetch + $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; } - return $paths; + # 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 _rollout_attr { @@ -2747,6 +3078,13 @@ sub _rollout_hash { sub _calculate_score { my ($self, $a, $b) = @_; + if (defined $a xor defined $b) { + return 0; + } + elsif (not defined $a) { + return 1; + } + if (ref $b eq 'HASH') { my ($b_key) = keys %{$b}; if (ref $a eq 'HASH') { @@ -2828,12 +3166,13 @@ See L for details. sub throw_exception { my $self=shift; + if (ref $self && $self->_source_handle->schema) { $self->_source_handle->schema->throw_exception(@_) - } else { - croak(@_); } - + else { + DBIx::Class::Exception->throw(@_); + } } # XXX: FIXME: Attributes docs need clearing up @@ -2855,10 +3194,15 @@ These are in no particular order: =back -Which column(s) to order the results by. If a single column name, or -an arrayref of names is supplied, the argument is passed through -directly to SQL. The hashref syntax allows for connection-agnostic -specification of ordering direction: +Which column(s) to order the results by. + +[The full list of suitable values is documented in +L; the following is a summary of +common options.] + +If a single column name, or an arrayref of names is supplied, the +argument is passed through directly to SQL. The hashref syntax allows +for connection-agnostic specification of ordering direction: For descending order: @@ -2937,20 +3281,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 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 @@ -2970,25 +3321,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: @@ -3003,16 +3355,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 attributes will be ignored. +B: Prefetch does a lot of deep magic. As such, it may not behave +exactly as you might expect. + +=over 4 + +=item * + +Prefetch uses the L to populate the prefetched relationships. This +may or may not be what you want. + +=item * + +If you specify a condition on a prefetched relationship, ONLY those +rows that match the prefetched condition will be fetched into that relationship. +This means that adding prefetch to a search() B what is returned by +traversing a relationship. So, if you have C<< Artist->has_many(CDs) >> and you do + + my $artist_rs = $schema->resultset('Artist')->search({ + 'cds.year' => 2008, + }, { + join => 'cds', + }); + + my $count = $artist_rs->first->cds->count; + + my $artist_rs_prefetch = $artist_rs->search( {}, { prefetch => 'cds' } ); + + my $prefetch_count = $artist_rs_prefetch->first->cds->count; + + cmp_ok( $count, '==', $prefetch_count, "Counts should be the same" ); + +that cmp_ok() may or may not pass depending on the datasets involved. This +behavior may or may not survive the 0.09 transition. + +=back + =head2 page =over 4 @@ -3149,7 +3527,7 @@ Makes the resultset paged and specifies the page to retrieve. Effectively identical to creating a non-pages resultset and then calling ->page($page) on it. -If L attribute is not specified it defualts to 10 rows per page. +If L attribute is not specified it defaults to 10 rows per page. When you have a paged resultset, L will only return the number of rows in the page. To get the total, use the L and call @@ -3163,7 +3541,7 @@ C on it. =back -Specifes the maximum number of rows for direct retrieval or the number of +Specifies the maximum number of rows for direct retrieval or the number of rows per page if the page attribute or method is used. =head2 offset @@ -3211,7 +3589,8 @@ done. =back -Set to 1 to group by all columns. +Set to 1 to group by all columns. If the resultset already has a group_by +attribute, this setting is ignored and an appropriate warning is issued. =head2 where @@ -3222,8 +3601,8 @@ Adds to the WHERE clause. # only return rows WHERE deleted IS NULL for all searches __PACKAGE__->resultset_attributes({ where => { deleted => undef } }); ) -Can be overridden by passing C<{ where => undef }> as an attribute -to a resulset. +Can be overridden by passing C<< { where => undef } >> as an attribute +to a resultset. =back @@ -3245,165 +3624,6 @@ By default, searches are not cached. For more examples of using these attributes, see L. -=head2 from - -=over 4 - -=item Value: \@from_clause - -=back - -The C attribute gives you manual control over the C clause of SQL -statements generated by L, allowing you to express custom C -clauses. - -NOTE: Use this on your own risk. This allows you to shoot off your foot! - -C will usually do what you need and it is strongly recommended that you -avoid using C unless you cannot achieve the desired result using C. -And we really do mean "cannot", not just tried and failed. Attempting to use -this because you're having problems with C is like trying to use x86 -ASM because you've got a syntax error in your C. Trust us on this. - -Now, if you're still really, really sure you need to use this (and if you're -not 100% sure, ask the mailing list first), here's an explanation of how this -works. - -The syntax is as follows - - - [ - { => }, - [ - { => , -join_type => 'inner|left|right' }, - [], # nested JOIN (optional) - { => , ... (more conditions) }, - ], - # More of the above [ ] may follow for additional joins - ] - - - JOIN - - [JOIN ...] - ON = - - -An easy way to follow the examples below is to remember the following: - - Anything inside "[]" is a JOIN - Anything inside "{}" is a condition for the enclosing JOIN - -The following examples utilize a "person" table in a family tree application. -In order to express parent->child relationships, this table is self-joined: - - # Person->belongs_to('father' => 'Person'); - # Person->belongs_to('mother' => 'Person'); - -C can be used to nest joins. Here we return all children with a father, -then search against all mothers of those children: - - $rs = $schema->resultset('Person')->search( - undef, - { - alias => 'mother', # alias columns in accordance with "from" - from => [ - { mother => 'person' }, - [ - [ - { child => 'person' }, - [ - { father => 'person' }, - { 'father.person_id' => 'child.father_id' } - ] - ], - { 'mother.person_id' => 'child.mother_id' } - ], - ] - }, - ); - - # Equivalent SQL: - # SELECT mother.* FROM person mother - # JOIN ( - # person child - # JOIN person father - # ON ( father.person_id = child.father_id ) - # ) - # ON ( mother.person_id = child.mother_id ) - -The type of any join can be controlled manually. To search against only people -with a father in the person table, we could explicitly use C: - - $rs = $schema->resultset('Person')->search( - undef, - { - alias => 'child', # alias columns in accordance with "from" - from => [ - { child => 'person' }, - [ - { father => 'person', -join_type => 'inner' }, - { 'father.id' => 'child.father_id' } - ], - ] - }, - ); - - # Equivalent SQL: - # SELECT child.* FROM person child - # INNER JOIN person father ON child.father_id = father.id - -If you need to express really complex joins or you need a subselect, you -can supply literal SQL to C via a scalar reference. In this case -the contents of the scalar will replace the table name asscoiated with the -resultsource. - -WARNING: This technique might very well not work as expected on chained -searches - you have been warned. - - # Assuming the Event resultsource is defined as: - - MySchema::Event->add_columns ( - sequence => { - data_type => 'INT', - is_auto_increment => 1, - }, - location => { - data_type => 'INT', - }, - type => { - data_type => 'INT', - }, - ); - MySchema::Event->set_primary_key ('sequence'); - - # This will get back the latest event for every location. The column - # selector is still provided by DBIC, all we do is add a JOIN/WHERE - # combo to limit the resultset - - $rs = $schema->resultset('Event'); - $table = $rs->result_source->name; - $latest = $rs->search ( - undef, - { from => \ " - (SELECT e1.* FROM $table e1 - JOIN $table e2 - ON e1.location = e2.location - AND e1.sequence < e2.sequence - WHERE e2.sequence is NULL - ) me", - }, - ); - - # Equivalent SQL (with the DBIC chunks added): - - SELECT me.sequence, me.location, me.type FROM - (SELECT e1.* FROM events e1 - JOIN events e2 - ON e1.location = e2.location - AND e1.sequence < e2.sequence - WHERE e2.sequence is NULL - ) me; - =head2 for =over 4