lib/DBIx/Class/SQLMaker/LimitDialects.pm

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