X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FResultSet.pm;h=31358a9fd6b28c6b55f0d7aff952e6a9c17b9f13;hb=dc87edb5845de612331948bce2445a3246663e96;hp=c87a13ce48bc72122e003b117a8bb01c01b6414a;hpb=3441fd57f3e40b9862f41618b49178f66de1a4d8;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm index c87a13c..31358a9 100644 --- a/lib/DBIx/Class/ResultSet.pm +++ b/lib/DBIx/Class/ResultSet.pm @@ -34,7 +34,7 @@ In the examples below, the following table classes are used: package MyApp::Schema::Artist; use base qw/DBIx::Class/; - __PACKAGE__->load_components(qw/Core/); + __PACKAGE__->load_components(qw/Core/) __PACKAGE__->table('artist'); __PACKAGE__->add_columns(qw/artistid name/); __PACKAGE__->set_primary_key('artistid'); @@ -87,6 +87,7 @@ sub new { my ($source, $attrs) = @_; $source = $source->handle unless $source->isa('DBIx::Class::ResultSourceHandle'); + $attrs = { %{$attrs||{}} }; if ($attrs->{page}) { $attrs->{rows} ||= 10; @@ -134,7 +135,10 @@ call it as C. columns => [qw/name artistid/], }); -For a list of attributes that can be passed to C, see L. For more examples of using this function, see L. +For a list of attributes that can be passed to C, see +L. For more examples of using this function, see +L. For a complete +documentation for the first argument, see L. =cut @@ -239,7 +243,7 @@ sub search_rs { : $having); } - my $rs = (ref $self)->new($self->_source_handle, $new_attrs); + my $rs = (ref $self)->new($self->result_source, $new_attrs); if ($rows) { $rs->set_cache($rows); } @@ -346,11 +350,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; @@ -409,21 +415,23 @@ sub _unique_queries { ? ($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; 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 $num_cols = scalar @unique_cols; my $num_query = scalar keys %$unique_query; - next unless $num_query; - # XXX: Assuming quite a bit about $self->{attrs}{where} - my $num_cols = scalar @unique_cols; - my $num_where = exists $self->{attrs}{where} - ? scalar keys %{ $self->{attrs}{where} } - : 0; - push @unique_queries, $unique_query - if $num_query + $num_where == $num_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; + } } return @unique_queries; @@ -741,85 +749,132 @@ sub next { sub _construct_object { my ($self, @row) = @_; my $info = $self->_collapse_result($self->{_attrs}{as}, \@row); - my @new = $self->result_class->inflate_result($self->_source_handle, @$info); + my @new = $self->result_class->inflate_result($self->result_source, @$info); @new = $self->{_attrs}{record_filter}->(@new) if exists $self->{_attrs}{record_filter}; return @new; } sub _collapse_result { - my ($self, $as, $row, $prefix) = @_; + my ($self, $as_proto, $row) = @_; - my %const; my @copy = @$row; - - foreach my $this_as (@$as) { - my $val = shift @copy; - if (defined $prefix) { - if ($this_as =~ m/^\Q${prefix}.\E(.+)$/) { - my $remain = $1; - $remain =~ /^(?:(.*)\.)?([^.]+)$/; - $const{$1||''}{$2} = $val; - } - } else { - $this_as =~ /^(?:(.*)\.)?([^.]+)$/; - $const{$1||''}{$2} = $val; - } - } - my $alias = $self->{attrs}{alias}; - my $info = [ {}, {} ]; - foreach my $key (keys %const) { - if (length $key && $key ne $alias) { - my $target = $info; - my @parts = split(/\./, $key); - foreach my $p (@parts) { - $target = $target->[1]->{$p} ||= []; + # 'foo' => [ undef, 'foo' ] + # 'foo.bar' => [ 'foo', 'bar' ] + # 'foo.bar.baz' => [ 'foo.bar', 'baz' ] + + my @construct_as = map { [ (/^(?:(.*)\.)?([^.]+)$/) ] } @$as_proto; + + my %collapse = %{$self->{_attrs}{collapse}||{}}; + + my @pri_index; + + # if we're doing collapsing (has_many prefetch) we need to grab records + # until the PK changes, so fill @pri_index. if not, we leave it empty so + # we know we don't have to bother. + + # the reason for not using the collapse stuff directly is because if you + # had for e.g. two artists in a row with no cds, the collapse info for + # both would be NULL (undef) so you'd lose the second artist + + # store just the index so we can check the array positions from the row + # without having to contruct the full hash + + if (keys %collapse) { + my %pri = map { ($_ => 1) } $self->result_source->primary_columns; + foreach my $i (0 .. $#construct_as) { + next if defined($construct_as[$i][0]); # only self table + if (delete $pri{$construct_as[$i][1]}) { + push(@pri_index, $i); } - $target->[0] = $const{$key}; - } else { - $info->[0] = $const{$key}; + last unless keys %pri; # short circuit (Johnny Five Is Alive!) } } - - my @collapse; - if (defined $prefix) { - @collapse = map { - m/^\Q${prefix}.\E(.+)$/ ? ($1) : () - } keys %{$self->{_attrs}{collapse}} - } else { - @collapse = keys %{$self->{_attrs}{collapse}}; - }; - if (@collapse) { - my ($c) = sort { length $a <=> length $b } @collapse; - my $target = $info; - foreach my $p (split(/\./, $c)) { - $target = $target->[1]->{$p} ||= []; + # no need to do an if, it'll be empty if @pri_index is empty anyway + + my %pri_vals = map { ($_ => $copy[$_]) } @pri_index; + + my @const_rows; + + do { # no need to check anything at the front, we always want the first row + + my %const; + + foreach my $this_as (@construct_as) { + $const{$this_as->[0]||''}{$this_as->[1]} = shift(@copy); } - my $c_prefix = (defined($prefix) ? "${prefix}.${c}" : $c); - my @co_key = @{$self->{_attrs}{collapse}{$c_prefix}}; - my $tree = $self->_collapse_result($as, $row, $c_prefix); - my %co_check = map { ($_, $tree->[0]->{$_}); } @co_key; - my (@final, @raw); - - while ( - !( + + push(@const_rows, \%const); + + } until ( # no pri_index => no collapse => drop straight out + !@pri_index + or + do { # get another row, stash it, drop out if different PK + + @copy = $self->cursor->next; + $self->{stashed_row} = \@copy; + + # last thing in do block, counts as true if anything doesn't match + + # check xor defined first for NULL vs. NOT NULL then if one is + # defined the other must be so check string equality + grep { - !defined($tree->[0]->{$_}) || $co_check{$_} ne $tree->[0]->{$_} - } @co_key - ) - ) { - push(@final, $tree); - last unless (@raw = $self->cursor->next); - $row = $self->{stashed_row} = \@raw; - $tree = $self->_collapse_result($as, $row, $c_prefix); + (defined $pri_vals{$_} ^ defined $copy[$_]) + || (defined $pri_vals{$_} && ($pri_vals{$_} ne $copy[$_])) + } @pri_index; + } + ); + + my $alias = $self->{attrs}{alias}; + my $info = []; + + my %collapse_pos; + + 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; + }; + foreach my $key (@const_keys) { + if (length $key) { + my $target = $info; + my @parts = split(/\./, $key); + my $cur = ''; + my $data = $const->{$key}; + foreach my $p (@parts) { + $target = $target->[1]->{$p} ||= []; + $cur .= ".${p}"; + if ($cur eq ".${key}" && (my @ckey = @{$collapse{$cur}||[]})) { + # collapsing at this point and on final part + my $pos = $collapse_pos{$cur}; + CK: foreach my $ck (@ckey) { + if (!defined $pos->{$ck} || $pos->{$ck} ne $data->{$ck}) { + $collapse_pos{$cur} = $data; + delete @collapse_pos{ # clear all positioning for sub-entries + grep { m/^\Q${cur}.\E/ } keys %collapse_pos + }; + push(@$target, []); + last CK; + } + } + } + if (exists $collapse{$cur}) { + $target = $target->[-1]; + } + } + $target->[0] = $data; + } else { + $info->[0] = $const->{$key}; + } } - @$target = (@final ? @final : [ {}, {} ]); - # single empty result to indicate an empty prefetched has_many } - #print "final info: " . Dumper($info); return $info; } @@ -1108,9 +1163,9 @@ sub update { unless ref $values eq 'HASH'; my $cond = $self->_cond_for_update_delete; - + return $self->result_source->storage->update( - $self->result_source->from, $values, $cond + $self->result_source, $values, $cond ); } @@ -1160,7 +1215,7 @@ sub delete { my $cond = $self->_cond_for_update_delete; - $self->result_source->storage->delete($self->result_source->from, $cond); + $self->result_source->storage->delete($self->result_source, $cond); return 1; } @@ -1185,6 +1240,135 @@ sub delete_all { return 1; } +=head2 populate + +=over 4 + +=item Arguments: $source_name, \@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' + +=cut +use Data::Dump qw/dump/; +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}) + { + 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; + } + } + + my @values = map { + [ map { + defined $_ ? $_ : $self->throw_exception("Undefined value for column!") + } @$_{@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) || next; + 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 @@ -1259,10 +1443,10 @@ sub new_result { %{ $self->_remove_alias($values, $alias) }, %{ $self->_remove_alias($collapsed_cond, $alias) }, -source_handle => $self->_source_handle, + -result_source => $self->result_source, # DO NOT REMOVE THIS, REQUIRED ); - my $obj = $self->result_class->new(\%new); - return $obj; + return $self->result_class->new(\%new); } # _collapse_cond @@ -1812,7 +1996,9 @@ Shortcut to include additional columns in the returned results - for example }); would return all CDs and include a 'name' column to the information -passed to object inflation +passed to object inflation. Note that the 'artist' is the name of the +column (or relationship) accessor, and 'name' is the name of the column +accessor in the related table. =head2 select @@ -1863,8 +2049,14 @@ Indicates additional column names for those added via L<+select>. =back -Indicates column names for object inflation. This is used in conjunction with -C contains one or more function or stored +Indicates column names for object inflation. That is, c< as > +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< SELECT foo AS bar +>. + +The C< as > attribute is used in conjunction with C contains one or more function or stored procedure names: $rs = $schema->resultset('Employee')->search(undef, {