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