lib/DBIx/Class/SQLMaker/LimitDialects.pm

   1 package DBIx::Class::SQLMaker::LimitDialects;
   2
   3 use warnings;
   4 use strict;
   5
   6 use Carp::Clan qw/^DBIx::Class|^SQL::Abstract|^Try::Tiny/;
   7 use List::Util 'first';
   8 use namespace::clean;
   9
  10 # FIXME
  11 # This dialect has not been ported to the subquery-realiasing code
  12 # that all other subquerying dialects are using. It is very possible
  13 # that this dialect is entirely unnecessary - it is currently only
  14 # used by ::Storage::DBI::ODBC::DB2_400_SQL which *should* be able to
  15 # just subclass ::Storage::DBI::DB2 and use the already rewritten
  16 # RowNumberOver. However nobody has access to this specific database
  17 # engine, thus keeping legacy code as-is
  18 # IF someone ever manages to test DB2-AS/400 with RNO, all the code
  19 # in this block should go on to meet its maker
  20 {
  21   sub _FetchFirst {
  22     my ( $self, $sql, $order, $rows, $offset ) = @_;
  23
  24     my $last = $rows + $offset;
  25
  26     my ( $order_by_up, $order_by_down ) = $self->_order_directions( $order );
  27
  28     $sql = "
  29       SELECT * FROM (
  30         SELECT * FROM (
  31           $sql
  32           $order_by_up
  33           FETCH FIRST $last ROWS ONLY
  34         ) foo
  35         $order_by_down
  36         FETCH FIRST $rows ROWS ONLY
  37       ) bar
  38       $order_by_up
  39     ";
  40
  41     return $sql;
  42   }
  43
  44   sub _order_directions {
  45     my ( $self, $order ) = @_;
  46
  47     return unless $order;
  48
  49     my $ref = ref $order;
  50
  51     my @order;
  52
  53     CASE: {
  54       @order = @$order,     last CASE if $ref eq 'ARRAY';
  55       @order = ( $order ),  last CASE unless $ref;
  56       @order = ( $$order ), last CASE if $ref eq 'SCALAR';
  57       croak __PACKAGE__ . ": Unsupported data struct $ref for ORDER BY";
  58     }
  59
  60     my ( $order_by_up, $order_by_down );
  61
  62     foreach my $spec ( @order )
  63     {
  64         my @spec = split ' ', $spec;
  65         croak( "bad column order spec: $spec" ) if @spec > 2;
  66         push( @spec, 'ASC' ) unless @spec == 2;
  67         my ( $col, $up ) = @spec; # or maybe down
  68         $up = uc( $up );
  69         croak( "bad direction: $up" ) unless $up =~ /^(?:ASC|DESC)$/;
  70         $order_by_up .= ", $col $up";
  71         my $down = $up eq 'ASC' ? 'DESC' : 'ASC';
  72         $order_by_down .= ", $col $down";
  73     }
  74
  75     s/^,/ORDER BY/ for ( $order_by_up, $order_by_down );
  76
  77     return $order_by_up, $order_by_down;
  78   }
  79 }
  80 ### end-of-FIXME
  81
  82 =head1 NAME
  83
  84 DBIx::Class::SQLMaker::LimitDialects - SQL::Abstract::Limit-like functionality for DBIx::Class::SQLMaker
  85
  86 =head1 DESCRIPTION
  87
  88 This module replicates a lot of the functionality originally found in
  89 L<SQL::Abstract::Limit>. While simple limits would work as-is, the more
  90 complex dialects that require e.g. subqueries could not be reliably
  91 implemented without taking full advantage of the metadata locked within
  92 L<DBIx::Class::ResultSource> classes. After reimplementation of close to
  93 80% of the L<SQL::Abstract::Limit> functionality it was deemed more
  94 practical to simply make an independent DBIx::Class-specific limit-dialect
  95 provider.
  96
  97 =head1 SQL LIMIT DIALECTS
  98
  99 Note that the actual implementations listed below never use C<*> literally.
 100 Instead proper re-aliasing of selectors and order criteria is done, so that
 101 the limit dialect are safe to use on joined resultsets with clashing column
 102 names.
 103
 104 Currently the provided dialects are:
 105
 106 =cut
 107
 108 =head2 LimitOffset
 109
 110  SELECT ... LIMIT $limit OFFSET $offset
 111
 112 Supported by B<PostgreSQL> and B<SQLite>
 113
 114 =cut
 115 sub _LimitOffset {
 116     my ( $self, $sql, $order, $rows, $offset ) = @_;
 117     $sql .= $self->_order_by( $order ) . " LIMIT $rows";
 118     $sql .= " OFFSET $offset" if +$offset;
 119     return $sql;
 120 }
 121
 122 =head2 LimitXY
 123
 124  SELECT ... LIMIT $offset $limit
 125
 126 Supported by B<MySQL> and any L<SQL::Statement> based DBD
 127
 128 =cut
 129 sub _LimitXY {
 130     my ( $self, $sql, $order, $rows, $offset ) = @_;
 131     $sql .= $self->_order_by( $order ) . " LIMIT ";
 132     $sql .= "$offset, " if +$offset;
 133     $sql .= $rows;
 134     return $sql;
 135 }
 136
 137 =head2 RowNumberOver
 138
 139  SELECT * FROM (
 140   SELECT *, ROW_NUMBER() OVER( ORDER BY ... ) AS RNO__ROW__INDEX FROM (
 141    SELECT ...
 142   )
 143  ) WHERE RNO__ROW__INDEX BETWEEN ($offset+1) AND ($limit+$offset)
 144
 145
 146 ANSI standard Limit/Offset implementation. Supported by B<DB2> and
 147 B<< MSSQL >= 2005 >>.
 148
 149 =cut
 150 sub _RowNumberOver {
 151   my ($self, $sql, $rs_attrs, $rows, $offset ) = @_;
 152
 153   # mangle the input sql as we will be replacing the selector
 154   $sql =~ s/^ \s* SELECT \s+ .+? \s+ (?= \b FROM \b )//ix
 155     or croak "Unrecognizable SELECT: $sql";
 156
 157   # get selectors, and scan the order_by (if any)
 158   my ($in_sel, $out_sel, $alias_map, $extra_order_sel)
 159     = $self->_subqueried_limit_attrs ( $rs_attrs );
 160
 161   # make up an order if none exists
 162   my $requested_order = (delete $rs_attrs->{order_by}) || $self->_rno_default_order;
 163   my $rno_ord = $self->_order_by ($requested_order);
 164
 165   # this is the order supplement magic
 166   my $mid_sel = $out_sel;
 167   if ($extra_order_sel) {
 168     for my $extra_col (sort
 169       { $extra_order_sel->{$a} cmp $extra_order_sel->{$b} }
 170       keys %$extra_order_sel
 171     ) {
 172       $in_sel .= sprintf (', %s AS %s',
 173         $extra_col,
 174         $extra_order_sel->{$extra_col},
 175       );
 176
 177       $mid_sel .= ', ' . $extra_order_sel->{$extra_col};
 178     }
 179   }
 180
 181   # and this is order re-alias magic
 182   for ($extra_order_sel, $alias_map) {
 183     for my $col (keys %$_) {
 184       my $re_col = quotemeta ($col);
 185       $rno_ord =~ s/$re_col/$_->{$col}/;
 186     }
 187   }
 188
 189   # whatever is left of the order_by (only where is processed at this point)
 190   my $group_having = $self->_parse_rs_attrs($rs_attrs);
 191
 192   my $qalias = $self->_quote ($rs_attrs->{alias});
 193   my $idx_name = $self->_quote ('rno__row__index');
 194
 195   $sql = sprintf (<<EOS, $offset + 1, $offset + $rows, );
 196
 197 SELECT $out_sel FROM (
 198   SELECT $mid_sel, ROW_NUMBER() OVER( $rno_ord ) AS $idx_name FROM (
 199     SELECT $in_sel ${sql}${group_having}
 200   ) $qalias
 201 ) $qalias WHERE $idx_name BETWEEN %u AND %u
 202
 203 EOS
 204
 205   $sql =~ s/\s*\n\s*/ /g;   # easier to read in the debugger
 206   return $sql;
 207 }
 208
 209 # some databases are happy with OVER (), some need OVER (ORDER BY (SELECT (1)) )
 210 sub _rno_default_order {
 211   return undef;
 212 }
 213
 214 =head2 SkipFirst
 215
 216  SELECT SKIP $offset FIRST $limit * FROM ...
 217
 218 Suported by B<Informix>, almost like LimitOffset. According to
 219 L<SQL::Abstract::Limit> C<... SKIP $offset LIMIT $limit ...> is also supported.
 220
 221 =cut
 222 sub _SkipFirst {
 223   my ($self, $sql, $rs_attrs, $rows, $offset) = @_;
 224
 225   $sql =~ s/^ \s* SELECT \s+ //ix
 226     or croak "Unrecognizable SELECT: $sql";
 227
 228   return sprintf ('SELECT %s%s%s%s',
 229     $offset
 230       ? sprintf ('SKIP %u ', $offset)
 231       : ''
 232     ,
 233     sprintf ('FIRST %u ', $rows),
 234     $sql,
 235     $self->_parse_rs_attrs ($rs_attrs),
 236   );
 237 }
 238
 239 =head2 FirstSkip
 240
 241  SELECT FIRST $limit SKIP $offset * FROM ...
 242
 243 Supported by B<Firebird/Interbase>, reverse of SkipFirst. According to
 244 L<SQL::Abstract::Limit> C<... ROWS $limit TO $offset ...> is also supported.
 245
 246 =cut
 247 sub _FirstSkip {
 248   my ($self, $sql, $rs_attrs, $rows, $offset) = @_;
 249
 250   $sql =~ s/^ \s* SELECT \s+ //ix
 251     or croak "Unrecognizable SELECT: $sql";
 252
 253   return sprintf ('SELECT %s%s%s%s',
 254     sprintf ('FIRST %u ', $rows),
 255     $offset
 256       ? sprintf ('SKIP %u ', $offset)
 257       : ''
 258     ,
 259     $sql,
 260     $self->_parse_rs_attrs ($rs_attrs),
 261   );
 262 }
 263
 264 =head2 RowNum
 265
 266  SELECT * FROM (
 267   SELECT *, ROWNUM rownum__index FROM (
 268    SELECT ...
 269   )
 270  ) WHERE rownum__index BETWEEN ($offset+1) AND ($limit+$offset)
 271
 272 Supported by B<Oracle>.
 273
 274 =cut
 275 sub _RowNum {
 276   my ( $self, $sql, $rs_attrs, $rows, $offset ) = @_;
 277
 278   # mangle the input sql as we will be replacing the selector
 279   $sql =~ s/^ \s* SELECT \s+ .+? \s+ (?= \b FROM \b )//ix
 280     or croak "Unrecognizable SELECT: $sql";
 281
 282   my ($insel, $outsel) = $self->_subqueried_limit_attrs ($rs_attrs);
 283
 284   my $qalias = $self->_quote ($rs_attrs->{alias});
 285   my $idx_name = $self->_quote ('rownum__index');
 286   my $order_group_having = $self->_parse_rs_attrs($rs_attrs);
 287
 288   $sql = sprintf (<<EOS, $offset + 1, $offset + $rows, );
 289
 290 SELECT $outsel FROM (
 291   SELECT $outsel, ROWNUM $idx_name FROM (
 292     SELECT $insel ${sql}${order_group_having}
 293   ) $qalias
 294 ) $qalias WHERE $idx_name BETWEEN %u AND %u
 295
 296 EOS
 297
 298   $sql =~ s/\s*\n\s*/ /g;   # easier to read in the debugger
 299   return $sql;
 300 }
 301
 302 =head2 Top
 303
 304  SELECT * FROM
 305
 306  SELECT TOP $limit FROM (
 307   SELECT TOP $limit FROM (
 308    SELECT TOP ($limit+$offset) ...
 309   ) ORDER BY $reversed_original_order
 310  ) ORDER BY $original_order
 311
 312 Unreliable Top-based implementation, supported by B<< MSSQL < 2005 >>.
 313
 314 =head3 CAVEAT
 315
 316 Due to its implementation, this limit dialect returns B<incorrect results>
 317 when $limit+$offset > total amount of rows in the resultset.
 318
 319 =cut
 320 sub _Top {
 321   my ( $self, $sql, $rs_attrs, $rows, $offset ) = @_;
 322
 323   # mangle the input sql as we will be replacing the selector
 324   $sql =~ s/^ \s* SELECT \s+ .+? \s+ (?= \b FROM \b )//ix
 325     or croak "Unrecognizable SELECT: $sql";
 326
 327   # get selectors
 328   my ($in_sel, $out_sel, $alias_map, $extra_order_sel)
 329     = $self->_subqueried_limit_attrs ($rs_attrs);
 330
 331   my $requested_order = delete $rs_attrs->{order_by};
 332
 333   my $order_by_requested = $self->_order_by ($requested_order);
 334
 335   # make up an order unless supplied
 336   my $inner_order = ($order_by_requested
 337     ? $requested_order
 338     : [ map
 339       { join ('', $rs_attrs->{alias}, $self->{name_sep}||'.', $_ ) }
 340       ( $rs_attrs->{_rsroot_source_handle}->resolve->_pri_cols )
 341     ]
 342   );
 343
 344   my ($order_by_inner, $order_by_reversed);
 345
 346   # localise as we already have all the bind values we need
 347   {
 348     local $self->{order_bind};
 349     $order_by_inner = $self->_order_by ($inner_order);
 350
 351     my @out_chunks;
 352     for my $ch ($self->_order_by_chunks ($inner_order)) {
 353       $ch = $ch->[0] if ref $ch eq 'ARRAY';
 354
 355       $ch =~ s/\s+ ( ASC|DESC ) \s* $//ix;
 356       my $dir = uc ($1||'ASC');
 357
 358       push @out_chunks, \join (' ', $ch, $dir eq 'ASC' ? 'DESC' : 'ASC' );
 359     }
 360
 361     $order_by_reversed = $self->_order_by (\@out_chunks);
 362   }
 363
 364   # this is the order supplement magic
 365   my $mid_sel = $out_sel;
 366   if ($extra_order_sel) {
 367     for my $extra_col (sort
 368       { $extra_order_sel->{$a} cmp $extra_order_sel->{$b} }
 369       keys %$extra_order_sel
 370     ) {
 371       $in_sel .= sprintf (', %s AS %s',
 372         $extra_col,
 373         $extra_order_sel->{$extra_col},
 374       );
 375
 376       $mid_sel .= ', ' . $extra_order_sel->{$extra_col};
 377     }
 378
 379     # since whatever order bindvals there are, they will be realiased
 380     # and need to show up in front of the entire initial inner subquery
 381     # Unshift *from_bind* to make this happen (horrible, horrible, but
 382     # we don't have another mechanism yet)
 383     unshift @{$self->{from_bind}}, @{$self->{order_bind}};
 384   }
 385
 386   # and this is order re-alias magic
 387   for my $map ($extra_order_sel, $alias_map) {
 388     for my $col (keys %$map) {
 389       my $re_col = quotemeta ($col);
 390       $_ =~ s/$re_col/$map->{$col}/
 391         for ($order_by_reversed, $order_by_requested);
 392     }
 393   }
 394
 395   # generate the rest of the sql
 396   my $grpby_having = $self->_parse_rs_attrs ($rs_attrs);
 397
 398   my $quoted_rs_alias = $self->_quote ($rs_attrs->{alias});
 399
 400   $sql = sprintf ('SELECT TOP %u %s %s %s %s',
 401     $rows + ($offset||0),
 402     $in_sel,
 403     $sql,
 404     $grpby_having,
 405     $order_by_inner,
 406   );
 407
 408   $sql = sprintf ('SELECT TOP %u %s FROM ( %s ) %s %s',
 409     $rows,
 410     $mid_sel,
 411     $sql,
 412     $quoted_rs_alias,
 413     $order_by_reversed,
 414   ) if $offset;
 415
 416   $sql = sprintf ('SELECT TOP %u %s FROM ( %s ) %s %s',
 417     $rows,
 418     $out_sel,
 419     $sql,
 420     $quoted_rs_alias,
 421     $order_by_requested,
 422   ) if ( ($offset && $order_by_requested) || ($mid_sel ne $out_sel) );
 423
 424   $sql =~ s/\s*\n\s*/ /g;   # easier to read in the debugger
 425   return $sql;
 426 }
 427
 428 =head2 RowCountOrGenericSubQ
 429
 430 This is not exactly a limit dialect, but more of a proxy for B<Sybase ASE>.
 431 If no $offset is supplied the limit is simply performed as:
 432
 433  SET ROWCOUNT $limit
 434  SELECT ...
 435  SET ROWCOUNT 0
 436
 437 Otherwise we fall back to L</GenericSubQ>
 438
 439 =cut
 440 sub _RowCountOrGenericSubQ {
 441   my $self = shift;
 442   my ($sql, $rs_attrs, $rows, $offset) = @_;
 443
 444   return $self->_GenericSubQ(@_) if $offset;
 445
 446   return sprintf <<"EOF", $rows, $sql;
 447 SET ROWCOUNT %d
 448 %s
 449 SET ROWCOUNT 0
 450 EOF
 451 }
 452
 453 =head2 GenericSubQ
 454
 455  SELECT * FROM (
 456   SELECT ...
 457  )
 458  WHERE (
 459   SELECT COUNT(*) FROM $original_table cnt WHERE cnt.id < $original_table.id
 460  ) BETWEEN $offset AND ($offset+$rows-1)
 461
 462 This is the most evil limit "dialect" (more of a hack) for I<really> stupid
 463 databases. It works by ordering the set by some unique column, and calculating
 464 the amount of rows that have a less-er value (thus emulating a L</RowNum>-like
 465 index). Of course this implies the set can only be ordered by a single unique
 466 column. Also note that this technique can be and often is B<excruciatingly
 467 slow>.
 468
 469 Currently used by B<Sybase ASE>, due to lack of any other option.
 470
 471 =cut
 472 sub _GenericSubQ {
 473   my ($self, $sql, $rs_attrs, $rows, $offset) = @_;
 474
 475   my $root_rsrc = $rs_attrs->{_rsroot_source_handle}->resolve;
 476   my $root_tbl_name = $root_rsrc->name;
 477
 478   # mangle the input sql as we will be replacing the selector
 479   $sql =~ s/^ \s* SELECT \s+ .+? \s+ (?= \b FROM \b )//ix
 480     or croak "Unrecognizable SELECT: $sql";
 481
 482   my ($order_by, @rest) = do {
 483     local $self->{quote_char};
 484     $self->_order_by_chunks ($rs_attrs->{order_by})
 485   };
 486
 487   unless (
 488     $order_by
 489       &&
 490     ! @rest
 491       &&
 492     ( ! ref $order_by
 493         ||
 494       ( ref $order_by eq 'ARRAY' and @$order_by == 1 )
 495     )
 496   ) {
 497     croak (
 498       'Generic Subquery Limit does not work on resultsets without an order, or resultsets '
 499     . 'with complex order criteria (multicolumn and/or functions). Provide a single, '
 500     . 'unique-column order criteria.'
 501     );
 502   }
 503
 504   ($order_by) = @$order_by if ref $order_by;
 505
 506   $order_by =~ s/\s+ ( ASC|DESC ) \s* $//ix;
 507   my $direction = lc ($1 || 'asc');
 508
 509   my ($unq_sort_col) = $order_by =~ /(?:^|\.)([^\.]+)$/;
 510
 511   my $inf = $root_rsrc->storage->_resolve_column_info (
 512     $rs_attrs->{from}, [$order_by, $unq_sort_col]
 513   );
 514
 515   my $ord_colinfo = $inf->{$order_by} || croak "Unable to determine source of order-criteria '$order_by'";
 516
 517   if ($ord_colinfo->{-result_source}->name ne $root_tbl_name) {
 518     croak "Generic Subquery Limit order criteria can be only based on the root-source '"
 519         . $root_rsrc->source_name . "' (aliased as '$rs_attrs->{alias}')";
 520   }
 521
 522   # make sure order column is qualified
 523   $order_by = "$rs_attrs->{alias}.$order_by"
 524     unless $order_by =~ /^$rs_attrs->{alias}\./;
 525
 526   my $is_u;
 527   my $ucs = { $root_rsrc->unique_constraints };
 528   for (values %$ucs ) {
 529     if (@$_ == 1 && "$rs_attrs->{alias}.$_->[0]" eq $order_by) {
 530       $is_u++;
 531       last;
 532     }
 533   }
 534   croak "Generic Subquery Limit order criteria column '$order_by' must be unique (no unique constraint found)"
 535     unless $is_u;
 536
 537   my ($in_sel, $out_sel, $alias_map, $extra_order_sel)
 538     = $self->_subqueried_limit_attrs ($rs_attrs);
 539
 540   my $cmp_op = $direction eq 'desc' ? '>' : '<';
 541   my $count_tbl_alias = 'rownum__emulation';
 542
 543   my $order_sql = $self->_order_by (delete $rs_attrs->{order_by});
 544   my $group_having_sql = $self->_parse_rs_attrs($rs_attrs);
 545
 546   # add the order supplement (if any) as this is what will be used for the outer WHERE
 547   $in_sel .= ", $_" for keys %{$extra_order_sel||{}};
 548
 549   $sql = sprintf (<<EOS,
 550 SELECT $out_sel
 551   FROM (
 552     SELECT $in_sel ${sql}${group_having_sql}
 553   ) %s
 554 WHERE ( SELECT COUNT(*) FROM %s %s WHERE %s $cmp_op %s ) %s
 555 $order_sql
 556 EOS
 557     ( map { $self->_quote ($_) } (
 558       $rs_attrs->{alias},
 559       $root_tbl_name,
 560       $count_tbl_alias,
 561       "$count_tbl_alias.$unq_sort_col",
 562       $order_by,
 563     )),
 564     $offset
 565       ? sprintf ('BETWEEN %u AND %u', $offset, $offset + $rows - 1)
 566       : sprintf ('< %u', $rows )
 567     ,
 568   );
 569
 570   $sql =~ s/\s*\n\s*/ /g;   # easier to read in the debugger
 571   return $sql;
 572 }
 573
 574
 575 # !!! THIS IS ALSO HORRIFIC !!! /me ashamed
 576 #
 577 # Generates inner/outer select lists for various limit dialects
 578 # which result in one or more subqueries (e.g. RNO, Top, RowNum)
 579 # Any non-root-table columns need to have their table qualifier
 580 # turned into a column alias (otherwise names in subqueries clash
 581 # and/or lose their source table)
 582 #
 583 # Returns inner/outer strings of SQL QUOTED selectors with aliases
 584 # (to be used in whatever select statement), and an alias index hashref
 585 # of QUOTED SEL => QUOTED ALIAS pairs (to maybe be used for string-subst
 586 # higher up).
 587 # If an order_by is supplied, the inner select needs to bring out columns
 588 # used in implicit (non-selected) orders, and the order condition itself
 589 # needs to be realiased to the proper names in the outer query. Thus we
 590 # also return a hashref (order doesn't matter) of QUOTED EXTRA-SEL =>
 591 # QUOTED ALIAS pairs, which is a list of extra selectors that do *not*
 592 # exist in the original select list
 593 sub _subqueried_limit_attrs {
 594   my ($self, $rs_attrs) = @_;
 595
 596   croak 'Limit dialect implementation usable only in the context of DBIC (missing $rs_attrs)'
 597     unless ref ($rs_attrs) eq 'HASH';
 598
 599   my ($re_sep, $re_alias) = map { quotemeta $_ } (
 600     $self->name_sep || '.',
 601     $rs_attrs->{alias},
 602   );
 603
 604   # correlate select and as, build selection index
 605   my (@sel, $in_sel_index);
 606   for my $i (0 .. $#{$rs_attrs->{select}}) {
 607
 608     my $s = $rs_attrs->{select}[$i];
 609     my $sql_sel = $self->_recurse_fields ($s);
 610     my $sql_alias = (ref $s) eq 'HASH' ? $s->{-as} : undef;
 611
 612     push @sel, {
 613       sql => $sql_sel,
 614       unquoted_sql => do { local $self->{quote_char}; $self->_recurse_fields ($s) },
 615       as =>
 616         $sql_alias
 617           ||
 618         $rs_attrs->{as}[$i]
 619           ||
 620         croak "Select argument $i ($s) without corresponding 'as'"
 621       ,
 622     };
 623
 624     $in_sel_index->{$sql_sel}++;
 625     $in_sel_index->{$self->_quote ($sql_alias)}++ if $sql_alias;
 626
 627     # record unqualified versions too, so we do not have
 628     # to reselect the same column twice (in qualified and
 629     # unqualified form)
 630     if (! ref $s && $sql_sel =~ / $re_sep (.+) $/x) {
 631       $in_sel_index->{$1}++;
 632     }
 633   }
 634
 635
 636   # re-alias and remove any name separators from aliases,
 637   # unless we are dealing with the current source alias
 638   # (which will transcend the subqueries as it is necessary
 639   # for possible further chaining)
 640   my (@in_sel, @out_sel, %renamed);
 641   for my $node (@sel) {
 642     if (first { $_ =~ / (?<! ^ $re_alias ) $re_sep /x } ($node->{as}, $node->{unquoted_sql}) )  {
 643       $node->{as} = $self->_unqualify_colname($node->{as});
 644       my $quoted_as = $self->_quote($node->{as});
 645       push @in_sel, sprintf '%s AS %s', $node->{sql}, $quoted_as;
 646       push @out_sel, $quoted_as;
 647       $renamed{$node->{sql}} = $quoted_as;
 648     }
 649     else {
 650       push @in_sel, $node->{sql};
 651       push @out_sel, $self->_quote ($node->{as});
 652     }
 653   }
 654
 655   # see if the order gives us anything
 656   my %extra_order_sel;
 657   for my $chunk ($self->_order_by_chunks ($rs_attrs->{order_by})) {
 658     # order with bind
 659     $chunk = $chunk->[0] if (ref $chunk) eq 'ARRAY';
 660     $chunk =~ s/\s+ (?: ASC|DESC ) \s* $//ix;
 661
 662     next if $in_sel_index->{$chunk};
 663
 664     $extra_order_sel{$chunk} ||= $self->_quote (
 665       'ORDER__BY__' . scalar keys %extra_order_sel
 666     );
 667   }
 668
 669   return (
 670     (map { join (', ', @$_ ) } (
 671       \@in_sel,
 672       \@out_sel)
 673     ),
 674     \%renamed,
 675     keys %extra_order_sel ? \%extra_order_sel : (),
 676   );
 677 }
 678
 679 sub _unqualify_colname {
 680   my ($self, $fqcn) = @_;
 681   my $re_sep = quotemeta($self->name_sep || '.');
 682   $fqcn =~ s/ $re_sep /__/xg;
 683   return $fqcn;
 684 }
 685
 686 1;
 687
 688 =head1 AUTHORS
 689
 690 See L<DBIx::Class/CONTRIBUTORS>.
 691
 692 =head1 LICENSE
 693
 694 You may distribute this code under the same terms as Perl itself.
 695
 696 =cut