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   return $sql;
 206 }
 207
 208 # some databases are happy with OVER (), some need OVER (ORDER BY (SELECT (1)) )
 209 sub _rno_default_order {
 210   return undef;
 211 }
 212
 213 =head2 SkipFirst
 214
 215  SELECT SKIP $offset FIRST $limit * FROM ...
 216
 217 Suported by B<Informix>, almost like LimitOffset. According to
 218 L<SQL::Abstract::Limit> C<... SKIP $offset LIMIT $limit ...> is also supported.
 219
 220 =cut
 221 sub _SkipFirst {
 222   my ($self, $sql, $rs_attrs, $rows, $offset) = @_;
 223
 224   $sql =~ s/^ \s* SELECT \s+ //ix
 225     or croak "Unrecognizable SELECT: $sql";
 226
 227   return sprintf ('SELECT %s%s%s%s',
 228     $offset
 229       ? sprintf ('SKIP %u ', $offset)
 230       : ''
 231     ,
 232     sprintf ('FIRST %u ', $rows),
 233     $sql,
 234     $self->_parse_rs_attrs ($rs_attrs),
 235   );
 236 }
 237
 238 =head2 FirstSkip
 239
 240  SELECT FIRST $limit SKIP $offset * FROM ...
 241
 242 Supported by B<Firebird/Interbase>, reverse of SkipFirst. According to
 243 L<SQL::Abstract::Limit> C<... ROWS $limit TO $offset ...> is also supported.
 244
 245 =cut
 246 sub _FirstSkip {
 247   my ($self, $sql, $rs_attrs, $rows, $offset) = @_;
 248
 249   $sql =~ s/^ \s* SELECT \s+ //ix
 250     or croak "Unrecognizable SELECT: $sql";
 251
 252   return sprintf ('SELECT %s%s%s%s',
 253     sprintf ('FIRST %u ', $rows),
 254     $offset
 255       ? sprintf ('SKIP %u ', $offset)
 256       : ''
 257     ,
 258     $sql,
 259     $self->_parse_rs_attrs ($rs_attrs),
 260   );
 261 }
 262
 263 =head2 RowNum
 264
 265  SELECT * FROM (
 266   SELECT *, ROWNUM rownum__index FROM (
 267    SELECT ...
 268   ) WHERE ROWNUM <= ($limit+$offset)
 269  ) WHERE rownum__index >= ($offset+1)
 270
 271 Supported by B<Oracle>.
 272
 273 =cut
 274 sub _RowNum {
 275   my ( $self, $sql, $rs_attrs, $rows, $offset ) = @_;
 276
 277   # mangle the input sql as we will be replacing the selector
 278   $sql =~ s/^ \s* SELECT \s+ .+? \s+ (?= \b FROM \b )//ix
 279     or croak "Unrecognizable SELECT: $sql";
 280
 281   my ($insel, $outsel) = $self->_subqueried_limit_attrs ($rs_attrs);
 282
 283   my $qalias = $self->_quote ($rs_attrs->{alias});
 284   my $idx_name = $self->_quote ('rownum__index');
 285   my $order_group_having = $self->_parse_rs_attrs($rs_attrs);
 286
 287   if ($offset) {
 288
 289     $sql = sprintf (<<EOS, $offset + $rows, $offset + 1 );
 290
 291 SELECT $outsel FROM (
 292   SELECT $outsel, ROWNUM $idx_name FROM (
 293     SELECT $insel ${sql}${order_group_having}
 294   ) $qalias WHERE ROWNUM <= %u
 295 ) $qalias WHERE $idx_name >= %u
 296
 297 EOS
 298   }
 299   else {
 300     $sql = sprintf (<<EOS, $rows );
 301
 302   SELECT $outsel FROM (
 303     SELECT $insel ${sql}${order_group_having}
 304   ) $qalias WHERE ROWNUM <= %u
 305
 306 EOS
 307   }
 308
 309   return $sql;
 310 }
 311
 312 =head2 Top
 313
 314  SELECT * FROM
 315
 316  SELECT TOP $limit FROM (
 317   SELECT TOP $limit FROM (
 318    SELECT TOP ($limit+$offset) ...
 319   ) ORDER BY $reversed_original_order
 320  ) ORDER BY $original_order
 321
 322 Unreliable Top-based implementation, supported by B<< MSSQL < 2005 >>.
 323
 324 =head3 CAVEAT
 325
 326 Due to its implementation, this limit dialect returns B<incorrect results>
 327 when $limit+$offset > total amount of rows in the resultset.
 328
 329 =cut
 330 sub _Top {
 331   my ( $self, $sql, $rs_attrs, $rows, $offset ) = @_;
 332
 333   # mangle the input sql as we will be replacing the selector
 334   $sql =~ s/^ \s* SELECT \s+ .+? \s+ (?= \b FROM \b )//ix
 335     or croak "Unrecognizable SELECT: $sql";
 336
 337   # get selectors
 338   my ($in_sel, $out_sel, $alias_map, $extra_order_sel)
 339     = $self->_subqueried_limit_attrs ($rs_attrs);
 340
 341   my $requested_order = delete $rs_attrs->{order_by};
 342
 343   my $order_by_requested = $self->_order_by ($requested_order);
 344
 345   # make up an order unless supplied
 346   my $inner_order = ($order_by_requested
 347     ? $requested_order
 348     : [ map
 349       { "$rs_attrs->{alias}.$_" }
 350       ( $rs_attrs->{_rsroot_source_handle}->resolve->_pri_cols )
 351     ]
 352   );
 353
 354   my ($order_by_inner, $order_by_reversed);
 355
 356   # localise as we already have all the bind values we need
 357   {
 358     local $self->{order_bind};
 359     $order_by_inner = $self->_order_by ($inner_order);
 360
 361     my @out_chunks;
 362     for my $ch ($self->_order_by_chunks ($inner_order)) {
 363       $ch = $ch->[0] if ref $ch eq 'ARRAY';
 364
 365       $ch =~ s/\s+ ( ASC|DESC ) \s* $//ix;
 366       my $dir = uc ($1||'ASC');
 367
 368       push @out_chunks, \join (' ', $ch, $dir eq 'ASC' ? 'DESC' : 'ASC' );
 369     }
 370
 371     $order_by_reversed = $self->_order_by (\@out_chunks);
 372   }
 373
 374   # this is the order supplement magic
 375   my $mid_sel = $out_sel;
 376   if ($extra_order_sel) {
 377     for my $extra_col (sort
 378       { $extra_order_sel->{$a} cmp $extra_order_sel->{$b} }
 379       keys %$extra_order_sel
 380     ) {
 381       $in_sel .= sprintf (', %s AS %s',
 382         $extra_col,
 383         $extra_order_sel->{$extra_col},
 384       );
 385
 386       $mid_sel .= ', ' . $extra_order_sel->{$extra_col};
 387     }
 388
 389     # since whatever order bindvals there are, they will be realiased
 390     # and need to show up in front of the entire initial inner subquery
 391     # Unshift *from_bind* to make this happen (horrible, horrible, but
 392     # we don't have another mechanism yet)
 393     unshift @{$self->{from_bind}}, @{$self->{order_bind}};
 394   }
 395
 396   # and this is order re-alias magic
 397   for my $map ($extra_order_sel, $alias_map) {
 398     for my $col (keys %$map) {
 399       my $re_col = quotemeta ($col);
 400       $_ =~ s/$re_col/$map->{$col}/
 401         for ($order_by_reversed, $order_by_requested);
 402     }
 403   }
 404
 405   # generate the rest of the sql
 406   my $grpby_having = $self->_parse_rs_attrs ($rs_attrs);
 407
 408   my $quoted_rs_alias = $self->_quote ($rs_attrs->{alias});
 409
 410   $sql = sprintf ('SELECT TOP %u %s %s %s %s',
 411     $rows + ($offset||0),
 412     $in_sel,
 413     $sql,
 414     $grpby_having,
 415     $order_by_inner,
 416   );
 417
 418   $sql = sprintf ('SELECT TOP %u %s FROM ( %s ) %s %s',
 419     $rows,
 420     $mid_sel,
 421     $sql,
 422     $quoted_rs_alias,
 423     $order_by_reversed,
 424   ) if $offset;
 425
 426   $sql = sprintf ('SELECT TOP %u %s FROM ( %s ) %s %s',
 427     $rows,
 428     $out_sel,
 429     $sql,
 430     $quoted_rs_alias,
 431     $order_by_requested,
 432   ) if ( ($offset && $order_by_requested) || ($mid_sel ne $out_sel) );
 433
 434   return $sql;
 435 }
 436
 437 =head2 RowCountOrGenericSubQ
 438
 439 This is not exactly a limit dialect, but more of a proxy for B<Sybase ASE>.
 440 If no $offset is supplied the limit is simply performed as:
 441
 442  SET ROWCOUNT $limit
 443  SELECT ...
 444  SET ROWCOUNT 0
 445
 446 Otherwise we fall back to L</GenericSubQ>
 447
 448 =cut
 449 sub _RowCountOrGenericSubQ {
 450   my $self = shift;
 451   my ($sql, $rs_attrs, $rows, $offset) = @_;
 452
 453   return $self->_GenericSubQ(@_) if $offset;
 454
 455   return sprintf <<"EOF", $rows, $sql;
 456 SET ROWCOUNT %d
 457 %s
 458 SET ROWCOUNT 0
 459 EOF
 460 }
 461
 462 =head2 GenericSubQ
 463
 464  SELECT * FROM (
 465   SELECT ...
 466  )
 467  WHERE (
 468   SELECT COUNT(*) FROM $original_table cnt WHERE cnt.id < $original_table.id
 469  ) BETWEEN $offset AND ($offset+$rows-1)
 470
 471 This is the most evil limit "dialect" (more of a hack) for I<really> stupid
 472 databases. It works by ordering the set by some unique column, and calculating
 473 the amount of rows that have a less-er value (thus emulating a L</RowNum>-like
 474 index). Of course this implies the set can only be ordered by a single unique
 475 column. Also note that this technique can be and often is B<excruciatingly
 476 slow>.
 477
 478 Currently used by B<Sybase ASE>, due to lack of any other option.
 479
 480 =cut
 481 sub _GenericSubQ {
 482   my ($self, $sql, $rs_attrs, $rows, $offset) = @_;
 483
 484   my $root_rsrc = $rs_attrs->{_rsroot_source_handle}->resolve;
 485   my $root_tbl_name = $root_rsrc->name;
 486
 487   # mangle the input sql as we will be replacing the selector
 488   $sql =~ s/^ \s* SELECT \s+ .+? \s+ (?= \b FROM \b )//ix
 489     or croak "Unrecognizable SELECT: $sql";
 490
 491   my ($order_by, @rest) = do {
 492     local $self->{quote_char};
 493     $self->_order_by_chunks ($rs_attrs->{order_by})
 494   };
 495
 496   unless (
 497     $order_by
 498       &&
 499     ! @rest
 500       &&
 501     ( ! ref $order_by
 502         ||
 503       ( ref $order_by eq 'ARRAY' and @$order_by == 1 )
 504     )
 505   ) {
 506     croak (
 507       'Generic Subquery Limit does not work on resultsets without an order, or resultsets '
 508     . 'with complex order criteria (multicolumn and/or functions). Provide a single, '
 509     . 'unique-column order criteria.'
 510     );
 511   }
 512
 513   ($order_by) = @$order_by if ref $order_by;
 514
 515   $order_by =~ s/\s+ ( ASC|DESC ) \s* $//ix;
 516   my $direction = lc ($1 || 'asc');
 517
 518   my ($unq_sort_col) = $order_by =~ /(?:^|\.)([^\.]+)$/;
 519
 520   my $inf = $root_rsrc->storage->_resolve_column_info (
 521     $rs_attrs->{from}, [$order_by, $unq_sort_col]
 522   );
 523
 524   my $ord_colinfo = $inf->{$order_by} || croak "Unable to determine source of order-criteria '$order_by'";
 525
 526   if ($ord_colinfo->{-result_source}->name ne $root_tbl_name) {
 527     croak "Generic Subquery Limit order criteria can be only based on the root-source '"
 528         . $root_rsrc->source_name . "' (aliased as '$rs_attrs->{alias}')";
 529   }
 530
 531   # make sure order column is qualified
 532   $order_by = "$rs_attrs->{alias}.$order_by"
 533     unless $order_by =~ /^$rs_attrs->{alias}\./;
 534
 535   my $is_u;
 536   my $ucs = { $root_rsrc->unique_constraints };
 537   for (values %$ucs ) {
 538     if (@$_ == 1 && "$rs_attrs->{alias}.$_->[0]" eq $order_by) {
 539       $is_u++;
 540       last;
 541     }
 542   }
 543   croak "Generic Subquery Limit order criteria column '$order_by' must be unique (no unique constraint found)"
 544     unless $is_u;
 545
 546   my ($in_sel, $out_sel, $alias_map, $extra_order_sel)
 547     = $self->_subqueried_limit_attrs ($rs_attrs);
 548
 549   my $cmp_op = $direction eq 'desc' ? '>' : '<';
 550   my $count_tbl_alias = 'rownum__emulation';
 551
 552   my $order_sql = $self->_order_by (delete $rs_attrs->{order_by});
 553   my $group_having_sql = $self->_parse_rs_attrs($rs_attrs);
 554
 555   # add the order supplement (if any) as this is what will be used for the outer WHERE
 556   $in_sel .= ", $_" for keys %{$extra_order_sel||{}};
 557
 558   $sql = sprintf (<<EOS,
 559 SELECT $out_sel
 560   FROM (
 561     SELECT $in_sel ${sql}${group_having_sql}
 562   ) %s
 563 WHERE ( SELECT COUNT(*) FROM %s %s WHERE %s $cmp_op %s ) %s
 564 $order_sql
 565 EOS
 566     ( map { $self->_quote ($_) } (
 567       $rs_attrs->{alias},
 568       $root_tbl_name,
 569       $count_tbl_alias,
 570       "$count_tbl_alias.$unq_sort_col",
 571       $order_by,
 572     )),
 573     $offset
 574       ? sprintf ('BETWEEN %u AND %u', $offset, $offset + $rows - 1)
 575       : sprintf ('< %u', $rows )
 576     ,
 577   );
 578
 579   return $sql;
 580 }
 581
 582
 583 # !!! THIS IS ALSO HORRIFIC !!! /me ashamed
 584 #
 585 # Generates inner/outer select lists for various limit dialects
 586 # which result in one or more subqueries (e.g. RNO, Top, RowNum)
 587 # Any non-root-table columns need to have their table qualifier
 588 # turned into a column alias (otherwise names in subqueries clash
 589 # and/or lose their source table)
 590 #
 591 # Returns inner/outer strings of SQL QUOTED selectors with aliases
 592 # (to be used in whatever select statement), and an alias index hashref
 593 # of QUOTED SEL => QUOTED ALIAS pairs (to maybe be used for string-subst
 594 # higher up).
 595 # If an order_by is supplied, the inner select needs to bring out columns
 596 # used in implicit (non-selected) orders, and the order condition itself
 597 # needs to be realiased to the proper names in the outer query. Thus we
 598 # also return a hashref (order doesn't matter) of QUOTED EXTRA-SEL =>
 599 # QUOTED ALIAS pairs, which is a list of extra selectors that do *not*
 600 # exist in the original select list
 601 sub _subqueried_limit_attrs {
 602   my ($self, $rs_attrs) = @_;
 603
 604   croak 'Limit dialect implementation usable only in the context of DBIC (missing $rs_attrs)'
 605     unless ref ($rs_attrs) eq 'HASH';
 606
 607   my ($re_sep, $re_alias) = map { quotemeta $_ } ( $self->{name_sep}, $rs_attrs->{alias} );
 608
 609   # correlate select and as, build selection index
 610   my (@sel, $in_sel_index);
 611   for my $i (0 .. $#{$rs_attrs->{select}}) {
 612
 613     my $s = $rs_attrs->{select}[$i];
 614     my $sql_sel = $self->_recurse_fields ($s);
 615     my $sql_alias = (ref $s) eq 'HASH' ? $s->{-as} : undef;
 616
 617     push @sel, {
 618       sql => $sql_sel,
 619       unquoted_sql => do { local $self->{quote_char}; $self->_recurse_fields ($s) },
 620       as =>
 621         $sql_alias
 622           ||
 623         $rs_attrs->{as}[$i]
 624           ||
 625         croak "Select argument $i ($s) without corresponding 'as'"
 626       ,
 627     };
 628
 629     $in_sel_index->{$sql_sel}++;
 630     $in_sel_index->{$self->_quote ($sql_alias)}++ if $sql_alias;
 631
 632     # record unqualified versions too, so we do not have
 633     # to reselect the same column twice (in qualified and
 634     # unqualified form)
 635     if (! ref $s && $sql_sel =~ / $re_sep (.+) $/x) {
 636       $in_sel_index->{$1}++;
 637     }
 638   }
 639
 640
 641   # re-alias and remove any name separators from aliases,
 642   # unless we are dealing with the current source alias
 643   # (which will transcend the subqueries as it is necessary
 644   # for possible further chaining)
 645   my (@in_sel, @out_sel, %renamed);
 646   for my $node (@sel) {
 647     if (
 648       $node->{as} =~ / (?<! ^ $re_alias ) \. /x
 649         or
 650       $node->{unquoted_sql} =~ / (?<! ^ $re_alias ) $re_sep /x
 651     ) {
 652       $node->{as} = $self->_unqualify_colname($node->{as});
 653       my $quoted_as = $self->_quote($node->{as});
 654       push @in_sel, sprintf '%s AS %s', $node->{sql}, $quoted_as;
 655       push @out_sel, $quoted_as;
 656       $renamed{$node->{sql}} = $quoted_as;
 657     }
 658     else {
 659       push @in_sel, $node->{sql};
 660       push @out_sel, $self->_quote ($node->{as});
 661     }
 662   }
 663
 664   # see if the order gives us anything
 665   my %extra_order_sel;
 666   for my $chunk ($self->_order_by_chunks ($rs_attrs->{order_by})) {
 667     # order with bind
 668     $chunk = $chunk->[0] if (ref $chunk) eq 'ARRAY';
 669     $chunk =~ s/\s+ (?: ASC|DESC ) \s* $//ix;
 670
 671     next if $in_sel_index->{$chunk};
 672
 673     $extra_order_sel{$chunk} ||= $self->_quote (
 674       'ORDER__BY__' . scalar keys %extra_order_sel
 675     );
 676   }
 677
 678   return (
 679     (map { join (', ', @$_ ) } (
 680       \@in_sel,
 681       \@out_sel)
 682     ),
 683     \%renamed,
 684     keys %extra_order_sel ? \%extra_order_sel : (),
 685   );
 686 }
 687
 688 sub _unqualify_colname {
 689   my ($self, $fqcn) = @_;
 690   $fqcn =~ s/ \. /__/xg;
 691   return $fqcn;
 692 }
 693
 694 1;
 695
 696 =head1 AUTHORS
 697
 698 See L<DBIx::Class/CONTRIBUTORS>.
 699
 700 =head1 LICENSE
 701
 702 You may distribute this code under the same terms as Perl itself.
 703
 704 =cut