X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FResultSet.pm;h=bf7e88f03a02567474ca7a889646d6b8bee4a622;hb=c6ec79000b160e7491d9ab9d95d6e69c473b0862;hp=2a08b657c5f10fa4d8a8c2995ad99ab172ace5dd;hpb=7ed4b48f691b78a3d832266d3a253a4d5c6a4837;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm index 2a08b65..bf7e88f 100644 --- a/lib/DBIx/Class/ResultSet.pm +++ b/lib/DBIx/Class/ResultSet.pm @@ -2,18 +2,18 @@ package DBIx::Class::ResultSet; use strict; use warnings; -use base qw/DBIx::Class/; + +use base 'DBIx::Class'; + use DBIx::Class::Carp; use DBIx::Class::ResultSetColumn; -use Scalar::Util qw/blessed weaken reftype/; +use DBIx::Class::ResultClass::HashRefInflator; +use Scalar::Util qw( blessed reftype ); use DBIx::Class::_Util qw( + dbic_internal_try dbic_internal_catch dump_value emit_loud_diag fail_on_internal_wantarray fail_on_internal_call UNRESOLVABLE_CONDITION ); -use Try::Tiny; -use Data::Compare (); # no imports!!! guard against insane architecture - -# not importing first() as it will clash with our own method -use List::Util (); +use DBIx::Class::SQLMaker::Util qw( normalize_sqla_condition extract_equality_conditions ); BEGIN { # De-duplication in _merge_attr() is disabled, but left in for reference @@ -59,7 +59,7 @@ just stores all the conditions needed to create the query. A basic ResultSet representing the data of an entire table is returned by calling C on a L and passing in a -L name. +L name. my $users_rs = $schema->resultset('User'); @@ -442,7 +442,7 @@ sub search_rs { $call_cond = shift; } # fish out attrs in the ($condref, $attr) case - elsif (@_ == 2 and ( ! defined $_[0] or (ref $_[0]) ne '') ) { + elsif (@_ == 2 and ( ! defined $_[0] or length ref $_[0] ) ) { ($call_cond, $call_attrs) = @_; } elsif (@_ % 2) { @@ -456,7 +456,7 @@ sub search_rs { for my $i (0 .. $#_) { next if $i % 2; $self->throw_exception ('All keys in condition key/value pairs must be plain scalars') - if (! defined $_[$i] or ref $_[$i] ne ''); + if (! defined $_[$i] or length ref $_[$i] ); } $call_cond = { @_ }; @@ -465,7 +465,7 @@ sub search_rs { # see if we can keep the cache (no $rs changes) my $cache; my %safe = (alias => 1, cache => 1); - if ( ! List::Util::first { !$safe{$_} } keys %$call_attrs and ( + if ( ! grep { !$safe{$_} } keys %$call_attrs and ( ! defined $call_cond or ref $call_cond eq 'HASH' && ! keys %$call_cond @@ -489,9 +489,8 @@ sub search_rs { my @selector_attrs = qw/select as columns cols +select +as +columns include_columns/; # reset the current selector list if new selectors are supplied - if (List::Util::first { exists $call_attrs->{$_} } qw/columns cols select as/) { - delete @{$old_attrs}{(@selector_attrs, '_dark_selector')}; - } + delete @{$old_attrs}{(@selector_attrs, '_dark_selector')} + if grep { exists $call_attrs->{$_} } qw(columns cols select as); # Normalize the new selector list (operates on the passed-in attr structure) # Need to do it on every chain instead of only once on _resolved_attrs, in @@ -553,7 +552,6 @@ sub search_rs { return $rs; } -my $dark_sel_dumper; sub _normalize_selection { my ($self, $attrs) = @_; @@ -618,11 +616,10 @@ sub _normalize_selection { else { $attrs->{_dark_selector} = { plus_stage => $pref, - string => ($dark_sel_dumper ||= do { - require Data::Dumper::Concise; - Data::Dumper::Concise::DumperObject()->Indent(0); - })->Values([$_])->Dump - , + string => do { + local $Data::Dumper::Indent = 0; + dump_value $_; + }, }; last SELECTOR; } @@ -656,26 +653,15 @@ sub _stack_cond { (ref $_ eq 'HASH' and ! keys %$_) ) and $_ = undef for ($left, $right); - # either on of the two undef or both undef - if ( ( (defined $left) xor (defined $right) ) or ! defined $left ) { - return defined $left ? $left : $right; - } - - my $cond = $self->result_source->schema->storage->_collapse_cond({ -and => [$left, $right] }); - - for my $c (grep { ref $cond->{$_} eq 'ARRAY' and ($cond->{$_}[0]||'') eq '-and' } keys %$cond) { - - my @vals = sort @{$cond->{$c}}[ 1..$#{$cond->{$c}} ]; - my @fin = shift @vals; - - for my $v (@vals) { - push @fin, $v unless Data::Compare::Compare( $fin[-1], $v ); - } + return( + # either one of the two undef + ( (defined $left) xor (defined $right) ) ? ( defined $left ? $left : $right ) - $cond->{$c} = (@fin == 1) ? $fin[0] : [-and => @fin ]; - } + # both undef + : ( ! defined $left ) ? undef - $cond; + : { -and => [$left, $right] } + ); } =head2 search_literal @@ -788,7 +774,7 @@ See also L and L. sub find { my $self = shift; - my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {}); + my $attrs = (@_ > 1 && ref $_[-1] eq 'HASH' ? pop(@_) : {}); my $rsrc = $self->result_source; @@ -832,7 +818,7 @@ sub find { my $relinfo = $rsrc->relationship_info($key) and # implicitly skip has_many's (likely MC) - (ref (my $val = delete $call_cond->{$key}) ne 'ARRAY' ) + ( ref( my $val = delete $call_cond->{$key} ) ne 'ARRAY' ) ) { my ($rel_cond, $crosstable) = $rsrc->_resolve_condition( $relinfo->{cond}, $val, $key, $key @@ -852,7 +838,7 @@ sub find { if (defined $constraint_name) { $final_cond = $self->_qualify_cond_columns ( - $self->result_source->_minimal_valueset_satisfying_constraint( + $rsrc->_minimal_valueset_satisfying_constraint( constraint_name => $constraint_name, values => ($self->_merge_with_rscond($call_cond))[0], carp_on_nulls => 1, @@ -887,17 +873,17 @@ sub find { join "\x00", sort $rsrc->unique_constraint_columns($c_name) }++; - try { + dbic_internal_try { push @unique_queries, $self->_qualify_cond_columns( - $self->result_source->_minimal_valueset_satisfying_constraint( + $rsrc->_minimal_valueset_satisfying_constraint( constraint_name => $c_name, values => ($self->_merge_with_rscond($call_cond))[0], - columns_info => ($ci ||= $self->result_source->columns_info), + columns_info => ($ci ||= $rsrc->columns_info), ), $alias ); } - catch { + dbic_internal_catch { push @fc_exceptions, $_ if $_ =~ /\bFilterColumn\b/; }; } @@ -998,7 +984,8 @@ See also L. =cut -sub search_related { +sub search_related :DBIC_method_is_indirect_sugar { + DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call; return shift->related_resultset(shift)->search(@_); } @@ -1009,7 +996,8 @@ it guarantees a resultset, even in list context. =cut -sub search_related_rs { +sub search_related_rs :DBIC_method_is_indirect_sugar { + DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call; return shift->related_resultset(shift)->search_rs(@_); } @@ -1033,7 +1021,7 @@ sub cursor { return $self->{cursor} ||= do { my $attrs = $self->_resolved_attrs; - $self->result_source->storage->select( + $self->result_source->schema->storage->select( $attrs->{from}, $attrs->{select}, $attrs->{where}, $attrs ); }; @@ -1106,7 +1094,7 @@ sub single { } } - my $data = [ $self->result_source->storage->select_single( + my $data = [ $self->result_source->schema->storage->select_single( $attrs->{from}, $attrs->{select}, $attrs->{where}, $attrs )]; @@ -1133,9 +1121,7 @@ Returns a L instance for a column of the ResultSet =cut sub get_column { - my ($self, $column) = @_; - my $new = DBIx::Class::ResultSetColumn->new($self, $column); - return $new; + DBIx::Class::ResultSetColumn->new(@_); } =head2 search_like @@ -1157,7 +1143,7 @@ You most likely want to use L with specific operators. For more information, see L. -This method is deprecated and will be removed in 0.09. Use L +This method is deprecated and will be removed in 0.09. Use L instead. An example conversion is: ->search_like({ foo => 'bar' }); @@ -1175,7 +1161,7 @@ sub search_like { .' Instead use ->search({ x => { -like => "y%" } })' .' (note the outer pair of {}s - they are important!)' ); - my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {}); + my $attrs = (@_ > 1 && ref $_[-1] eq 'HASH' ? pop(@_) : {}); my $query = ref $_[0] eq 'HASH' ? { %{shift()} }: {@_}; $query->{$_} = { 'like' => $query->{$_} } for keys %$query; return $class->search($query, { %$attrs }); @@ -1392,11 +1378,7 @@ sub _construct_results { $self->{_result_inflator}{is_hri} = ( ( ! $self->{_result_inflator}{is_core_row} and - $inflator_cref == ( - require DBIx::Class::ResultClass::HashRefInflator - && - DBIx::Class::ResultClass::HashRefInflator->can('inflate_result') - ) + $inflator_cref == \&DBIx::Class::ResultClass::HashRefInflator::inflate_result ) ? 1 : 0 ) unless defined $self->{_result_inflator}{is_hri}; @@ -1427,7 +1409,7 @@ sub _construct_results { : '@$rows = map { $inflator_cref->($res_class, $rsrc, { %s } ) } @$rows' ), ( join (', ', map { "\$infmap->[$_] => \$_->[$_]" } 0..$#$infmap ) ) - ); + ) . '; 1' or die; } } else { @@ -1437,57 +1419,30 @@ sub _construct_results { : 'classic_nonpruning' ; - # $args and $attrs to _mk_row_parser are separated to delineate what is - # core collapser stuff and what is dbic $rs specific - @{$self->{_row_parser}{$parser_type}}{qw(cref nullcheck)} = $rsrc->_mk_row_parser({ - eval => 1, - inflate_map => $infmap, - collapse => $attrs->{collapse}, - premultiplied => $attrs->{_main_source_premultiplied}, - hri_style => $self->{_result_inflator}{is_hri}, - prune_null_branches => $self->{_result_inflator}{is_hri} || $self->{_result_inflator}{is_core_row}, - }, $attrs) unless $self->{_row_parser}{$parser_type}{cref}; - - # column_info metadata historically hasn't been too reliable. - # We need to start fixing this somehow (the collapse resolver - # can't work without it). Add an explicit check for the *main* - # result, hopefully this will gradually weed out such errors - # - # FIXME - this is a temporary kludge that reduces performance - # It is however necessary for the time being - my ($unrolled_non_null_cols_to_check, $err); - - if (my $check_non_null_cols = $self->{_row_parser}{$parser_type}{nullcheck} ) { + unless( $self->{_row_parser}{$parser_type}{cref} ) { - $err = - 'Collapse aborted due to invalid ResultSource metadata - the following ' - . 'selections are declared non-nullable but NULLs were retrieved: ' - ; - - my @violating_idx; - COL: for my $i (@$check_non_null_cols) { - ! defined $_->[$i] and push @violating_idx, $i and next COL for @$rows; - } + # $args and $attrs to _mk_row_parser are separated to delineate what is + # core collapser stuff and what is dbic $rs specific + $self->{_row_parser}{$parser_type}{src} = $rsrc->_mk_row_parser({ + inflate_map => $infmap, + collapse => $attrs->{collapse}, + premultiplied => $attrs->{_main_source_premultiplied}, + hri_style => $self->{_result_inflator}{is_hri}, + prune_null_branches => $self->{_result_inflator}{is_hri} || $self->{_result_inflator}{is_core_row}, + }, $attrs); - $self->throw_exception( $err . join (', ', map { "'$infmap->[$_]'" } @violating_idx ) ) - if @violating_idx; + $self->{_row_parser}{$parser_type}{cref} = do { + package # hide form PAUSE + DBIx::Class::__GENERATED_ROW_PARSER__; - $unrolled_non_null_cols_to_check = join (',', @$check_non_null_cols); + eval $self->{_row_parser}{$parser_type}{src}; + } || die $@; } - my $next_cref = - ($did_fetch_all or ! $attrs->{collapse}) ? undef - : defined $unrolled_non_null_cols_to_check ? eval sprintf <<'EOS', $unrolled_non_null_cols_to_check -sub { - # FIXME SUBOPTIMAL - we can do better, cursor->next/all (well diff. methods) should return a ref - my @r = $cursor->next or return; - if (my @violating_idx = grep { ! defined $r[$_] } (%s) ) { - $self->throw_exception( $err . join (', ', map { "'$infmap->[$_]'" } @violating_idx ) ) - } - \@r -} -EOS - : sub { + # this needs to close over the *current* cursor, hence why it is not cached above + my $next_cref = ($did_fetch_all or ! $attrs->{collapse}) + ? undef + : sub { # FIXME SUBOPTIMAL - we can do better, cursor->next/all (well diff. methods) should return a ref my @r = $cursor->next or return; \@r @@ -1496,9 +1451,25 @@ EOS $self->{_row_parser}{$parser_type}{cref}->( $rows, - $next_cref ? ( $next_cref, $self->{_stashed_rows} = [] ) : (), + $next_cref, + ( $self->{_stashed_rows} = [] ), + ( my $null_violations = {} ), ); + $self->throw_exception( + 'Collapse aborted - the following columns are declared (or defaulted to) ' + . 'non-nullable within DBIC but NULLs were retrieved from storage: ' + . join( ', ', map { "'$infmap->[$_]'" } sort { $a <=> $b } keys %$null_violations ) + . ' within data row ' . dump_value({ + map { + $infmap->[$_] => + ( ! defined $self->{_stashed_rows}[0][$_] or length $self->{_stashed_rows}[0][$_] < 50 ) + ? $self->{_stashed_rows}[0][$_] + : substr( $self->{_stashed_rows}[0][$_], 0, 50 ) . '...' + } 0 .. $#{$self->{_stashed_rows}[0]} + }) + ) if keys %$null_violations; + # simple in-place substitution, does not regrow $rows if ($self->{_result_inflator}{is_core_row}) { $_ = $inflator_cref->($res_class, $rsrc, @$_) for @$rows @@ -1552,8 +1523,8 @@ L<"table"|DBIx::Class::Manual::Glossary/"ResultSource"> class. Note that changing the result_class will also remove any components that were originally loaded in the source class via -L. Any overloaded methods -in the original source class will not run. +L. +Any overloaded methods in the original source class will not run. =cut @@ -1675,7 +1646,7 @@ sub _count_rs { # overwrite the selector (supplied by the storage) $rsrc->resultset_class->new($rsrc, { %$tmp_attrs, - select => $rsrc->storage->_count_select ($rsrc, $attrs), + select => $rsrc->schema->storage->_count_select ($rsrc, $attrs), as => 'count', })->get_column ('count'); } @@ -1706,7 +1677,7 @@ sub _count_subq_rs { # Calculate subquery selector if (my $g = $sub_attrs->{group_by}) { - my $sql_maker = $rsrc->storage->sql_maker; + my $sql_maker = $rsrc->schema->storage->sql_maker; # necessary as the group_by may refer to aliased functions my $sel_index; @@ -1773,7 +1744,7 @@ sub _count_subq_rs { return $rsrc->resultset_class ->new ($rsrc, $sub_attrs) ->as_subselect_rs - ->search ({}, { columns => { count => $rsrc->storage->_count_select ($rsrc, $attrs) } }) + ->search ({}, { columns => { count => $rsrc->schema->storage->_count_select ($rsrc, $attrs) } }) ->get_column ('count'); } @@ -1796,7 +1767,10 @@ with the passed arguments, then L. =cut -sub count_literal { shift->search_literal(@_)->count; } +sub count_literal :DBIC_method_is_indirect_sugar { + DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call; + shift->search_literal(@_)->count +} =head2 all @@ -1873,7 +1847,8 @@ an object for the first result (or C if the resultset is empty). =cut -sub first { +sub first :DBIC_method_is_indirect_sugar { + DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call; return $_[0]->reset->next; } @@ -1913,7 +1888,7 @@ sub _rs_update_delete { $storage->_prune_unused_joins ($attrs); # any non-pruneable non-local restricting joins imply subq - $needs_subq = defined List::Util::first { $_ ne $attrs->{alias} } keys %{ $join_classifications->{restricting} || {} }; + $needs_subq = grep { $_ ne $attrs->{alias} } keys %{ $join_classifications->{restricting} || {} }; } # check if the head is composite (by now all joins are thrown out unless $needs_subq) @@ -1930,7 +1905,7 @@ sub _rs_update_delete { # a condition containing 'me' or other table prefixes will not work # at all. Tell SQLMaker to dequalify idents via a gross hack. $cond = do { - my $sqla = $rsrc->storage->sql_maker; + my $sqla = $rsrc->schema->storage->sql_maker; local $sqla->{_dequalify_idents} = 1; \[ $sqla->_recurse_where($self->{cond}) ]; }; @@ -2228,36 +2203,44 @@ case there are obviously no benefits to using this method over L. sub populate { my $self = shift; - my ($data, $guard); - # this is naive and just a quick check # the types will need to be checked more thoroughly when the # multi-source populate gets added - if (ref $_[0] eq 'ARRAY') { - return unless @{$_[0]}; - - $data = $_[0] if (ref $_[0][0] eq 'HASH' or ref $_[0][0] eq 'ARRAY'); - } - - $self->throw_exception('Populate expects an arrayref of hashrefs or arrayref of arrayrefs') - unless $data; + my $data = ( + ref $_[0] eq 'ARRAY' + and + ( @{$_[0]} or return ) + and + ( ref $_[0][0] eq 'HASH' or ref $_[0][0] eq 'ARRAY' ) + and + $_[0] + ) or $self->throw_exception('Populate expects an arrayref of hashrefs or arrayref of arrayrefs'); # FIXME - no cref handling # At this point assume either hashes or arrays - if(defined wantarray) { - my @results; + my $rsrc = $self->result_source; - $guard = $self->result_source->schema->storage->txn_scope_guard - if ( @$data > 2 or ( @$data == 2 and ref $data->[0] eq 'ARRAY' ) ); + if(defined wantarray) { + my (@results, $guard); if (ref $data->[0] eq 'ARRAY') { + # column names only, nothing to do + return if @$data == 1; + + $guard = $rsrc->schema->storage->txn_scope_guard + if @$data > 2; + @results = map { my $vals = $_; $self->new_result({ map { $data->[0][$_] => $vals->[$_] } 0..$#{$data->[0]} })->insert } @{$data}[1 .. $#$data] ; } else { + + $guard = $rsrc->schema->storage->txn_scope_guard + if @$data > 1; + @results = map { $self->new_result($_)->insert } @$data; } @@ -2269,7 +2252,6 @@ sub populate { # this means we have to walk the data structure twice # whether we want this or not # jnap, I hate you ;) - my $rsrc = $self->result_source; my $rel_info = { map { $_ => $rsrc->relationship_info($_) } $rsrc->relationships }; my ($colinfo, $colnames, $slices_with_rels); @@ -2286,6 +2268,8 @@ sub populate { # positional(!) explicit column list if ($i == 0) { + # column names only, nothing to do + return if @$data == 1; $colinfo->{$data->[0][$_]} = { pos => $_, name => $data->[0][$_] } and push @$colnames, $data->[0][$_] for 0 .. $#{$data->[0]}; @@ -2304,7 +2288,18 @@ sub populate { or ref $data->[$i][$_->{pos}] eq 'HASH' or - ( defined blessed $data->[$i][$_->{pos}] and $data->[$i][$_->{pos}]->isa('DBIx::Class::Row') ) + ( + defined blessed $data->[$i][$_->{pos}] + and + $data->[$i][$_->{pos}]->isa( + $DBIx::Class::ResultSource::__expected_result_class_isa + || + emit_loud_diag( + confess => 1, + msg => 'Global $DBIx::Class::ResultSource::__expected_result_class_isa unexpectedly unset...' + ) + ) + ) ) and 1 @@ -2312,7 +2307,18 @@ sub populate { # moar sanity check... sigh for ( ref $data->[$i][$_->{pos}] eq 'ARRAY' ? @{$data->[$i][$_->{pos}]} : $data->[$i][$_->{pos}] ) { - if ( defined blessed $_ and $_->isa('DBIx::Class::Row' ) ) { + if ( + defined blessed $_ + and + $_->isa( + $DBIx::Class::ResultSource::__expected_result_class_isa + || + emit_loud_diag( + confess => 1, + msg => 'Global $DBIx::Class::ResultSource::__expected_result_class_isa unexpectedly unset...' + ) + ) + ) { carp_unique("Fast-path populate() with supplied related objects is not possible - falling back to regular create()"); return my $throwaway = $self->populate(@_); } @@ -2354,7 +2360,18 @@ sub populate { or ref $data->[$i]{$_} eq 'HASH' or - ( defined blessed $data->[$i]{$_} and $data->[$i]{$_}->isa('DBIx::Class::Row') ) + ( + defined blessed $data->[$i]{$_} + and + $data->[$i]{$_}->isa( + $DBIx::Class::ResultSource::__expected_result_class_isa + || + emit_loud_diag( + confess => 1, + msg => 'Global $DBIx::Class::ResultSource::__expected_result_class_isa unexpectedly unset...' + ) + ) + ) ) and 1 @@ -2362,7 +2379,18 @@ sub populate { # moar sanity check... sigh for ( ref $data->[$i]{$_} eq 'ARRAY' ? @{$data->[$i]{$_}} : $data->[$i]{$_} ) { - if ( defined blessed $_ and $_->isa('DBIx::Class::Row' ) ) { + if ( + defined blessed $_ + and + $_->isa( + $DBIx::Class::ResultSource::__expected_result_class_isa + || + emit_loud_diag( + confess => 1, + msg => 'Global $DBIx::Class::ResultSource::__expected_result_class_isa unexpectedly unset...' + ) + ) + ) { carp_unique("Fast-path populate() with supplied related objects is not possible - falling back to regular create()"); return my $throwaway = $self->populate(@_); } @@ -2423,13 +2451,14 @@ sub populate { } ### start work + my $guard; $guard = $rsrc->schema->storage->txn_scope_guard if $slices_with_rels; ### main source data # FIXME - need to switch entirely to a coderef-based thing, # so that large sets aren't copied several times... I think - $rsrc->storage->insert_bulk( + $rsrc->schema->storage->_insert_bulk( $rsrc, [ @$colnames, sort keys %$rs_data ], [ map { @@ -2580,11 +2609,8 @@ Passes the hashref of input on to L. sub new_result { my ($self, $values) = @_; - $self->throw_exception( "new_result takes only one argument - a hashref of values" ) - if @_ > 2; - - $self->throw_exception( "Result object instantiation requires a hashref as argument" ) - unless (ref $values eq 'HASH'); + $self->throw_exception( "Result object instantiation requires a single hashref argument" ) + if @_ > 2 or ref $values ne 'HASH'; my ($merged_cond, $cols_from_relations) = $self->_merge_with_rscond($values); @@ -2634,7 +2660,7 @@ sub _merge_with_rscond { @cols_from_relations = keys %{ $implied_data || {} }; } else { - my $eqs = $self->result_source->schema->storage->_extract_fixed_condition_columns($self->{cond}, 'consider_nulls'); + my $eqs = extract_equality_conditions( $self->{cond}, 'consider_nulls' ); $implied_data = { map { ( ($eqs->{$_}||'') eq UNRESOLVABLE_CONDITION ) ? () : ( $_ => $eqs->{$_} ) } keys %$eqs }; @@ -2748,7 +2774,7 @@ sub as_query { my $attrs = { %{ $self->_resolved_attrs } }; - my $aq = $self->result_source->storage->_select_args_to_query ( + my $aq = $self->result_source->schema->storage->_select_args_to_query ( $attrs->{from}, $attrs->{select}, $attrs->{where}, $attrs ); @@ -2794,7 +2820,7 @@ all in the call to C, even when set to C. sub find_or_new { my $self = shift; - my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {}); + my $attrs = (@_ > 1 && ref $_[-1] eq 'HASH' ? pop(@_) : {}); my $hash = ref $_[0] eq 'HASH' ? shift : {@_}; if (keys %$hash and my $row = $self->find($hash, $attrs) ) { return $row; @@ -2883,7 +2909,7 @@ L. =cut -sub create { +sub create :DBIC_method_is_indirect_sugar { #my ($self, $col_data) = @_; DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call; return shift->new_result(shift)->insert; @@ -2963,7 +2989,7 @@ database! sub find_or_create { my $self = shift; - my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {}); + my $attrs = (@_ > 1 && ref $_[-1] eq 'HASH' ? pop(@_) : {}); my $hash = ref $_[0] eq 'HASH' ? shift : {@_}; if (keys %$hash and my $row = $self->find($hash, $attrs) ) { return $row; @@ -3029,7 +3055,7 @@ database! sub update_or_create { my $self = shift; - my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {}); + my $attrs = (@_ > 1 && ref $_[-1] eq 'HASH' ? pop(@_) : {}); my $cond = ref $_[0] eq 'HASH' ? shift : {@_}; my $row = $self->find($cond, $attrs); @@ -3092,7 +3118,7 @@ See also L, L and L. sub update_or_new { my $self = shift; - my $attrs = ( @_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {} ); + my $attrs = ( @_ > 1 && ref $_[-1] eq 'HASH' ? pop(@_) : {} ); my $cond = ref $_[0] eq 'HASH' ? shift : {@_}; my $row = $self->find( $cond, $attrs ); @@ -3201,7 +3227,7 @@ sub is_paged { sub is_ordered { my ($self) = @_; - return scalar $self->result_source->storage->_extract_order_criteria($self->{attrs}{order_by}); + return scalar $self->result_source->schema->storage->_extract_order_criteria($self->{attrs}{order_by}); } =head2 related_resultset @@ -3221,10 +3247,16 @@ Returns a related resultset for the supplied relationship name. =cut sub related_resultset { - my ($self, $rel) = @_; + $_[0]->throw_exception( + 'Extra arguments to $rs->related_resultset() were always quietly ' + . 'discarded without consideration, you need to switch to ' + . '...->related_resultset( $relname )->search_rs( $search, $args ) instead.' + ) if @_ > 2; - return $self->{related_resultsets}{$rel} - if defined $self->{related_resultsets}{$rel}; + return $_[0]->{related_resultsets}{$_[1]} + if defined $_[0]->{related_resultsets}{$_[1]}; + + my ($self, $rel) = @_; return $self->{related_resultsets}{$rel} = do { my $rsrc = $self->result_source; @@ -3237,22 +3269,25 @@ sub related_resultset { my $attrs = $self->_chain_relationship($rel); - my $join_count = $attrs->{seen_join}{$rel}; + my $storage = $rsrc->schema->storage; - my $alias = $self->result_source->storage - ->relname_to_table_alias($rel, $join_count); + # Previously this atribute was deleted (instead of being set as it is now) + # Doing so seems to be harmless in all available test permutations + # See also 01d59a6a6 and mst's comment below + # + $attrs->{alias} = $storage->relname_to_table_alias( + $rel, + $attrs->{seen_join}{$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->_inner_join_to_node ($attrs->{from}, $alias); - + $attrs->{from} = $storage->_inner_join_to_node( $attrs->{from}, $attrs->{alias} ); #XXX - temp fix for result_class bug. There likely is a more elegant fix -groditi - delete @{$attrs}{qw(result_class alias)}; - - my $rel_source = $rsrc->related_source($rel); + delete $attrs->{result_class}; my $new = do { @@ -3261,16 +3296,19 @@ sub related_resultset { # 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 $rel_attrs = $rel_source->resultset_attributes; - local $rel_attrs->{alias} = $alias; - - $rel_source->resultset - ->search_rs( - undef, { - %$attrs, - where => $attrs->{where}, - }); + # -- mst ~ 2007 (01d59a6a6) + # + # FIXME - this seems to be no longer neccessary (perhaps due to the + # advances in relcond resolution. Testing DBIC::S::RWO and its only + # dependent (as of Jun 2015 ) does not yield any difference with or + # without this line. Nevertheless keep it as is for now, to minimize + # churn, there is enough potential for breakage in 0.0829xx as it is + # -- ribasushi Jun 2015 + # + my $rel_source = $rsrc->related_source($rel); + local $rel_source->resultset_attributes->{alias} = $attrs->{alias}; + + $rel_source->resultset->search_rs( undef, $attrs ); }; if (my $cache = $self->get_cache) { @@ -3321,6 +3359,9 @@ source alias of the current result set: }); } +The alias of L can be altered by the +L. + =cut sub current_source_alias { @@ -3517,9 +3558,25 @@ sub _resolved_attrs { $self->throw_exception("Specifying distinct => 1 in conjunction with collapse => 1 is unsupported") if $attrs->{collapse} and $attrs->{distinct}; + + # Sanity check the paging attributes + # SQLMaker does it too, but in case of a software_limit we'll never get there + if (defined $attrs->{offset}) { + $self->throw_exception('A supplied offset attribute must be a non-negative integer') + if ( $attrs->{offset} =~ /[^0-9]/ or $attrs->{offset} < 0 ); + } + if (defined $attrs->{rows}) { + $self->throw_exception("The rows attribute must be a positive integer if present") + if ( $attrs->{rows} =~ /[^0-9]/ or $attrs->{rows} <= 0 ); + } + + # normalize where condition + $attrs->{where} = normalize_sqla_condition( $attrs->{where} ) + if $attrs->{where}; + # default selection list $attrs->{columns} = [ $source->columns ] - unless List::Util::first { exists $attrs->{$_} } qw/columns cols select as/; + unless grep { exists $attrs->{$_} } qw/columns cols select as/; # merge selectors together for (qw/columns select as/) { @@ -3615,62 +3672,35 @@ sub _resolved_attrs { ]; } - if ( defined $attrs->{order_by} ) { - $attrs->{order_by} = ( - ref( $attrs->{order_by} ) eq 'ARRAY' - ? [ @{ $attrs->{order_by} } ] - : [ $attrs->{order_by} || () ] - ); - } - if ($attrs->{group_by} and ref $attrs->{group_by} ne 'ARRAY') { - $attrs->{group_by} = [ $attrs->{group_by} ]; - } + for my $attr (qw(order_by group_by)) { + if ( defined $attrs->{$attr} ) { + $attrs->{$attr} = ( + ref( $attrs->{$attr} ) eq 'ARRAY' + ? [ @{ $attrs->{$attr} } ] + : [ $attrs->{$attr} || () ] + ); - # generate selections based on the prefetch helper - my ($prefetch, @prefetch_select, @prefetch_as); - $prefetch = $self->_merge_joinpref_attr( {}, delete $attrs->{prefetch} ) - if defined $attrs->{prefetch}; + delete $attrs->{$attr} unless @{$attrs->{$attr}}; + } + } - if ($prefetch) { - - $self->throw_exception("Unable to prefetch, resultset contains an unnamed selector $attrs->{_dark_selector}{string}") - if $attrs->{_dark_selector}; + # set collapse default based on presence of prefetch + my $prefetch; + if ( + defined $attrs->{prefetch} + and + $prefetch = $self->_merge_joinpref_attr( {}, delete $attrs->{prefetch} ) + ) { $self->throw_exception("Specifying prefetch in conjunction with an explicit collapse => 0 is unsupported") if defined $attrs->{collapse} and ! $attrs->{collapse}; $attrs->{collapse} = 1; - - # 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') { - - my $start_depth = $attrs->{seen_join}{-relation_chain_depth} || 0; - - 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; - - 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}; - } - } - - my @prefetch = $source->_resolve_prefetch( $prefetch, $alias, $join_map ); - - # save these for after distinct resolution - @prefetch_select = map { $_->[0] } @prefetch; - @prefetch_as = map { $_->[1] } @prefetch; } + # run through the resulting joinstructure (starting from our current slot) # and unset collapse if proven unnecessary # @@ -3707,7 +3737,7 @@ sub _resolved_attrs { if ( ! $attrs->{_main_source_premultiplied} and - ! List::Util::first { ! $_->[0]{-is_single} } @fromlist + ! grep { ! $_->[0]{-is_single} } @fromlist ) { $attrs->{collapse} = 0; } @@ -3720,6 +3750,7 @@ sub _resolved_attrs { } } + # generate the distinct induced group_by before injecting the prefetched select/as parts if (delete $attrs->{distinct}) { if ($attrs->{group_by}) { @@ -3728,7 +3759,7 @@ sub _resolved_attrs { else { $attrs->{_grouped_by_distinct} = 1; # distinct affects only the main selection part, not what prefetch may add below - ($attrs->{group_by}, my $new_order) = $source->storage->_group_over_selection($attrs); + ($attrs->{group_by}, my $new_order) = $source->schema->storage->_group_over_selection($attrs); # FIXME possibly ignore a rewritten order_by (may turn out to be an issue) # The thinking is: if we are collapsing the subquerying prefetch engine will @@ -3739,9 +3770,38 @@ sub _resolved_attrs { } } - # inject prefetch-bound selection (if any) - push @{$attrs->{select}}, @prefetch_select; - push @{$attrs->{as}}, @prefetch_as; + + # generate selections based on the prefetch helper + if ($prefetch) { + + $self->throw_exception("Unable to prefetch, resultset contains an unnamed selector $attrs->{_dark_selector}{string}") + if $attrs->{_dark_selector}; + + # 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 $joined_node_aliases_map = {}; + if (ref $attrs->{from} eq 'ARRAY') { + + my $start_depth = $attrs->{seen_join}{-relation_chain_depth} || 0; + + 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; + + my @jpath = map { keys %$_ } @{$j->[0]{-join_path}}; + + my $p = $joined_node_aliases_map; + $p = $p->{$_} ||= {} for @jpath[ ($start_depth/2) .. $#jpath]; #only even depths are actual jpath boundaries + push @{$p->{-join_aliases} }, $j->[0]{-alias}; + } + } + + ( push @{$attrs->{select}}, $_->[0] ) and ( push @{$attrs->{as}}, $_->[1] ) + for $source->_resolve_selection_from_prefetch( $prefetch, $joined_node_aliases_map ); + } + $attrs->{_simple_passthrough_construction} = !( $attrs->{collapse} @@ -3749,6 +3809,7 @@ sub _resolved_attrs { grep { $_ =~ /\./ } @{$attrs->{as}} ); + # 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 @@ -3814,8 +3875,10 @@ sub _calculate_score { if (ref $b eq 'HASH') { my ($b_key) = keys %{$b}; + $b_key = '' if ! defined $b_key; if (ref $a eq 'HASH') { my ($a_key) = keys %{$a}; + $a_key = '' if ! defined $a_key; if ($a_key eq $b_key) { return (1 + $self->_calculate_score( $a->{$a_key}, $b->{$b_key} )); } else { @@ -3904,7 +3967,7 @@ sub _merge_joinpref_attr { }, ARRAY => sub { return $_[1] if !defined $_[0]; - return $_[1] if __HM_DEDUP and List::Util::first { $_ eq $_[0] } @{$_[1]}; + return $_[1] if __HM_DEDUP and grep { $_ eq $_[0] } @{$_[1]}; return [$_[0], @{$_[1]}] }, HASH => sub { @@ -3917,7 +3980,7 @@ sub _merge_joinpref_attr { ARRAY => { SCALAR => sub { return $_[0] if !defined $_[1]; - return $_[0] if __HM_DEDUP and List::Util::first { $_ eq $_[1] } @{$_[0]}; + return $_[0] if __HM_DEDUP and grep { $_ eq $_[1] } @{$_[0]}; return [@{$_[0]}, $_[1]] }, ARRAY => sub { @@ -3930,7 +3993,7 @@ sub _merge_joinpref_attr { HASH => sub { return [ $_[1] ] if ! @{$_[0]}; return $_[0] if !keys %{$_[1]}; - return $_[0] if __HM_DEDUP and List::Util::first { $_ eq $_[1] } @{$_[0]}; + return $_[0] if __HM_DEDUP and grep { $_ eq $_[1] } @{$_[0]}; return [ @{$_[0]}, $_[1] ]; }, }, @@ -3945,7 +4008,7 @@ sub _merge_joinpref_attr { return [] if !keys %{$_[0]} and !@{$_[1]}; return [ $_[0] ] if !@{$_[1]}; return $_[1] if !keys %{$_[0]}; - return $_[1] if __HM_DEDUP and List::Util::first { $_ eq $_[0] } @{$_[1]}; + return $_[1] if __HM_DEDUP and grep { $_ eq $_[0] } @{$_[1]}; return [ $_[0], @{$_[1]} ]; }, HASH => sub { @@ -4082,19 +4145,34 @@ is the same as as => [qw(some_column dbic_slot)] If you want to individually retrieve related columns (in essence perform -manual prefetch) you have to make sure to specify the correct inflation slot +manual L) you have to make sure to specify the correct inflation slot chain such that it matches existing relationships: my $rs = $schema->resultset('Artist')->search({}, { # required to tell DBIC to collapse has_many relationships collapse => 1, - join => { cds => 'tracks'}, + join => { cds => 'tracks' }, '+columns' => { 'cds.cdid' => 'cds.cdid', 'cds.tracks.title' => 'tracks.title', }, }); +Like elsewhere, literal SQL or literal values can be included by using a +scalar reference or a literal bind value, and these values will be available +in the result with C (see also +L): + + # equivalent SQL: SELECT 1, 'a string', IF(my_column,?,?) ... + # bind values: $true_value, $false_value + columns => [ + { + foo => \1, + bar => \q{'a string'}, + baz => \[ 'IF(my_column,?,?)', $true_value, $false_value ], + } + ] + =head2 +columns B You B explicitly quote C<'+columns'> when using this attribute. @@ -4147,10 +4225,11 @@ names: 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 supplied as shown in the example above. =head2 +select @@ -4180,8 +4259,10 @@ Indicates DBIC-side names for object inflation. That is L indicates the slot name in which the column value will be stored within the L object. The value will then be accessible via this identifier by the C method (or via the object accessor B) as shown below. The L attribute has -B with the SQL-side C. See L for details. +with the same name already exists>) as shown below. + +The L attribute has B with the SQL-side identifier +aliasing C. See L for details. $rs = $schema->resultset('Employee')->search(undef, { select => [ @@ -4357,8 +4438,10 @@ For a more in-depth discussion, see L. This attribute is a shorthand for specifying a L spec, adding all columns from the joined related sources as L and setting -L to a true value. For example, the following two queries are -equivalent: +L to a true value. It can be thought of as a rough B +of the L attribute. + +For example, the following two queries are equivalent: my $rs = $schema->resultset('Artist')->search({}, { prefetch => { cds => ['genre', 'tracks' ] }, @@ -4535,15 +4618,20 @@ A arrayref of columns to group by. Can include columns of joined tables. =back -HAVING is a select statement attribute that is applied between GROUP BY and -ORDER BY. It is applied to the after the grouping calculations have been -done. +The HAVING operator specifies a B condition applied to the set +after the grouping calculations have been done. In other words it is a +constraint just like L (and accepting the same +L) applied to the data +as it exists after GROUP BY has taken place. Specifying L without +L is a logical mistake, and a fatal error on most RDBMS engines. + +E.g. having => { 'count_employee' => { '>=', 100 } } or with an in-place function in which case literal SQL is required: - having => \[ 'count(employee) >= ?', [ count => 100 ] ] + having => \[ 'count(employee) >= ?', 100 ] =head2 distinct @@ -4567,19 +4655,14 @@ setting is ignored and an appropriate warning is issued. =head2 where -=over 4 - -Adds to the WHERE clause. +Adds extra conditions to the resultset, combined with the preexisting C +conditions, same as the B argument to the L # 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 resultset. - -For more complicated where clauses see L. - -=back +Note that the above example is +L. =head2 cache @@ -4592,7 +4675,7 @@ revisit rows in your ResultSet: ... do stuff ... } - $rs->first; # without cache, this would issue a query + $resultset->first; # without cache, this would issue a query By default, searches are not cached. @@ -4785,11 +4868,15 @@ supported: [ undef, $val ] === [ {}, $val ] $val === [ {}, $val ] -=head1 AUTHOR AND CONTRIBUTORS +=head1 FURTHER QUESTIONS? -See L and L in DBIx::Class +Check the list of L. -=head1 LICENSE +=head1 COPYRIGHT AND LICENSE -You may distribute this code under the same terms as Perl itself. +This module is free software L +by the L. You can +redistribute it and/or modify it under the same terms as the +L. +=cut