X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FStorage%2FDBIHacks.pm;h=26f8dcac1f559a252ba5ba3d69627cf32c8d9c46;hb=8d73fcd44e0441f0252744be32bada6816c5ff6b;hp=aa112861548558deae8afbe13df528d549d1df21;hpb=9736be652a2d4ce442c222c17ba5d47fff28bbed;p=dbsrgits%2FDBIx-Class.git

diff --git a/lib/DBIx/Class/Storage/DBIHacks.pm b/lib/DBIx/Class/Storage/DBIHacks.pm
index aa11286..26f8dca 100644
--- a/lib/DBIx/Class/Storage/DBIHacks.pm
+++ b/lib/DBIx/Class/Storage/DBIHacks.pm
@@ -15,7 +15,8 @@ use mro 'c3';
 
 use List::Util 'first';
 use Scalar::Util 'blessed';
-use Sub::Name 'subname';
+use DBIx::Class::_Util 'UNRESOLVABLE_CONDITION';
+use SQL::Abstract qw(is_plain_value is_literal_value);
 use namespace::clean;
 
 #
@@ -783,31 +784,9 @@ sub _resolve_column_info {
 sub _inner_join_to_node {
   my ($self, $from, $alias) = @_;
 
-  # subqueries and other oddness are naturally not supported
-  return $from if (
-    ref $from ne 'ARRAY'
-      ||
-    @$from <= 1
-      ||
-    ref $from->[0] ne 'HASH'
-      ||
-    ! $from->[0]{-alias}
-      ||
-    $from->[0]{-alias} eq $alias  # this last bit means $alias is the head of $from - nothing to do
-  );
+  my $switch_branch = $self->_find_join_path_to_node($from, $alias);
 
-  # find the current $alias in the $from structure
-  my $switch_branch;
-  JOINSCAN:
-  for my $j (@{$from}[1 .. $#$from]) {
-    if ($j->[0]{-alias} eq $alias) {
-      $switch_branch = $j->[0]{-join_path};
-      last JOINSCAN;
-    }
-  }
-
-  # something else went quite wrong
-  return $from unless $switch_branch;
+  return $from unless @{$switch_branch||[]};
 
   # So it looks like we will have to switch some stuff around.
   # local() is useless here as we will be leaving the scope
@@ -835,6 +814,29 @@ sub _inner_join_to_node {
   return \@new_from;
 }
 
+sub _find_join_path_to_node {
+  my ($self, $from, $target_alias) = @_;
+
+  # subqueries and other oddness are naturally not supported
+  return undef if (
+    ref $from ne 'ARRAY'
+      ||
+    ref $from->[0] ne 'HASH'
+      ||
+    ! defined $from->[0]{-alias}
+  );
+
+  # no path - the head is the alias
+  return [] if $from->[0]{-alias} eq $target_alias;
+
+  for my $i (1 .. $#$from) {
+    return $from->[$i][0]{-join_path} if ( ($from->[$i][0]{-alias}||'') eq $target_alias );
+  }
+
+  # something else went quite wrong
+  return undef;
+}
+
 sub _extract_order_criteria {
   my ($self, $order_by, $sql_maker) = @_;
 
@@ -885,14 +887,14 @@ sub _order_by_is_stable {
 
   my @cols = (
     ( map { $_->[0] } $self->_extract_order_criteria($order_by) ),
-    ( $where ? @{ $self->_extract_fixed_condition_columns($where) || [] } : () ),
-  ) or return undef;
+    ( $where ? keys %{ $self->_extract_fixed_condition_columns($where) } : () ),
+  ) or return 0;
 
   my $colinfo = $self->_resolve_column_info($ident, \@cols);
 
   return keys %$colinfo
     ? $self->_columns_comprise_identifying_set( $colinfo,  \@cols )
-    : undef
+    : 0
   ;
 }
 
@@ -908,78 +910,70 @@ sub _columns_comprise_identifying_set {
     return 1 if $src->_identifying_column_set($_);
   }
 
-  return undef;
+  return 0;
 }
 
-# this is almost identical to the above, except it accepts only
+# this is almost similar to _order_by_is_stable, except it takes
 # a single rsrc, and will succeed only if the first portion of the order
 # by is stable.
 # returns that portion as a colinfo hashref on success
-sub _main_source_order_by_portion_is_stable {
-  my ($self, $main_rsrc, $order_by, $where) = @_;
+sub _extract_colinfo_of_stable_main_source_order_by_portion {
+  my ($self, $attrs) = @_;
+
+  my $nodes = $self->_find_join_path_to_node($attrs->{from}, $attrs->{alias});
 
-  die "Huh... I expect a blessed result_source..."
-    if ref($main_rsrc) eq 'ARRAY';
+  return unless defined $nodes;
 
   my @ord_cols = map
     { $_->[0] }
-    ( $self->_extract_order_criteria($order_by) )
+    ( $self->_extract_order_criteria($attrs->{order_by}) )
   ;
   return unless @ord_cols;
 
-  my $colinfos = $self->_resolve_column_info($main_rsrc);
+  my $valid_aliases = { map { $_ => 1 } (
+    $attrs->{from}[0]{-alias},
+    map { values %$_ } @$nodes,
+  ) };
 
-  for (0 .. $#ord_cols) {
-    if (
-      ! $colinfos->{$ord_cols[$_]}
-        or
-      $colinfos->{$ord_cols[$_]}{-result_source} != $main_rsrc
-    ) {
-      $#ord_cols =  $_ - 1;
-      last;
-    }
-  }
+  my $colinfos = $self->_resolve_column_info($attrs->{from});
 
-  # we just truncated it above
-  return unless @ord_cols;
+  my ($colinfos_to_return, $seen_main_src_cols);
 
-  my $order_portion_ci = { map {
-    $colinfos->{$_}{-colname} => $colinfos->{$_},
-    $colinfos->{$_}{-fq_colname} => $colinfos->{$_},
-  } @ord_cols };
+  for my $col (@ord_cols) {
+    # if order criteria is unresolvable - there is nothing we can do
+    my $colinfo = $colinfos->{$col} or last;
 
-  # since all we check here are the start of the order_by belonging to the
-  # top level $rsrc, a present identifying set will mean that the resultset
-  # is ordered by its leftmost table in a stable manner
-  #
-  # RV of _identifying_column_set contains unqualified names only
-  my $unqualified_idset = $main_rsrc->_identifying_column_set({
-    ( $where ? %{
-      $self->_resolve_column_info(
-        $main_rsrc, $self->_extract_fixed_condition_columns($where)||[]
-      )
-    } : () ),
-    %$order_portion_ci
-  }) or return;
-
-  my $ret_info;
-  my %unqualified_idcols_from_order = map {
-    $order_portion_ci->{$_} ? ( $_ => $order_portion_ci->{$_} ) : ()
-  } @$unqualified_idset;
-
-  # extra optimization - cut the order_by at the end of the identifying set
-  # (just in case the user was stupid and overlooked the obvious)
-  for my $i (0 .. $#ord_cols) {
-    my $col = $ord_cols[$i];
-    my $unqualified_colname = $order_portion_ci->{$col}{-colname};
-    $ret_info->{$col} = { %{$order_portion_ci->{$col}}, -idx_in_order_subset => $i };
-    delete $unqualified_idcols_from_order{$ret_info->{$col}{-colname}};
-
-    # we didn't reach the end of the identifying portion yet
-    return $ret_info unless keys %unqualified_idcols_from_order;
+    # if we reached the end of the allowed aliases - also nothing we can do
+    last unless $valid_aliases->{$colinfo->{-source_alias}};
+
+    $colinfos_to_return->{$col} = $colinfo;
+
+    $seen_main_src_cols->{$colinfo->{-colname}} = 1
+      if $colinfo->{-source_alias} eq $attrs->{alias};
   }
 
-  die 'How did we get here...';
+  # FIXME the condition may be singling out things on its own, so we
+  # conceivable could come back wi "stable-ordered by nothing"
+  # not confient enough in the parser yet, so punt for the time being
+  return unless $seen_main_src_cols;
+
+  my $main_src_fixed_cols_from_cond = [ $attrs->{where}
+    ? (
+      map
+      {
+        ( $colinfos->{$_} and $colinfos->{$_}{-source_alias} eq $attrs->{alias} )
+          ? $colinfos->{$_}{-colname}
+          : ()
+      }
+      keys %{ $self->_extract_fixed_condition_columns($attrs->{where}) }
+    )
+    : ()
+  ];
+
+  return $attrs->{result_source}->_identifying_column_set([
+    keys %$seen_main_src_cols,
+    @$main_src_fixed_cols_from_cond,
+  ]) ? $colinfos_to_return : ();
 }
 
 # Attempts to flatten a passed in SQLA condition as much as possible towards
@@ -1080,10 +1074,7 @@ sub _collapse_cond {
         : { $w[0] => undef }
       ;
     }
-    elsif ( ref $w[0] ) {
-      return \@w;
-    }
-    elsif ( @w == 2 ) {
+    elsif ( @w == 2 and ! ref $w[0]) {
       if ( ( $w[0]||'' ) =~ /^\-and$/i ) {
         return (ref $w[1] eq 'HASH' or ref $w[1] eq 'ARRAY')
           ? $self->_collapse_cond($w[1], (ref $w[1] eq 'ARRAY') )
@@ -1094,14 +1085,16 @@ sub _collapse_cond {
         return $self->_collapse_cond({ @w });
       }
     }
+    else {
+      return { -or => \@w };
+    }
   }
   else {
     # not a hash not an array
     return { '' => $where };
   }
 
-  # catchall, some of the things above fall through
-  return $where;
+  die 'should not get here';
 }
 
 sub _collapse_cond_unroll_pairs {
@@ -1127,25 +1120,36 @@ sub _collapse_cond_unroll_pairs {
       if (ref $rhs eq 'HASH' and ! keys %$rhs) {
         # FIXME - SQLA seems to be doing... nothing...?
       }
+      elsif (ref $rhs eq 'HASH' and keys %$rhs == 1 and exists $rhs->{-ident}) {
+        push @conds, { $lhs => { '=', $rhs } };
+      }
+      elsif (ref $rhs eq 'HASH' and keys %$rhs == 1 and exists $rhs->{-value} and is_plain_value $rhs->{-value}) {
+        push @conds, { $lhs => $rhs->{-value} };
+      }
       elsif (ref $rhs eq 'HASH' and keys %$rhs == 1 and exists $rhs->{'='}) {
-        for my $p ($self->_collapse_cond_unroll_pairs([ [ $lhs => $rhs->{'='} ] ])) {
-
-          # extra sanity check
-          if (keys %$p > 1) {
-            require Data::Dumper::Concise;
-            local $Data::Dumper::Deepcopy = 1;
-            $self->throw_exception(
-              "Internal error: unexpected collapse unroll:"
-            . Data::Dumper::Concise::Dumper { in => { $lhs => $rhs }, out => $p }
-            );
-          }
+        if( is_literal_value $rhs->{'='}) {
+          push @conds, { $lhs => $rhs };
+        }
+        else {
+          for my $p ($self->_collapse_cond_unroll_pairs([ [ $lhs => $rhs->{'='} ] ])) {
+
+            # extra sanity check
+            if (keys %$p > 1) {
+              require Data::Dumper::Concise;
+              local $Data::Dumper::Deepcopy = 1;
+              $self->throw_exception(
+                "Internal error: unexpected collapse unroll:"
+              . Data::Dumper::Concise::Dumper { in => { $lhs => $rhs }, out => $p }
+              );
+            }
 
-          my ($l, $r) = %$p;
+            my ($l, $r) = %$p;
 
-          push @conds, ( ! ref $r or overload::Method($r, '""' ) )
-            ? { $l => $r }
-            : { $l => { '=' => $r } }
-          ;
+            push @conds, ( ! length ref $r or is_plain_value($r) )
+              ? { $l => $r }
+              : { $l => { '=' => $r } }
+            ;
+          }
         }
       }
       elsif (ref $rhs eq 'ARRAY') {
@@ -1185,46 +1189,78 @@ sub _collapse_cond_unroll_pairs {
   return @conds;
 }
 
-
-# returns an arrayref of column names which *definitely* have some
-# sort of non-nullable *single* equality requested in the given condition
-# specification. This is used to figure out if a resultset is
-# constrained to a column which is part of a unique constraint,
-# which in turn allows us to better predict how ordering will behave
-# etc.
+# Analyzes a given condition and attempts to extract all columns
+# with a definitive fixed-condition criteria. Returns a hashref
+# of k/v pairs suitable to be passed to set_columns(), with a
+# MAJOR CAVEAT - multi-value (contradictory) equalities are still
+# represented as a reference to the UNRESOVABLE_CONDITION constant
+# The reason we do this is that some codepaths only care about the
+# codition being stable, as opposed to actually making sense
+#
+# The normal mode is used to figure out if a resultset is constrained
+# to a column which is part of a unique constraint, which in turn
+# allows us to better predict how ordering will behave etc.
+#
+# With the optional "consider_nulls" boolean argument, the function
+# is instead used to infer inambiguous values from conditions
+# (e.g. the inheritance of resultset conditions on new_result)
 #
-# this is a rudimentary, incomplete, and error-prone extractor
-# however this is OK - it is conservative, and if we can not find
-# something that is in fact there - the stack will recover gracefully
+my $undef_marker = \ do{ my $x = 'undef' };
 sub _extract_fixed_condition_columns {
-  my $self = shift;
-  my $where_hash = $self->_collapse_cond(shift);
-
-  my $res;
-  for my $c (keys %$where_hash) {
-    if (defined (my $v = $where_hash->{$c}) ) {
-      if (
-        ! ref $v
-          or
-        (ref $v eq 'HASH' and keys %$v == 1 and defined $v->{'='} and (
-          ! ref $v->{'='}
-            or
-          ref $v->{'='} eq 'SCALAR'
-            or
-          ( ref $v->{'='} eq 'REF' and ref ${$v->{'='}} eq 'ARRAY' )
-            or
-          overload::Method($v->{'='}, '""')
-        ))
-      ) {
-        $res->{$c} = 1;
+  my ($self, $where, $consider_nulls) = @_;
+  my $where_hash = $self->_collapse_cond($_[1]);
+
+  my $res = {};
+  my ($c, $v);
+  for $c (keys %$where_hash) {
+    my $vals;
+
+    if (!defined ($v = $where_hash->{$c}) ) {
+      $vals->{$undef_marker} = $v if $consider_nulls
+    }
+    elsif (
+      ref $v eq 'HASH'
+        and
+      keys %$v == 1
+    ) {
+      if (exists $v->{-value}) {
+        if (defined $v->{-value}) {
+          $vals->{$v->{-value}} = $v->{-value}
+        }
+        elsif( $consider_nulls ) {
+          $vals->{$undef_marker} = $v->{-value};
+        }
       }
-      elsif (ref $v eq 'ARRAY' and ($v->[0]||'') eq '-and') {
-        $res->{$_} = 1 for map { @{ $self->_extract_fixed_condition_columns({ $c => $_ }) } } @{$v}[1..$#$v];
+      # do not need to check for plain values - _collapse_cond did it for us
+      elsif(ref $v->{'='} and is_literal_value($v->{'='}) ) {
+        $vals->{$v->{'='}} = $v->{'='};
       }
     }
+    elsif (
+      ! length ref $v
+        or
+      is_plain_value ($v)
+    ) {
+      $vals->{$v} = $v;
+    }
+    elsif (ref $v eq 'ARRAY' and ($v->[0]||'') eq '-and') {
+      for ( @{$v}[1..$#$v] ) {
+        my $subval = $self->_extract_fixed_condition_columns({ $c => $_ }, 'consider nulls');  # always fish nulls out on recursion
+        next unless exists $subval->{$c};  # didn't find anything
+        $vals->{defined $subval->{$c} ? $subval->{$c} : $undef_marker} = $subval->{$c};
+      }
+    }
+
+    if (keys %$vals == 1) {
+      ($res->{$c}) = (values %$vals)
+        unless !$consider_nulls and exists $vals->{$undef_marker};
+    }
+    elsif (keys %$vals > 1) {
+      $res->{$c} = UNRESOLVABLE_CONDITION;
+    }
   }
 
-  return [ sort keys %$res ];
+  $res;
 }
 
 1;