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