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