X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FResultSet.pm;h=574b2da18f3dea55c4e8ae5d5065e472921e3ce5;hb=c97338007ede15e7c62095a642b3de382a3508bd;hp=d8dcfcaa45255a3127422b2767426de101daea88;hpb=fe0708a2d68b5d34b6bc6f7e70164c3e569f1dd0;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm index d8dcfca..574b2da 100644 --- a/lib/DBIx/Class/ResultSet.pm +++ b/lib/DBIx/Class/ResultSet.pm @@ -829,7 +829,7 @@ sub find { # Run the query, passing the result_class since it should propagate for find my $rs = $self->search ($final_cond, {result_class => $self->result_class, %$attrs}); - if ($rs->_resolved_attrs->{collapse}) { + if (keys %{$rs->_resolved_attrs->{collapse}}) { my $row = $rs->next; carp "Query returned more than one row" if $rs->next; return $row; @@ -1038,7 +1038,7 @@ sub single { my $attrs = $self->_resolved_attrs_copy; - if ($attrs->{collapse}) { + if (keys %{$attrs->{collapse}}) { $self->throw_exception( 'single() can not be used on resultsets prefetching has_many. Use find( \%cond ) or next() instead' ); @@ -1061,10 +1061,7 @@ sub single { $attrs->{where}, $attrs ); - return @data - ? ($self->_construct_objects(@data))[0] - : undef - ; + return (@data ? ($self->_construct_object(@data))[0] : undef); } @@ -1241,361 +1238,141 @@ sub next { : $self->cursor->next ); return undef unless (@row); - my ($row, @more) = $self->_construct_objects(@row); + my ($row, @more) = $self->_construct_object(@row); $self->{stashed_objects} = \@more if @more; return $row; } -# takes a single DBI-row of data and coinstructs as many objects -# as the resultset attributes call for. -# This can be a bit of an action at a distance - it takes as an argument -# the *current* cursor-row (already taken off the $sth), but if -# collapsing is requested it will keep advancing the cursor either -# until the current row-object is assembled (the collapser was able to -# order the result sensibly) OR until the cursor is exhausted (an -# unordered collapsing resultset effectively triggers ->all) - -# FIXME: why the *FUCK* do we pass around DBI data by copy?! Sadly needs -# assessment before changing... -# -sub _construct_objects { +sub _construct_object { my ($self, @row) = @_; - my $attrs = $self->_resolved_attrs; - my $keep_collapsing = $attrs->{collapse}; - - my $res_index; -=begin - do { - my $me_pref_col = $attrs->{_row_parser}->($row_ref); - - my $container; - if ($keep_collapsing) { - - # FIXME - we should be able to remove these 2 checks after the design validates - $self->throw_exception ('Collapsing without a top-level collapse-set... can not happen') - unless @{$me_ref_col->[2]}; - $self->throw_exception ('Top-level collapse-set contains a NULL-value... can not happen') - if grep { ! defined $_ } @{$me_pref_col->[2]}; - - my $main_ident = join "\x00", @{$me_pref_col->[2]}; - - if (! $res_index->{$main_ident}) { - # this is where we bail out IFF we are ordered, and the $main_ident changes - $res_index->{$main_ident} = { - all_me_pref => [, - index => scalar keys %$res_index, - }; - } - } - - - - $container = $res_index->{$main_ident}{container}; - }; - - push @$container, [ @{$me_pref_col}[0,1] ]; - - - - } while ( - $keep_collapsing - && - do { $row_ref = [$self->cursor->next]; $self->{stashed_row} = $row_ref if @$row_ref; scalar @$row_ref } - ); - - # attempt collapse all rows with same collapse identity - if (@to_collapse > 1) { - my @collapsed; - while (@to_collapse) { - $self->_merge_result(\@collapsed, shift @to_collapse); - } - } -=cut - - my $mepref_structs = $self->_collapse_result($attrs->{as}, \@row, $keep_collapsing) + my $info = $self->_collapse_result($self->{_attrs}{as}, \@row) or return (); - - my $rsrc = $self->result_source; - my $res_class = $self->result_class; - my $inflator = $res_class->can ('inflate_result'); - - my @objs = - $res_class->$inflator ($rsrc, @$mepref_structs); - - if (my $f = $attrs->{record_filter}) { - @objs = map { $f->($_) } @objs; - } - - return @objs; + 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_proto, $row_ref, $keep_collapsing ) = @_; - my $collapse = $self->_resolved_attrs->{collapse}; - my $parser = $self->result_source->_mk_row_parser( $as_proto, $collapse ); - my $result = []; - my $register = {}; - my $rel_register = {}; - - my @row = @$row_ref; - do { - my $row = $parser->( \@row ); + my ($self, $as_proto, $row) = @_; - # init register - $self->_check_register( $register, $row ) unless ( keys %$register ); + my @copy = @$row; - $self->_merge_result( $result, $row, $rel_register ) - if ( !$collapse - || ( $collapse = $self->_check_register( $register, $row ) ) ); + # 'foo' => [ undef, 'foo' ] + # 'foo.bar' => [ 'foo', 'bar' ] + # 'foo.bar.baz' => [ 'foo.bar', 'baz' ] - } while ( - $collapse - && do { @row = $self->cursor->next; $self->{stashed_row} = \@row if @row; } + my @construct_as = map { [ (/^(?:(.*)\.)?([^.]+)$/) ] } @$as_proto; - # run this as long as there is a next row and we are not yet done collapsing - ); - return $result; -} - - - -# Taubenschlag -sub _check_register { - my ( $self, $register, $obj ) = @_; - return undef unless ( ref $obj eq 'ARRAY' && ref $obj->[2] eq 'ARRAY' ); - my @ids = @{ $obj->[2] }; - while ( defined( my $id = shift @ids ) ) { - return $register->{$id} if ( exists $register->{$id} && !@ids ); - $register->{$id} = @ids ? {} : $obj unless ( exists $register->{$id} ); - $register = $register->{$id}; - } - return undef; -} + my %collapse = %{$self->{_attrs}{collapse}||{}}; -sub _merge_result { - my ( $self, $result, $row, $register ) = @_; - return @$result = @$row if ( @$result == 0 ); # initialize with $row + my @pri_index; - my ( undef, $rels, $ids ) = @$result; - my ( undef, $new_rels, $new_ids ) = @$row; + # 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. - my @rels = keys %{ { %{$rels||{} }, %{ $new_rels||{} } } }; - foreach my $rel (@rels) { - $register = $register->{$rel} ||= {}; + # 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 - my $new_data = $new_rels->{$rel}; - my $data = $rels->{$rel}; - @$data = [@$data] unless ( ref $data->[0] eq 'ARRAY' ); + # store just the index so we can check the array positions from the row + # without having to contruct the full hash - $self->_check_register( $register, $data->[0] ) - unless ( keys %$register ); - - if ( my $found = $self->_check_register( $register, $new_data ) ) { - $self->_merge_result( $found, $new_data, $register ); - } - else { - push( @$data, $new_data ); + if (keys %collapse) { + 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]}) { + push(@pri_index, $i); + } + last unless keys %pri; # short circuit (Johnny Five Is Alive!) } } - return 1; -} - -=begin - -# two arguments: $as_proto is an arrayref of column names, -# $row_ref is an arrayref of the data. If none of the row data -# is defined we return undef (that's copied from the old -# _collapse_result). Next we decide whether we need to collapse -# the resultset (i.e. we prefetch something) or not. $collapse -# indicates that. The do-while loop will run once if we do not need -# to collapse the result and will run as long as _merge_result returns -# a true value. It will return undef if the current added row does not -# match the previous row. A bit of stashing and cursor magic is -# required so that the cursor is not mixed up. - -# "$rows" is a bit misleading. In the end, there should only be one -# element in this arrayref. - -sub _collapse_result { - my ( $self, $as_proto, $row_ref ) = @_; - my $has_def; - for (@$row_ref) { - if ( defined $_ ) { - $has_def++; - last; - } - } - return undef unless $has_def; - - my $collapse = $self->_resolved_attrs->{collapse}; - my $rows = []; - my @row = @$row_ref; - do { - my $i = 0; - my $row = { map { $_ => $row[ $i++ ] } @$as_proto }; - $row = $self->result_source->_parse_row($row, $collapse); - unless ( scalar @$rows ) { - push( @$rows, $row ); - } - $collapse = undef unless ( $self->_merge_result( $rows, $row ) ); - } while ( - $collapse - && do { @row = $self->cursor->next; $self->{stashed_row} = \@row if @row; } - ); - return $rows->[0]; + # no need to do an if, it'll be empty if @pri_index is empty anyway -} + my %pri_vals = map { ($_ => $copy[$_]) } @pri_index; -# _merge_result accepts an arrayref of rows objects (again, an arrayref of two elements) -# and a row object which should be merged into the first object. -# First we try to find out whether $row is already in $rows. If this is the case -# we try to merge them by iteration through their relationship data. We call -# _merge_result again on them, so they get merged. - -# If we don't find the $row in $rows, we append it to $rows and return undef. -# _merge_result returns 1 otherwise (i.e. $row has been found in $rows). - -sub _merge_result { - my ( $self, $rows, $row ) = @_; - my ( $columns, $rels ) = @$row; - my $found = undef; - foreach my $seen (@$rows) { - my $match = 1; - foreach my $column ( keys %$columns ) { - if ( defined $seen->[0]->{$column} ^ defined $columns->{$column} - or defined $columns->{$column} - && $seen->[0]->{$column} ne $columns->{$column} ) - { - - $match = 0; - last; - } - } - if ($match) { - $found = $seen; - last; - } - } - if ($found) { - foreach my $rel ( keys %$rels ) { - my $old_rows = $found->[1]->{$rel}; - $self->_merge_result( - ref $found->[1]->{$rel}->[0] eq 'HASH' ? [ $found->[1]->{$rel} ] - : $found->[1]->{$rel}, - ref $rels->{$rel}->[0] eq 'HASH' ? [ $rels->{$rel}->[0], $rels->{$rel}->[1] ] - : $rels->{$rel}->[0] - ); - - my $attrs = $self->_resolved_attrs; - my ($keep_collapsing, $set_ident) = @{$attrs}{qw/collapse _collapse_ident/}; - - # FIXME this is temporary, need to calculate in _resolved_attrs - $set_ident ||= { me => [ $self->result_source->_pri_cols ], pref => {} }; - - my @cur_row = @$row_ref; - my (@to_collapse, $last_ident); - - do { - my $row_hr = { map { $as_proto->[$_] => $cur_row[$_] } (0 .. $#$as_proto) }; - - # see if we are switching to another object - # this can be turned off and things will still work - # since _merge_prefetch knows about _collapse_ident -# my $cur_ident = [ @{$row_hr}{@$set_ident} ]; - my $cur_ident = []; - $last_ident ||= $cur_ident; - -# if ($keep_collapsing = Test::Deep::eq_deeply ($cur_ident, $last_ident)) { -# push @to_collapse, $self->result_source->_parse_row ( -# $row_hr, -# ); -# } - } while ( - $keep_collapsing - && - do { @cur_row = $self->cursor->next; $self->{stashed_row} = \@cur_row if @cur_row; } - ); + my @const_rows; - die Dumper \@to_collapse; + do { # no need to check anything at the front, we always want the first row + my %const; - # attempt collapse all rows with same collapse identity - if (@to_collapse > 1) { - my @collapsed; - while (@to_collapse) { - $self->_merge_result(\@collapsed, shift @to_collapse); + foreach my $this_as (@construct_as) { + $const{$this_as->[0]||''}{$this_as->[1]} = shift(@copy); } - @to_collapse = @collapsed; - } - # still didn't fully collapse - $self->throw_exception ('Resultset collapse failed (theoretically impossible). Maybe a wrong collapse_ident...?') - if (@to_collapse > 1); + push(@const_rows, \%const); - return $to_collapse[0]; -} + } 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; -# two arguments: $as_proto is an arrayref of 'as' column names, -# $row_ref is an arrayref of the data. The do-while loop will run -# once if we do not need to collapse the result and will run as long as -# _merge_result returns a true value. It will return undef if the -# current added row does not match the previous row, which in turn -# means we need to stash the row for the subsequent ->next call -sub _collapse_result { - my ( $self, $as_proto, $row_ref ) = @_; - - my $attrs = $self->_resolved_attrs; - my ($keep_collapsing, $set_ident) = @{$attrs}{qw/collapse _collapse_ident/}; + # last thing in do block, counts as true if anything doesn't match - die Dumper [$as_proto, $row_ref, $keep_collapsing, $set_ident ]; + # check xor defined first for NULL vs. NOT NULL then if one is + # defined the other must be so check string equality + grep { + (defined $pri_vals{$_} ^ defined $copy[$_]) + || (defined $pri_vals{$_} && ($pri_vals{$_} ne $copy[$_])) + } @pri_index; + } + ); - my @cur_row = @$row_ref; - my (@to_collapse, $last_ident); - - do { - my $row_hr = { map { $as_proto->[$_] => $cur_row[$_] } (0 .. $#$as_proto) }; - - # see if we are switching to another object - # this can be turned off and things will still work - # since _merge_prefetch knows about _collapse_ident -# my $cur_ident = [ @{$row_hr}{@$set_ident} ]; - my $cur_ident = []; - $last_ident ||= $cur_ident; + my $alias = $self->{attrs}{alias}; + my $info = []; -# if ($keep_collapsing = eq_deeply ($cur_ident, $last_ident)) { -# push @to_collapse, $self->result_source->_parse_row ( -# $row_hr, -# ); -# } - } while ( - $keep_collapsing - && - do { @cur_row = $self->cursor->next; $self->{stashed_row} = \@cur_row if @cur_row; } - ); + my %collapse_pos; - # attempt collapse all rows with same collapse identity -} -=cut + my @const_keys; -# Takes an arrayref of me/pref pairs and a new me/pref pair that should -# be merged on a preexisting matching me (or should be pushed into $merged -# as a new me/pref pair for further invocations). It should be possible to -# use this function to collapse complete ->all results, provided _collapse_result() is adjusted -# to provide everything to this sub not to barf when $merged contains more than one -# arrayref) -sub _merge_prefetch { - my ($self, $merged, $next_row) = @_; - - unless (@$merged) { - push @$merged, $next_row; - return; + 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}; + } + } } + return $info; } =head2 result_source @@ -1766,7 +1543,7 @@ sub _count_subq_rs { # if we multi-prefetch we group_by something unique, as this is what we would # get out of the rs via ->next/->all. We *DO WANT* to clobber old group_by regardless - if ( $attrs->{collapse} ) { + if ( keys %{$attrs->{collapse}} ) { $sub_attrs->{group_by} = [ map { "$attrs->{alias}.$_" } @{ $rsrc->_identifying_column_set || $self->throw_exception( 'Unable to construct a unique group_by criteria properly collapsing the ' @@ -1886,32 +1663,30 @@ sub all { $self->throw_exception("all() doesn't take any arguments, you probably wanted ->search(...)->all()"); } - if (my $c = $self->get_cache) { - return @$c; - } + return @{ $self->get_cache } if $self->get_cache; - my @objects; + my @obj; - if ($self->_resolved_attrs->{collapse}) { + if (keys %{$self->_resolved_attrs->{collapse}}) { # 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_objects to survive the approach + # _construct_object to survive the approach $self->cursor->reset; my @row = $self->cursor->next; while (@row) { - push(@objects, $self->_construct_objects(@row)); + push(@obj, $self->_construct_object(@row)); @row = (exists $self->{stashed_row} ? @{delete $self->{stashed_row}} : $self->cursor->next); } } else { - @objects = map { $self->_construct_objects(@$_) } $self->cursor->all; + @obj = map { $self->_construct_object(@$_) } $self->cursor->all; } - $self->set_cache(\@objects) if $self->{attrs}{cache}; + $self->set_cache(\@obj) if $self->{attrs}{cache}; - return @objects; + return @obj; } =head2 reset @@ -1981,14 +1756,19 @@ sub _rs_update_delete { # simplify the joinmap and maybe decide if a grouping (and thus subquery) is necessary my $relation_classifications; if (ref($attrs->{from}) eq 'ARRAY') { - $attrs->{from} = $storage->_prune_unused_joins ($attrs->{from}, $attrs->{select}, $cond, $attrs); - - $relation_classifications = $storage->_resolve_aliastypes_from_select_args ( - [ @{$attrs->{from}}[1 .. $#{$attrs->{from}}] ], - $attrs->{select}, - $cond, - $attrs - ) unless $needs_group_by_subq; # we already know we need a group, no point of resolving them + if (@{$attrs->{from}} == 1) { + # not a fucking JOIN at all, quit with the dickery + $relation_classifications = {}; + } else { + $attrs->{from} = $storage->_prune_unused_joins ($attrs->{from}, $attrs->{select}, $cond, $attrs); + + $relation_classifications = $storage->_resolve_aliastypes_from_select_args ( + [ @{$attrs->{from}}[1 .. $#{$attrs->{from}}] ], + $attrs->{select}, + $cond, + $attrs + ) unless $needs_group_by_subq; # we already know we need a group, no point of resolving them + } } else { $needs_group_by_subq ||= 1; # if {from} is unparseable assume the worst @@ -2006,21 +1786,13 @@ sub _rs_update_delete { ) { # Most databases do not allow aliasing of tables in UPDATE/DELETE. Thus # a condition containing 'me' or other table prefixes will not work - # at all. What this code tries to do (badly) is to generate a condition - # with the qualifiers removed, by exploiting the quote mechanism of sqla - # - # this is atrocious and should be replaced by normal sqla introspection - # one sunny day - my ($sql, @bind) = do { - my $sqla = $rsrc->storage->sql_maker; - local $sqla->{_dequalify_idents} = 1; - $sqla->_recurse_where($self->{cond}); - } if $self->{cond}; - + # at all. Tell SQLMaker to dequalify idents via a gross hack. + my $sqla = $rsrc->storage->sql_maker; + local $sqla->{_dequalify_idents} = 1; return $rsrc->storage->$op( $rsrc, $op eq 'update' ? $values : (), - $self->{cond} ? \[$sql, @bind] : (), + $self->{cond}, ); } @@ -3660,17 +3432,15 @@ sub _resolved_attrs { } } - # generate selections based on the prefetch helper - my $prefetch; - $prefetch = $self->_merge_joinpref_attr( {}, delete $attrs->{prefetch} ) - if defined $attrs->{prefetch}; - - if ($prefetch) { + $attrs->{collapse} ||= {}; + if ($attrs->{prefetch}) { $self->throw_exception("Unable to prefetch, resultset contains an unnamed selector $attrs->{_dark_selector}{string}") if $attrs->{_dark_selector}; - $attrs->{collapse} = 1; + my $prefetch = $self->_merge_joinpref_attr( {}, delete $attrs->{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 @@ -3693,7 +3463,8 @@ sub _resolved_attrs { } } - my @prefetch = $source->_resolve_prefetch( $prefetch, $alias, $join_map ); + my @prefetch = + $source->_resolve_prefetch( $prefetch, $alias, $join_map, $prefetch_ordering, $attrs->{collapse} ); # we need to somehow mark which columns came from prefetch if (@prefetch) { @@ -3703,34 +3474,11 @@ sub _resolved_attrs { push @{ $attrs->{select} }, (map { $_->[0] } @prefetch); push @{ $attrs->{as} }, (map { $_->[1] } @prefetch); - } - - # run through the resulting joinstructure (starting from our current slot) - # and unset collapse if proven unnesessary - if ($attrs->{collapse} && ref $attrs->{from} eq 'ARRAY') { - - if (@{$attrs->{from}} > 1) { - - # find where our table-spec starts and consider only things after us - my @fromlist = @{$attrs->{from}}; - while (@fromlist) { - my $t = shift @fromlist; - $t = $t->[0] if ref $t eq 'ARRAY'; #me vs join from-spec mismatch - last if ($t->{-alias} && $t->{-alias} eq $alias); - } - for (@fromlist) { - $attrs->{collapse} = ! $_->[0]{-is_single} - and last; - } - } - else { - # no joins - no collapse - $attrs->{collapse} = 0; - } + push( @{$attrs->{order_by}}, @$prefetch_ordering ); + $attrs->{_collapse_order_by} = \@$prefetch_ordering; } - # 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