9 years of perl and I somehow did not know that...
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / SQLMaker / LimitDialects.pm
index e9a1c87..2062021 100644 (file)
@@ -121,10 +121,10 @@ sub _RowNumberOver {
   }
 
   # and this is order re-alias magic
-  for ($sq_attrs->{order_supplement}, $sq_attrs->{outer_renames}) {
-    for my $col (keys %$_) {
+  for my $map ($sq_attrs->{order_supplement}, $sq_attrs->{outer_renames}) {
+    for my $col (sort { (length $b) <=> (length $a) } keys %{$map||{}} ) {
       my $re_col = quotemeta ($col);
-      $rno_ord =~ s/$re_col/$_->{$col}/;
+      $rno_ord =~ s/$re_col/$map->{$col}/;
     }
   }
 
@@ -279,7 +279,7 @@ EOS
     $rs_attrs->{order_by}
       and
     $rs_attrs->{_rsroot_rsrc}->storage->_order_by_is_stable(
-      $rs_attrs->{from}, $rs_attrs->{order_by}
+      @{$rs_attrs}{qw/from order_by where/}
     )
   ) {
     push @{$self->{limit_bind}}, [ $self->__total_bindtype => $offset + $rows ], [ $self->__offset_bindtype => $offset + 1 ];
@@ -331,10 +331,11 @@ sub _prep_for_skimming_limit {
     if ($sq_attrs->{order_by_requested}) {
       $self->throw_exception (
         'Unable to safely perform "skimming type" limit with supplied unstable order criteria'
-      ) unless $rs_attrs->{_rsroot_rsrc}->schema->storage->_order_by_is_stable(
+      ) unless ($rs_attrs->{_rsroot_rsrc}->schema->storage->_order_by_is_stable(
         $rs_attrs->{from},
-        $requested_order
-      );
+        $requested_order,
+        $rs_attrs->{where},
+      ));
 
       $inner_order = $requested_order;
     }
@@ -357,9 +358,12 @@ sub _prep_for_skimming_limit {
     for my $ch ($self->_order_by_chunks ($inner_order)) {
       $ch = $ch->[0] if ref $ch eq 'ARRAY';
 
-      $ch =~ s/\s+ ( ASC|DESC ) \s* $//ix;
-      my $dir = uc ($1||'ASC');
-      push @out_chunks, \join (' ', $ch, $dir eq 'ASC' ? 'DESC' : 'ASC' );
+      my $is_desc = (
+        $ch =~ s/\s+ ( ASC|DESC ) \s* $//ix
+          and
+        uc($1) eq 'DESC'
+      ) ? 1 : 0;
+      push @out_chunks, \join (' ', $ch, $is_desc ? 'ASC' : 'DESC' );
     }
 
     $sq_attrs->{order_by_middle} = $self->_order_by (\@out_chunks);
@@ -382,23 +386,11 @@ sub _prep_for_skimming_limit {
       # Whatever order bindvals there are, they will be realiased and
       # reselected, and need to show up at end of the initial inner select
       push @{$self->{select_bind}}, @{$self->{order_bind}};
-
-      # if this is a part of something bigger, we need to add back all
-      # the extra order_by's, as they may be relied upon by the outside
-      # of a prefetch or something
-      if ($rs_attrs->{_is_internal_subuery}) {
-        $sq_attrs->{selection_outer} .= sprintf ", $extra_order_sel->{$_} AS $_"
-          for sort
-            { $extra_order_sel->{$a} cmp $extra_order_sel->{$b} }
-              grep { $_ !~ /[^\w\-]/ }  # ignore functions
-              keys %$extra_order_sel
-        ;
-      }
     }
 
     # and this is order re-alias magic
     for my $map ($sq_attrs->{order_supplement}, $sq_attrs->{outer_renames}) {
-      for my $col (sort { $map->{$a} cmp $map->{$b} } keys %{$map||{}}) {
+      for my $col (sort { (length $b) <=> (length $a) } keys %{$map||{}}) {
         my $re_col = quotemeta ($col);
         $_ =~ s/$re_col/$map->{$col}/
           for ($sq_attrs->{order_by_middle}, $sq_attrs->{order_by_requested});
@@ -536,9 +528,9 @@ sub _RowCountOrGenericSubQ {
 
   return $self->_GenericSubQ(@_) if $offset;
 
-  return sprintf <<"EOF", $rows, $sql;
+  return sprintf <<"EOF", $rows, $sql, $self->_parse_rs_attrs( $rs_attrs );
 SET ROWCOUNT %d
-%s
+%s %s
 SET ROWCOUNT 0
 EOF
 }
@@ -556,8 +548,11 @@ This is the most evil limit "dialect" (more of a hack) for I<really> stupid
 databases. It works by ordering the set by some unique column, and calculating
 the amount of rows that have a less-er value (thus emulating a L</RowNum>-like
 index). Of course this implies the set can only be ordered by a single unique
-column. Also note that this technique can be and often is B<excruciatingly
-slow>.
+column.
+
+Also note that this technique can be and often is B<excruciatingly slow>. You
+may have much better luck using L<DBIx::Class::ResultSet/software_limit>
+instead.
 
 Currently used by B<Sybase ASE>, due to lack of any other option.
 
@@ -577,8 +572,9 @@ sub _GenericSubQ {
   . 'unique-column order criteria.'
   );
 
-  $first_order_by =~ s/\s+ ( ASC|DESC ) \s* $//ix;
-  my $direction = lc ($1 || 'asc');
+  my $direction = (
+    $first_order_by =~ s/\s+ ( ASC|DESC ) \s* $//ix
+  ) ? lc($1) : 'asc';
 
   my ($first_ord_alias, $first_ord_col) = $first_order_by =~ /^ (?: ([^\.]+) \. )? ([^\.]+) $/x;
 
@@ -702,6 +698,7 @@ sub _subqueried_limit_attrs {
     my $sql_alias = (ref $s) eq 'HASH' ? $s->{-as} : undef;
 
     push @sel, {
+      arg => $s,
       sql => $sql_sel,
       unquoted_sql => do {
         local $self->{quote_char};
@@ -716,7 +713,9 @@ sub _subqueried_limit_attrs {
       ,
     };
 
-    $in_sel_index->{$sql_sel}++;
+    # anything with a placeholder in it needs re-selection
+    $in_sel_index->{$sql_sel}++ unless $sql_sel =~ / (?: ^ | \W ) \? (?: \W | $ ) /x;
+
     $in_sel_index->{$self->_quote ($sql_alias)}++ if $sql_alias;
 
     # record unqualified versions too, so we do not have
@@ -732,11 +731,14 @@ sub _subqueried_limit_attrs {
   # unless we are dealing with the current source alias
   # (which will transcend the subqueries as it is necessary
   # for possible further chaining)
+  # same for anything we do not recognize
   my ($sel, $renamed);
   for my $node (@sel) {
     push @{$sel->{original}}, $node->{sql};
 
     if (
+      ! $in_sel_index->{$node->{sql}}
+        or
       $node->{as} =~ / (?<! ^ $re_alias ) \. /x
         or
       $node->{unquoted_sql} =~ / (?<! ^ $re_alias ) $re_sep /x
@@ -749,7 +751,7 @@ sub _subqueried_limit_attrs {
     }
     else {
       push @{$sel->{inner}}, $node->{sql};
-      push @{$sel->{outer}}, $self->_quote ($node->{as});
+      push @{$sel->{outer}}, $self->_quote (ref $node->{arg} ? $node->{as} : $node->{arg});
     }
   }
 
@@ -763,7 +765,7 @@ sub _subqueried_limit_attrs {
     next if $in_sel_index->{$chunk};
 
     $extra_order_sel->{$chunk} ||= $self->_quote (
-      'ORDER__BY__' . scalar keys %{$extra_order_sel||{}}
+      'ORDER__BY__' . sprintf '%03d', scalar keys %{$extra_order_sel||{}}
     );
   }