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