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