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