X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FResultSet.pm;h=c2b045cf332a9f244bfba837832e2c3f189aa81a;hb=0ed8d3b659c714c617fa211f32f34879c5b224f0;hp=fcba7590c6867eb9f2138b11c460f265674cd0a2;hpb=b72d5dd34049102b38ad21afc6fb808a7cba9fd1;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm index fcba759..c2b045c 100644 --- a/lib/DBIx/Class/ResultSet.pm +++ b/lib/DBIx/Class/ResultSet.pm @@ -11,6 +11,7 @@ use Data::Page; use Storable; use DBIx::Class::ResultSetColumn; use DBIx::Class::ResultSourceHandle; +use List::Util (); use base qw/DBIx::Class/; __PACKAGE__->mk_group_accessors('simple' => qw/result_class _source_handle/); @@ -91,12 +92,12 @@ sub new { if ($attrs->{page}) { $attrs->{rows} ||= 10; - $attrs->{offset} ||= 0; - $attrs->{offset} += ($attrs->{rows} * ($attrs->{page} - 1)); } $attrs->{alias} ||= 'me'; + # Creation of {} and bless separated to mitigate RH perl bug + # see https://bugzilla.redhat.com/show_bug.cgi?id=196836 my $self = { _source_handle => $source, result_class => $attrs->{result_class} || $source->resolve->result_class, @@ -140,6 +141,8 @@ L. For more examples of using this function, see L. For a complete documentation for the first argument, see L. +For more help on using joins with search, see L. + =cut sub search { @@ -166,18 +169,26 @@ always return a resultset, even in list context. sub search_rs { my $self = shift; - my $rows; - - unless (@_) { # no search, effectively just a clone - $rows = $self->get_cache; - } - 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 %safe = (alias => 1, cache => 1); + + 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 $new_attrs = { %{$our_attrs}, %{$attrs} }; # merge new attrs into inherited @@ -266,6 +277,13 @@ sub search_rs { Pass a literal chunk of SQL to be added to the conditional part of the resultset query. +CAVEAT: C is provided for Class::DBI compatibility and should +only be used in that context. There are known problems using C +in chained queries; it can result in bind values in the wrong order. See +L and +L for searching techniques that do not +require C. + =cut sub search_literal { @@ -350,11 +368,13 @@ sub find { my (%related, $info); - foreach my $key (keys %$input_query) { + 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}, delete $input_query->{$key}, $key + $info->{cond}, $val, $key ); die "Can't handle OR join condition in find" if ref($rel_q) eq 'ARRAY'; @related{keys %$rel_q} = values %$rel_q; @@ -833,8 +853,6 @@ sub _collapse_result { my @const_keys; - use Data::Dumper; - foreach my $const (@const_rows) { scalar @const_keys or do { @const_keys = sort { length($a) <=> length($b) } keys %$const; @@ -920,7 +938,7 @@ Performs an SQL C with the same query as the resultset was built with to find the number of elements. If passed arguments, does a search on the resultset and counts the results of that. -Note: When using C with C, L emulates C +Note: When using C with C, L emulates C using C. Some databases (notably SQLite) do not support C with multiple columns. If you are using such a database, you should only use columns from the main table in your C @@ -935,9 +953,12 @@ sub count { my $count = $self->_count; return 0 unless $count; - $count -= $self->{attrs}{offset} if $self->{attrs}{offset}; + # need to take offset from resolved attrs + + $count -= $self->{_attrs}{offset} if $self->{_attrs}{offset}; $count = $self->{attrs}{rows} if $self->{attrs}{rows} and $self->{attrs}{rows} < $count; + $count = 0 if ($count < 0); return $count; } @@ -970,7 +991,7 @@ sub _count { # Separated out so pager can get the full count # offset, order by and page are not needed to count. record_filter is cdbi delete $attrs->{$_} for qw/rows offset order_by page pager record_filter/; - my $tmp_rs = (ref $self)->new($self->_source_handle, $attrs); + my $tmp_rs = (ref $self)->new($self->result_source, $attrs); my ($count) = $tmp_rs->cursor->next; return $count; } @@ -1238,6 +1259,141 @@ sub delete_all { return 1; } +=head2 populate + +=over 4 + +=item Arguments: \@data; + +=back + +Pass an arrayref of hashrefs. Each hashref should be a structure suitable for +submitting to a $resultset->create(...) method. + +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. + +Example: Assuming an Artist Class that has many CDs Classes relating: + + my $Artist_rs = $schema->resultset("Artist"); + + ## Void Context Example + $Artist_rs->populate([ + { artistid => 4, name => 'Manufactured Crap', cds => [ + { title => 'My First CD', year => 2006 }, + { title => 'Yet More Tweeny-Pop crap', year => 2007 }, + ], + }, + { artistid => 5, name => 'Angsty-Whiny Girl', cds => [ + { 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 } + ], + }, + ]); + + ## Array Context Example + my ($ArtistOne, $ArtistTwo, $ArtistThree) = $Artist_rs->populate([ + { name => "Artist One"}, + { name => "Artist Two"}, + { name => "Artist Three", cds=> [ + { title => "First CD", year => 2007}, + { title => "Second CD", year => 2008}, + ]} + ]); + + print $ArtistOne->name; ## response is 'Artist One' + print $ArtistThree->cds->count ## reponse is '2' + +Please note an important effect on your data when choosing between void and +wantarray context. Since void context goes straight to C in +L this will skip any component that is overriding +c. So if you are using something like L to +create primary keys for you, you will find that your PKs are empty. In this +case you will have to use the wantarray context in order to create those +values. + +=cut + +sub populate { + my ($self, $data) = @_; + + if(defined wantarray) { + my @created; + foreach my $item (@$data) { + push(@created, $self->create($item)); + } + return @created; + } else { + my ($first, @rest) = @$data; + + my @names = grep {!ref $first->{$_}} keys %$first; + my @rels = grep { $self->result_source->has_relationship($_) } keys %$first; + my @pks = $self->result_source->primary_columns; + + ## do the belongs_to relationships + foreach my $index (0..$#$data) { + if( grep { !defined $data->[$index]->{$_} } @pks ) { + my @ret = $self->populate($data); + return; + } + + foreach my $rel (@rels) { + next unless $data->[$index]->{$rel} && 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( + $result->result_source->relationship_info($reverse)->{cond}, + $self, + $result, + ); + + delete $data->[$index]->{$rel}; + $data->[$index] = {%{$data->[$index]}, %$related}; + + push @names, keys %$related if $index == 0; + } + } + + ## do bulk insert on current row + my @values = map { [ @$_{@names} ] } @$data; + + $self->result_source->storage->insert_bulk( + $self->result_source, + \@names, + \@values, + ); + + ## do the has_many relationships + foreach my $item (@$data) { + + foreach my $rel (@rels) { + next unless $item->{$rel} && ref $item->{$rel} eq "ARRAY"; + + my $parent = $self->find(map {{$_=>$item->{$_}} } @pks) + || $self->throw_exception('Cannot find the relating object.'); + + my $child = $parent->$rel; + + my $related = $child->result_source->resolve_condition( + $parent->result_source->relationship_info($rel)->{cond}, + $child, + $parent, + ); + + my @rows_to_add = ref $item->{$rel} eq 'ARRAY' ? @{$item->{$rel}} : ($item->{$rel}); + my @populate = map { {%$_, %$related} } @rows_to_add; + + $child->populate( \@populate ); + } + } + } +} + =head2 pager =over 4 @@ -1281,7 +1437,7 @@ attribute set on the resultset (10 by default). sub page { my ($self, $page) = @_; - return (ref $self)->new($self->_source_handle, { %{$self->{attrs}}, page => $page }); + return (ref $self)->new($self->result_source, { %{$self->{attrs}}, page => $page }); } =head2 new_result @@ -1294,7 +1450,12 @@ sub page { =back -Creates an object in the resultset's result class and returns it. +Creates a new row object in the resultset's result class and returns +it. The row is not inserted into the database at this point, call +L to do that. Calling L +will tell you whether the row object has been inserted or not. + +Passes the hashref of input on to L. =cut @@ -1308,9 +1469,12 @@ sub new_result { my $alias = $self->{attrs}{alias}; my $collapsed_cond = $self->{cond} ? $self->_collapse_cond($self->{cond}) : {}; + + # precendence must be given to passed values over values inherited from the cond, + # so the order here is important. my %new = ( - %{ $self->_remove_alias($values, $alias) }, %{ $self->_remove_alias($collapsed_cond, $alias) }, + %{ $self->_remove_alias($values, $alias) }, -source_handle => $self->_source_handle, -result_source => $self->result_source, # DO NOT REMOVE THIS, REQUIRED ); @@ -1408,14 +1572,63 @@ sub find_or_new { =item Arguments: \%vals -=item Return Value: $object +=item Return Value: a L $object =back -Inserts a record into the resultset and returns the object representing it. +Attempt to create a single new row or a row with multiple related rows +in the table represented by the resultset (and related tables). This +will not check for duplicate rows before inserting, use +L to do that. + +To create one row for this resultset, pass a hashref of key/value +pairs representing the columns of the table and the values you wish to +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 it's 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. + +Instead of hashrefs of plain related data (key/value pairs), you may +also pass new or inserted objects. New objects (not inserted yet, see +L), will be inserted into their appropriate tables. Effectively a shortcut for C<< ->new_result(\%vals)->insert >>. +Example of creating a new row. + + $person_rs->create({ + name=>"Some Person", + email=>"somebody@someplace.com" + }); + +Example of creating a new row and also creating rows in a related C +or C resultset. Note Arrayref. + + $artist_rs->create( + { artistid => 4, name => 'Manufactured Crap', cds => [ + { title => 'My First CD', year => 2006 }, + { title => 'Yet More Tweeny-Pop crap', year => 2007 }, + ], + }, + ); + +Example of creating a new row and also creating a row in a related +Cresultset. Note Hashref. + + $cd_rs->create({ + title=>"Music for Silly Walks", + year=>2000, + artist => { + name=>"Silly Musician", + } + }); + =cut sub create { @@ -1609,7 +1822,7 @@ sub related_resultset { my $rel_obj = $self->result_source->relationship_info($rel); $self->throw_exception( - "search_related: result source '" . $self->_source_handle->source_moniker . + "search_related: result source '" . $self->result_source->source_name . "' has no such relationship $rel") unless $rel_obj; @@ -1620,20 +1833,45 @@ sub related_resultset { #XXX - temp fix for result_class bug. There likely is a more elegant fix -groditi my %attrs = %{$self->{attrs}||{}}; - delete $attrs{result_class}; - - $self->_source_handle->schema->resultset($rel_obj->{class})->search_rs( - undef, { - %attrs, - join => undef, - prefetch => undef, - select => undef, - as => undef, - alias => $alias, - where => $self->{cond}, - seen_join => $seen, - from => $from, - }); + delete @attrs{qw(result_class alias)}; + + my $new_cache; + + if (my $cache = $self->get_cache) { + if ($cache->[0] && $cache->[0]->related_resultset($rel)->get_cache) { + $new_cache = [ map { @{$_->related_resultset($rel)->get_cache} } + @$cache ]; + } + } + + my $rel_source = $self->result_source->related_source($rel); + + my $new = do { + + # The reason we do this now instead of passing the alias to the + # search_rs below is that if you wrap/overload resultset on the + # source you need to know what alias it's -going- to have for things + # 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; + + $rel_source->resultset + ->search_rs( + undef, { + %attrs, + join => undef, + prefetch => undef, + select => undef, + as => undef, + where => $self->{cond}, + seen_join => $seen, + from => $from, + }); + }; + $new->set_cache($new_cache) if $new_cache; + $new; }; } @@ -1650,9 +1888,14 @@ sub _resolve_from { my $join = ($attrs->{join} ? [ $attrs->{join}, $extra_join ] : $extra_join); + + # we need to take the prefetch the attrs into account before we + # ->resolve_join as otherwise they get lost - captainL + my $merged = $self->_merge_attr( $join, $attrs->{prefetch} ); + $from = [ @$from, - ($join ? $source->resolve_join($join, $attrs->{alias}, $seen) : ()), + ($join ? $source->resolve_join($merged, $attrs->{alias}, $seen) : ()), ]; return ($from,$seen); @@ -1713,6 +1956,7 @@ sub _resolved_attrs { $join = $self->_merge_attr( $join, $attrs->{prefetch} ); + } $attrs->{from} = # have to copy here to avoid corrupting the original @@ -1720,6 +1964,7 @@ sub _resolved_attrs { @{$attrs->{from}}, $source->resolve_join($join, $alias, { %{$attrs->{seen_join}||{}} }) ]; + } $attrs->{group_by} ||= $attrs->{select} if delete $attrs->{distinct}; @@ -1748,51 +1993,117 @@ sub _resolved_attrs { } $attrs->{collapse} = $collapse; + if ($attrs->{page}) { + $attrs->{offset} ||= 0; + $attrs->{offset} += ($attrs->{rows} * ($attrs->{page} - 1)); + } + return $self->{_attrs} = $attrs; } +sub _rollout_attr { + my ($self, $attr) = @_; + + if (ref $attr eq 'HASH') { + return $self->_rollout_hash($attr); + } elsif (ref $attr eq 'ARRAY') { + return $self->_rollout_array($attr); + } else { + return [$attr]; + } +} + +sub _rollout_array { + my ($self, $attr) = @_; + + my @rolled_array; + foreach my $element (@{$attr}) { + if (ref $element eq 'HASH') { + push( @rolled_array, @{ $self->_rollout_hash( $element ) } ); + } elsif (ref $element eq 'ARRAY') { + # XXX - should probably recurse here + push( @rolled_array, @{$self->_rollout_array($element)} ); + } else { + push( @rolled_array, $element ); + } + } + return \@rolled_array; +} + +sub _rollout_hash { + my ($self, $attr) = @_; + + my @rolled_array; + foreach my $key (keys %{$attr}) { + push( @rolled_array, { $key => $attr->{$key} } ); + } + return \@rolled_array; +} + +sub _calculate_score { + my ($self, $a, $b) = @_; + + if (ref $b eq 'HASH') { + my ($b_key) = keys %{$b}; + if (ref $a eq 'HASH') { + my ($a_key) = keys %{$a}; + if ($a_key eq $b_key) { + return (1 + $self->_calculate_score( $a->{$a_key}, $b->{$b_key} )); + } else { + return 0; + } + } else { + return ($a eq $b_key) ? 1 : 0; + } + } else { + if (ref $a eq 'HASH') { + my ($a_key) = keys %{$a}; + return ($b eq $a_key) ? 1 : 0; + } else { + return ($b eq $a) ? 1 : 0; + } + } +} + sub _merge_attr { my ($self, $a, $b) = @_; + return $b unless defined($a); return $a unless defined($b); - if (ref $b eq 'HASH' && ref $a eq 'HASH') { - foreach my $key (keys %{$b}) { - if (exists $a->{$key}) { - $a->{$key} = $self->_merge_attr($a->{$key}, $b->{$key}); - } else { - $a->{$key} = $b->{$key}; + $a = $self->_rollout_attr($a); + $b = $self->_rollout_attr($b); + + my $seen_keys; + foreach my $b_element ( @{$b} ) { + # find best candidate from $a to merge $b_element into + my $best_candidate = { position => undef, score => 0 }; my $position = 0; + foreach my $a_element ( @{$a} ) { + my $score = $self->_calculate_score( $a_element, $b_element ); + if ($score > $best_candidate->{score}) { + $best_candidate->{position} = $position; + $best_candidate->{score} = $score; } + $position++; } - return $a; - } else { - $a = [$a] unless ref $a eq 'ARRAY'; - $b = [$b] unless ref $b eq 'ARRAY'; - - my $hash = {}; - my @array; - foreach my $x ($a, $b) { - foreach my $element (@{$x}) { - if (ref $element eq 'HASH') { - $hash = $self->_merge_attr($hash, $element); - } elsif (ref $element eq 'ARRAY') { - push(@array, @{$element}); - } else { - push(@array, $element) unless $b == $x - && grep { $_ eq $element } @array; - } + my ($b_key) = ( ref $b_element eq 'HASH' ) ? keys %{$b_element} : ($b_element); + + if ($best_candidate->{score} == 0 || exists $seen_keys->{$b_key}) { + push( @{$a}, $b_element ); + } else { + my $a_best = $a->[$best_candidate->{position}]; + # merge a_best and b_element together and replace original with merged + if (ref $a_best ne 'HASH') { + $a->[$best_candidate->{position}] = $b_element; + } elsif (ref $b_element eq 'HASH') { + my ($key) = keys %{$a_best}; + $a->[$best_candidate->{position}] = { $key => $self->_merge_attr($a_best->{$key}, $b_element->{$key}) }; } } - - @array = grep { !exists $hash->{$_} } @array; - - return keys %{$hash} - ? ( scalar(@array) - ? [$hash, @array] - : $hash - ) - : \@array; + $seen_keys->{$b_key} = 1; # don't merge the same key twice } + + return $a; } sub result_source { @@ -1902,7 +2213,7 @@ return a column named C in the above example. =over 4 Indicates additional columns to be selected from storage. Works the same as -L but adds columns to the selection. =back @@ -1910,7 +2221,7 @@ L. -The C< as > attribute is used in conjunction with C, usually when C