| File | /project/perl/lib/Class/DBI/Plugin/Pager.pm |
| Statements Executed | 37 |
| Statement Execution Time | 13.1ms |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 1 | 1 | 1 | 112µs | 160µs | Class::DBI::Plugin::Pager::import |
| 0 | 0 | 0 | 0s | 0s | Class::DBI::Plugin::Pager::BEGIN |
| 0 | 0 | 0 | 0s | 0s | Class::DBI::Plugin::Pager::_init |
| 0 | 0 | 0 | 0s | 0s | Class::DBI::Plugin::Pager::_setup_pager |
| 0 | 0 | 0 | 0s | 0s | Class::DBI::Plugin::Pager::auto_set_syntax |
| 0 | 0 | 0 | 0s | 0s | Class::DBI::Plugin::Pager::pager |
| 0 | 0 | 0 | 0s | 0s | Class::DBI::Plugin::Pager::retrieve_all |
| 0 | 0 | 0 | 0s | 0s | Class::DBI::Plugin::Pager::search_where |
| 0 | 0 | 0 | 0s | 0s | Class::DBI::Plugin::Pager::set_syntax |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | package Class::DBI::Plugin::Pager; | ||||
| 2 | 3 | 87µs | 1 | 27µs | use strict;
# spent 27µs making 1 call to strict::import |
| 3 | 3 | 81µs | 1 | 115µs | use warnings;
# spent 115µs making 1 call to warnings::import |
| 4 | 3 | 90µs | 1 | 243µs | use Carp;
# spent 243µs making 1 call to Exporter::import |
| 5 | |||||
| 6 | 3 | 9.91ms | 1 | 138µs | use UNIVERSAL::require;
# spent 138µs making 1 call to Exporter::import |
| 7 | 3 | 100µs | 1 | 125µs | use SQL::Abstract;
# spent 125µs making 1 call to Exporter::import |
| 8 | |||||
| 9 | 3 | 108µs | 1 | 0s | use base qw( Data::Page Class::Data::Inheritable );
# spent 32.4ms making 1 call to base::import, recursion: max depth 1, time 32.4ms |
| 10 | |||||
| 11 | 3 | 289µs | 1 | 141µs | use vars qw( $VERSION );
# spent 141µs making 1 call to vars::import |
| 12 | |||||
| 13 | 1 | 6µs | $VERSION = 0.561; | ||
| 14 | |||||
| 15 | # D::P inherits from Class::Accessor::Chained::Fast | ||||
| 16 | 1 | 53µs | 1 | 1.34ms | __PACKAGE__->mk_accessors( qw( where abstract_attr per_page page order_by _cdbi_app ) );
# spent 1.34ms making 1 call to Class::Accessor::mk_accessors |
| 17 | |||||
| 18 | 1 | 36µs | 1 | 60µs | __PACKAGE__->mk_classdata( '_syntax' );
# spent 60µs making 1 call to Class::Data::Inheritable::mk_classdata |
| 19 | 1 | 26µs | 1 | 52µs | __PACKAGE__->mk_classdata( '_pager_class' );
# spent 52µs making 1 call to Class::Data::Inheritable::mk_classdata |
| 20 | |||||
| 21 | |||||
| 22 | =head1 NAME | ||||
| 23 | |||||
| 24 | Class::DBI::Plugin::Pager - paged queries for CDBI | ||||
| 25 | |||||
| 26 | =head1 DESCRIPTION | ||||
| 27 | |||||
| 28 | Adds a pager method to your class that can query using SQL::Abstract where clauses, | ||||
| 29 | and limit the number of rows returned to a specific subset. | ||||
| 30 | |||||
| 31 | =head1 SYNOPSIS | ||||
| 32 | |||||
| 33 | package CD; | ||||
| 34 | use base 'Class::DBI'; | ||||
| 35 | |||||
| 36 | use Class::DBI::Plugin::AbstractCount; # pager needs this | ||||
| 37 | use Class::DBI::Plugin::Pager; | ||||
| 38 | |||||
| 39 | # or to use a different syntax | ||||
| 40 | # use Class::DBI::Plugin::Pager::RowsTo; | ||||
| 41 | |||||
| 42 | __PACKAGE__->set_db(...); | ||||
| 43 | |||||
| 44 | |||||
| 45 | # in a nearby piece of code... | ||||
| 46 | |||||
| 47 | use CD; | ||||
| 48 | |||||
| 49 | # see SQL::Abstract for how to specify the query | ||||
| 50 | my $where = { ... }; | ||||
| 51 | |||||
| 52 | my $order_by => [ qw( foo bar ) ]; | ||||
| 53 | |||||
| 54 | # bit by bit: | ||||
| 55 | my $pager = CD->pager; | ||||
| 56 | |||||
| 57 | $pager->per_page( 10 ); | ||||
| 58 | $pager->page( 3 ); | ||||
| 59 | $pager->where( $where ); | ||||
| 60 | $pager->order_by( $order_by ); | ||||
| 61 | |||||
| 62 | $pager->set_syntax( 'RowsTo' ); | ||||
| 63 | |||||
| 64 | my @cds = $pager->search_where; | ||||
| 65 | |||||
| 66 | # or all at once | ||||
| 67 | my $pager = CD->pager( $where, $order_by, 10, 3 ); | ||||
| 68 | |||||
| 69 | my @cds = $pager->search_where; | ||||
| 70 | |||||
| 71 | # or | ||||
| 72 | |||||
| 73 | my $pager = CD->pager; | ||||
| 74 | |||||
| 75 | my @cds = $pager->search_where( $where, $order_by, 10, 3 ); | ||||
| 76 | |||||
| 77 | # $pager isa Data::Page | ||||
| 78 | # @cds contains the CDs just for the current page | ||||
| 79 | |||||
| 80 | =head1 METHODS | ||||
| 81 | |||||
| 82 | =over | ||||
| 83 | |||||
| 84 | =item import | ||||
| 85 | |||||
| 86 | Loads the C<pager> method into the CDBI app. | ||||
| 87 | |||||
| 88 | =cut | ||||
| 89 | |||||
| 90 | # spent 160µs (112+48) within Class::DBI::Plugin::Pager::import which was called
# once (112µs+48µs) by base::import at line 10 of K2/DB2.pm | ||||
| 91 | 8 | 131µs | my ( $class ) = @_; # the pager class or subclass | ||
| 92 | |||||
| 93 | __PACKAGE__->_pager_class( $class );
# spent 26µs making 1 call to Class::Data::Inheritable::__ANON__[Class/Data/Inheritable.pm:23] | ||||
| 94 | |||||
| 95 | my $caller; | ||||
| 96 | |||||
| 97 | # find the app - supports subclassing (My::Pager is_a CDBI::P::Pager, not_a CDBI) | ||||
| 98 | foreach my $level ( 0 .. 10 ) | ||||
| 99 | { | ||||
| 100 | $caller = caller( $level ); | ||||
| 101 | last if UNIVERSAL::isa( $caller, 'Class::DBI' )
# spent 22µs making 1 call to UNIVERSAL::isa | ||||
| 102 | } | ||||
| 103 | |||||
| 104 | warn( "can't find the CDBI app" ), return unless $caller; | ||||
| 105 | #croak( "can't find the CDBI app" ) unless $caller; | ||||
| 106 | |||||
| 107 | 3 | 2.20ms | 1 | 101µs | no strict 'refs';
# spent 101µs making 1 call to strict::unimport |
| 108 | *{"$caller\::pager"} = \&pager; | ||||
| 109 | } | ||||
| 110 | |||||
| 111 | =item pager( [$where, [$abstract_attr]], [$order_by], [$per_page], [$page], [$syntax] ) | ||||
| 112 | |||||
| 113 | Also accepts named arguments: | ||||
| 114 | |||||
| 115 | where => $where, | ||||
| 116 | abstract_attr => $attr, | ||||
| 117 | order_by => $order_by, | ||||
| 118 | per_page => $per_page, | ||||
| 119 | page => $page, | ||||
| 120 | syntax => $syntax | ||||
| 121 | |||||
| 122 | Returns a pager object. This subclasses L<Data::Page>. | ||||
| 123 | |||||
| 124 | Note that for positional arguments, C<$abstract_attr> can only be passed if | ||||
| 125 | preceded by a C<$where> argument. | ||||
| 126 | |||||
| 127 | C<$abstract_attr> can contain the C<$order_by> setting (just as in | ||||
| 128 | L<SQL::Abstract|SQL::Abstract>). | ||||
| 129 | |||||
| 130 | =over 4 | ||||
| 131 | |||||
| 132 | =item configuration | ||||
| 133 | |||||
| 134 | The named arguments all exist as get/set methods. | ||||
| 135 | |||||
| 136 | =over 4 | ||||
| 137 | |||||
| 138 | =item where | ||||
| 139 | |||||
| 140 | A hashref specifying the query. See L<SQL::Abstract|SQL::Abstract>. | ||||
| 141 | |||||
| 142 | =item abstract_attr | ||||
| 143 | |||||
| 144 | A hashref specifying extra options to be passed through to the | ||||
| 145 | L<SQL::Abstract|SQL::Abstract> constructor. | ||||
| 146 | |||||
| 147 | =item order_by | ||||
| 148 | |||||
| 149 | Single column name or arrayref of column names for the ORDER BY clause. | ||||
| 150 | Defaults to the primary key(s) if not set. | ||||
| 151 | |||||
| 152 | =item per_page | ||||
| 153 | |||||
| 154 | Number of results per page. | ||||
| 155 | |||||
| 156 | =item page | ||||
| 157 | |||||
| 158 | The pager will retrieve results just for this page. Defaults to 1. | ||||
| 159 | |||||
| 160 | =item syntax | ||||
| 161 | |||||
| 162 | Change the way the 'limit' clause is constructed. See C<set_syntax>. Default | ||||
| 163 | is C<LimitOffset>. | ||||
| 164 | |||||
| 165 | =back | ||||
| 166 | |||||
| 167 | =back | ||||
| 168 | |||||
| 169 | =cut | ||||
| 170 | |||||
| 171 | sub pager { | ||||
| 172 | my $cdbi = shift; | ||||
| 173 | |||||
| 174 | my $class = __PACKAGE__->_pager_class; | ||||
| 175 | |||||
| 176 | my $self = bless {}, $class; | ||||
| 177 | |||||
| 178 | $self->_cdbi_app( $cdbi ); | ||||
| 179 | |||||
| 180 | # This has to come before _init, so the caller can choose to set the syntax | ||||
| 181 | # instead. But don't auto-set if we're a subclass. | ||||
| 182 | $self->auto_set_syntax if $class eq __PACKAGE__; | ||||
| 183 | |||||
| 184 | $self->_init( @_ ); | ||||
| 185 | |||||
| 186 | return $self; | ||||
| 187 | } | ||||
| 188 | |||||
| 189 | # _init is also called by results, so preserve any existing settings if | ||||
| 190 | # new settings are not provided | ||||
| 191 | sub _init { | ||||
| 192 | my $self = shift; | ||||
| 193 | |||||
| 194 | return unless @_; | ||||
| 195 | |||||
| 196 | my ( $where, $abstract_attr, $order_by, $per_page, $page, $syntax ); | ||||
| 197 | |||||
| 198 | if ( ref( $_[0] ) or $_[0] =~ /^\d+$/ ) | ||||
| 199 | { | ||||
| 200 | $where = shift if ref $_[0]; # SQL::Abstract accepts a hashref or an arrayref | ||||
| 201 | $abstract_attr = shift if ref $_[0] eq 'HASH'; | ||||
| 202 | # $order_by = shift unless $_[0] =~ /^\d+$/; | ||||
| 203 | # $per_page = shift if $_[0] =~ /^\d+$/; | ||||
| 204 | # $page = shift if $_[0] =~ /^\d+$/; | ||||
| 205 | $order_by = shift unless $_[0] and $_[0] =~ /^\d+$/; | ||||
| 206 | $per_page = shift if $_[0] and $_[0] =~ /^\d+$/; | ||||
| 207 | $page = shift if $_[0] and $_[0] =~ /^\d+$/; | ||||
| 208 | $syntax = shift; | ||||
| 209 | } | ||||
| 210 | else | ||||
| 211 | { | ||||
| 212 | my %args = @_; | ||||
| 213 | |||||
| 214 | $where = $args{where}; | ||||
| 215 | $abstract_attr = $args{abstract_attr}; | ||||
| 216 | $order_by = $args{order_by}; | ||||
| 217 | $per_page = $args{per_page}; | ||||
| 218 | $page = $args{page}; | ||||
| 219 | $syntax = $args{syntax}; | ||||
| 220 | } | ||||
| 221 | |||||
| 222 | # Emulate AbstractSearch's search_where ordering -VV 20041209 | ||||
| 223 | $order_by = delete $$abstract_attr{order_by} if ($abstract_attr and !$order_by); | ||||
| 224 | |||||
| 225 | $self->per_page( $per_page ) if $per_page; | ||||
| 226 | $self->set_syntax( $syntax ) if $syntax; | ||||
| 227 | $self->abstract_attr( $abstract_attr )if $abstract_attr; | ||||
| 228 | $self->where( $where ) if $where; | ||||
| 229 | $self->order_by( $order_by ) if $order_by; | ||||
| 230 | $self->page( $page ) if $page; | ||||
| 231 | } | ||||
| 232 | |||||
| 233 | =item search_where | ||||
| 234 | |||||
| 235 | Retrieves results from the pager. Accepts the same arguments as the C<pager> | ||||
| 236 | method. | ||||
| 237 | |||||
| 238 | =cut | ||||
| 239 | |||||
| 240 | # like CDBI::AbstractSearch::search_where, with extra limitations | ||||
| 241 | sub search_where { | ||||
| 242 | my $self = shift; | ||||
| 243 | |||||
| 244 | $self->_init( @_ ); | ||||
| 245 | |||||
| 246 | $self->_setup_pager; | ||||
| 247 | |||||
| 248 | my $cdbi = $self->_cdbi_app; | ||||
| 249 | |||||
| 250 | my $order_by = $self->order_by || [ $cdbi->primary_columns ]; | ||||
| 251 | my $where = $self->where; | ||||
| 252 | my $syntax = $self->_syntax || $self->set_syntax; | ||||
| 253 | my $limit_phrase = $self->$syntax; | ||||
| 254 | my $sql = SQL::Abstract->new( %{ $self->abstract_attr || {} } ); | ||||
| 255 | |||||
| 256 | $order_by = [ $order_by ] unless ref $order_by; | ||||
| 257 | my ( $phrase, @bind ) = $sql->where( $where, $order_by ); | ||||
| 258 | |||||
| 259 | # If the phrase starts with the ORDER clause (i.e. no WHERE spec), then we are | ||||
| 260 | # emulating a { 1 => 1 } search, but avoiding the bug in Class::DBI::Plugin::AbstractCount 0.04, | ||||
| 261 | # so we need to replace the spec - patch from Will Hawes | ||||
| 262 | if ( $phrase =~ /^\s*ORDER\s*/i ) | ||||
| 263 | { | ||||
| 264 | $phrase = ' 1=1' . $phrase; | ||||
| 265 | } | ||||
| 266 | |||||
| 267 | |||||
| 268 | $phrase .= ' ' . $limit_phrase; | ||||
| 269 | $phrase =~ s/^\s*WHERE\s*//i; | ||||
| 270 | |||||
| 271 | return $cdbi->retrieve_from_sql( $phrase, @bind ); | ||||
| 272 | } | ||||
| 273 | |||||
| 274 | =item retrieve_all | ||||
| 275 | |||||
| 276 | Convenience method, generates a WHERE clause that matches all rows from the table. | ||||
| 277 | |||||
| 278 | Accepts the same arguments as the C<pager> or C<search_where> methods, except that no | ||||
| 279 | WHERE clause should be specified. | ||||
| 280 | |||||
| 281 | Note that the argument parsing routine called by the C<pager> method cannot cope with | ||||
| 282 | positional arguments that lack a WHERE clause, so either use named arguments, or the | ||||
| 283 | 'bit by bit' approach, or pass the arguments directly to C<retrieve_all>. | ||||
| 284 | |||||
| 285 | =cut | ||||
| 286 | |||||
| 287 | sub retrieve_all | ||||
| 288 | { | ||||
| 289 | my $self = shift; | ||||
| 290 | |||||
| 291 | my $get_all = {}; # { 1 => 1 }; | ||||
| 292 | |||||
| 293 | unless ( @_ ) | ||||
| 294 | { # already set pager up via method calls | ||||
| 295 | $self->where( $get_all ); | ||||
| 296 | return $self->search_where; | ||||
| 297 | } | ||||
| 298 | |||||
| 299 | my @args = ( ref( $_[0] ) or $_[0] =~ /^\d+$/ ) ? | ||||
| 300 | ( $get_all, @_ ) : # send an array | ||||
| 301 | ( where => $get_all, @_ ); # send a hash | ||||
| 302 | |||||
| 303 | return $self->search_where( @args ); | ||||
| 304 | } | ||||
| 305 | |||||
| 306 | sub _setup_pager | ||||
| 307 | { | ||||
| 308 | my ( $self ) = @_; | ||||
| 309 | |||||
| 310 | my $where = $self->where || {}; | ||||
| 311 | |||||
| 312 | # fix { 1 => 1 } as a special case - Class::DBI::Plugin::AbstractCount 0.04 has a bug in | ||||
| 313 | # its column-checking code | ||||
| 314 | if ( ref( $where ) eq 'HASH' and $where->{1} ) | ||||
| 315 | { | ||||
| 316 | $where = {}; | ||||
| 317 | $self->where( {} ); | ||||
| 318 | } | ||||
| 319 | |||||
| 320 | my $per_page = $self->per_page || croak( 'no. of entries per page not specified' ); | ||||
| 321 | my $cdbi = $self->_cdbi_app; | ||||
| 322 | my $count = $cdbi->count_search_where( $where, $self->abstract_attr ); | ||||
| 323 | my $page = $self->page || 1; | ||||
| 324 | |||||
| 325 | $self->total_entries( $count ); | ||||
| 326 | $self->entries_per_page( $per_page ); | ||||
| 327 | $self->current_page( $page ); | ||||
| 328 | |||||
| 329 | croak( 'Fewer than one entry per page!' ) if $self->entries_per_page < 1; | ||||
| 330 | |||||
| 331 | $self->current_page( $self->first_page ) unless defined $self->current_page; | ||||
| 332 | $self->current_page( $self->first_page ) if $self->current_page < $self->first_page; | ||||
| 333 | $self->current_page( $self->last_page ) if $self->current_page > $self->last_page; | ||||
| 334 | } | ||||
| 335 | |||||
| 336 | # SQL::Abstract::_recurse_where eats the WHERE clause | ||||
| 337 | #sub where { | ||||
| 338 | # my ( $self, $where_ref ) = @_; | ||||
| 339 | # | ||||
| 340 | # return $self->_where unless $where_ref; | ||||
| 341 | # | ||||
| 342 | # my $where_copy; | ||||
| 343 | # | ||||
| 344 | # if ( ref( $where_ref ) eq 'HASH' ) { | ||||
| 345 | # $where_copy = { %$where_ref }; | ||||
| 346 | # } | ||||
| 347 | # elsif ( ref( $where_ref ) eq 'ARRAY' ) | ||||
| 348 | # { | ||||
| 349 | # $where_copy = [ @$where_ref ]; | ||||
| 350 | # } | ||||
| 351 | # else | ||||
| 352 | # { | ||||
| 353 | # die "WHERE clause [$where_ref] must be specified as an ARRAYREF or HASHREF"; | ||||
| 354 | # } | ||||
| 355 | # | ||||
| 356 | # # this will get eaten, but the caller's value is now protected | ||||
| 357 | # $self->_where( $where_copy ); | ||||
| 358 | #} | ||||
| 359 | |||||
| 360 | =item set_syntax( [ $name || $class || $coderef ] ) | ||||
| 361 | |||||
| 362 | Changes the syntax used to generate the C<limit> or other phrase that restricts | ||||
| 363 | the results set to the required page. | ||||
| 364 | |||||
| 365 | The syntax is implemented as a method called on the pager, which can be | ||||
| 366 | queried to provide the C<$rows> and C<$offset> parameters (see the subclasses | ||||
| 367 | included in this distribution). | ||||
| 368 | |||||
| 369 | =over 4 | ||||
| 370 | |||||
| 371 | =item $class | ||||
| 372 | |||||
| 373 | A class with a C<make_limit> method. | ||||
| 374 | |||||
| 375 | =item $name | ||||
| 376 | |||||
| 377 | Name of a class in the C<Class::DBI::Plugin::Pager::> namespace, which has a | ||||
| 378 | C<make_limit> method. | ||||
| 379 | |||||
| 380 | =item $coderef | ||||
| 381 | |||||
| 382 | Will be called as a method on the pager object, so receives the pager as its | ||||
| 383 | argument. | ||||
| 384 | |||||
| 385 | =item (no args) | ||||
| 386 | |||||
| 387 | Called without args, will default to C<LimitOffset>, which causes | ||||
| 388 | L<Class::DBI::Plugin::Pager::LimitOffset|Class::DBI::Plugin::Pager::LimitOffset> | ||||
| 389 | to be used. | ||||
| 390 | |||||
| 391 | =back | ||||
| 392 | |||||
| 393 | =cut | ||||
| 394 | |||||
| 395 | sub set_syntax { | ||||
| 396 | my ( $proto, $syntax ) = @_; | ||||
| 397 | |||||
| 398 | # pick up default from subclass, or load from LimitOffset | ||||
| 399 | $syntax ||= $proto->can( 'make_limit' ); | ||||
| 400 | $syntax ||= 'LimitOffset'; | ||||
| 401 | |||||
| 402 | if ( ref( $syntax ) eq 'CODE' ) | ||||
| 403 | { | ||||
| 404 | $proto->_syntax( $syntax ); | ||||
| 405 | return $syntax; | ||||
| 406 | } | ||||
| 407 | |||||
| 408 | my $format_class = $syntax =~ '::' ? $syntax : "Class::DBI::Plugin::Pager::$syntax"; | ||||
| 409 | |||||
| 410 | $format_class->require || croak "error loading $format_class: $UNIVERSAL::require::ERROR"; | ||||
| 411 | |||||
| 412 | my $formatter = $format_class->can( 'make_limit' ) || croak "no make_limit method in $format_class"; | ||||
| 413 | |||||
| 414 | $proto->_syntax( $formatter ); | ||||
| 415 | |||||
| 416 | return $formatter; | ||||
| 417 | } | ||||
| 418 | |||||
| 419 | =item auto_set_syntax | ||||
| 420 | |||||
| 421 | This is called automatically when you call C<pager>, and attempts to set the | ||||
| 422 | syntax automatically. | ||||
| 423 | |||||
| 424 | If you are using a subclass of the pager, this method will not be called. | ||||
| 425 | |||||
| 426 | Will C<die> if using Oracle or DB2, since there is no simple syntax for limiting | ||||
| 427 | the results set. DB2 has a C<FETCH> keyword, but that seems to apply to a | ||||
| 428 | cursor and I don't know if there is a cursor available to the pager. There | ||||
| 429 | should probably be others to add to the unsupported list. | ||||
| 430 | |||||
| 431 | Supports the following drivers: | ||||
| 432 | |||||
| 433 | DRIVER CDBI::P::Pager subclass | ||||
| 434 | my %supported = ( pg => 'LimitOffset', | ||||
| 435 | mysql => 'LimitOffset', # older versions need LimitXY | ||||
| 436 | sqlite => 'LimitOffset', # or LimitYX | ||||
| 437 | sqlite2 => 'LimitOffset', # or LimitYX | ||||
| 438 | interbase => 'RowsTo', | ||||
| 439 | firebird => 'RowsTo', | ||||
| 440 | ); | ||||
| 441 | |||||
| 442 | Older versions of MySQL should use the LimitXY syntax. You'll need to set it | ||||
| 443 | manually, either by C<use CDBI::P::Pager::LimitXY>, or by passing | ||||
| 444 | C<syntax =E<gt> 'LimitXY'> to a method call, or call C<set_syntax> directly. | ||||
| 445 | |||||
| 446 | Any driver not in the supported or unsupported lists defaults to LimitOffset. | ||||
| 447 | |||||
| 448 | Any additions to the supported and unsupported lists gratefully received. | ||||
| 449 | |||||
| 450 | =cut | ||||
| 451 | |||||
| 452 | sub auto_set_syntax { | ||||
| 453 | my ( $self ) = @_; | ||||
| 454 | |||||
| 455 | # not an exhaustive list | ||||
| 456 | my %not_supported = ( oracle => 'Oracle', | ||||
| 457 | db2 => 'DB2', | ||||
| 458 | ); | ||||
| 459 | |||||
| 460 | # additions welcome | ||||
| 461 | my %supported = ( pg => 'LimitOffset', | ||||
| 462 | mysql => 'LimitOffset', # older versions need LimitXY | ||||
| 463 | sqlite => 'LimitOffset', # or LimitYX | ||||
| 464 | sqlite2 => 'LimitOffset', # or LimitYX | ||||
| 465 | interbase => 'RowsTo', | ||||
| 466 | firebird => 'RowsTo', | ||||
| 467 | ); | ||||
| 468 | |||||
| 469 | my $cdbi = $self->_cdbi_app; | ||||
| 470 | |||||
| 471 | my $driver = lc( $cdbi->__driver ); | ||||
| 472 | |||||
| 473 | die __PACKAGE__ . " can't build limit clauses for $not_supported{ $driver }" | ||||
| 474 | if $not_supported{ $driver }; | ||||
| 475 | |||||
| 476 | #warn sprintf "Setting syntax to %s for $driver", $supported{ $driver } || 'LimitOffset'; | ||||
| 477 | |||||
| 478 | $self->set_syntax( $supported{ $driver } || 'LimitOffset' ); | ||||
| 479 | } | ||||
| 480 | |||||
| 481 | 1 | 19µs | 1; | ||
| 482 | |||||
| 483 | __END__ | ||||
| 484 | |||||
| 485 | #=for notes | ||||
| 486 | # | ||||
| 487 | #Would this work? | ||||
| 488 | # | ||||
| 489 | #with $limit and $offset defined. | ||||
| 490 | # | ||||
| 491 | #my $last = $limit + $offset | ||||
| 492 | # | ||||
| 493 | #my $order_by_str = join( ', ', @$order_by ) | ||||
| 494 | # | ||||
| 495 | #$cdbi->set_sql( emulate_limit => <<''); | ||||
| 496 | # SELECT * FROM ( | ||||
| 497 | # SELECT TOP $limit * FROM ( | ||||
| 498 | # SELECT TOP $last __ESSENTIAL__ | ||||
| 499 | # FROM __TABLE__ | ||||
| 500 | # ORDER BY $order_by_str ASC | ||||
| 501 | # ) AS foo ORDER BY $order_by_str DESC | ||||
| 502 | # ) AS bar ORDER BY $order_by_str ASC | ||||
| 503 | # | ||||
| 504 | # | ||||
| 505 | #e.g. MS Access (thanks Emanuele Zeppieri) | ||||
| 506 | # | ||||
| 507 | #to add LIMIT/OFFSET to this query: | ||||
| 508 | # | ||||
| 509 | #SELECT my_column | ||||
| 510 | #FROM my_table | ||||
| 511 | #ORDER BY my_column ASC | ||||
| 512 | # | ||||
| 513 | #say with the values LIMIT=5 OFFSET=10, you have to resort to the TOP | ||||
| 514 | #clause and re-write it this way: | ||||
| 515 | # | ||||
| 516 | #SELECT * FROM ( | ||||
| 517 | # SELECT TOP 5 * FROM ( | ||||
| 518 | # SELECT TOP 15 my_column | ||||
| 519 | # FROM my_table | ||||
| 520 | # ORDER BY my_column ASC | ||||
| 521 | # ) AS foo ORDER BY my_column DESC | ||||
| 522 | #) AS bar ORDER BY my_column ASC | ||||
| 523 | # | ||||
| 524 | #=cut | ||||
| 525 | |||||
| 526 | =back | ||||
| 527 | |||||
| 528 | =head2 SUBCLASSING | ||||
| 529 | |||||
| 530 | The 'limit' syntax can be set by using a subclass, e.g. | ||||
| 531 | |||||
| 532 | use Class::DBI::Plugin::Pager::RowsTo; | ||||
| 533 | |||||
| 534 | instead of setting at runtime. A subclass looks like this: | ||||
| 535 | |||||
| 536 | package Class::DBI::Plugin::Pager::RowsTo; | ||||
| 537 | use base 'Class::DBI::Plugin::Pager'; | ||||
| 538 | |||||
| 539 | sub make_limit { | ||||
| 540 | my ( $self ) = @_; | ||||
| 541 | |||||
| 542 | my $offset = $self->skipped; | ||||
| 543 | my $rows = $self->entries_per_page; | ||||
| 544 | |||||
| 545 | my $last = $rows + $offset; | ||||
| 546 | |||||
| 547 | return "ROWS $offset TO $last"; | ||||
| 548 | } | ||||
| 549 | |||||
| 550 | 1; | ||||
| 551 | |||||
| 552 | You can omit the C<use base> and switch syntax by calling | ||||
| 553 | C<$pager-E<gt>set_syntax( 'RowsTo' )>. Or you can leave in the C<use base> and | ||||
| 554 | still say C<$pager-E<gt>set_syntax( 'RowsTo' )>, because in this case the class is | ||||
| 555 | C<require>d and the C<import> in the base class doesn't get called. Or something. | ||||
| 556 | At any rate, It Works. | ||||
| 557 | |||||
| 558 | The subclasses implement the following LIMIT syntaxes: | ||||
| 559 | |||||
| 560 | =over | ||||
| 561 | |||||
| 562 | =item Class::DBI::Plugin::Pager::LimitOffset | ||||
| 563 | |||||
| 564 | LIMIT $rows OFFSET $offset | ||||
| 565 | |||||
| 566 | This is the default if your driver is not in the list of known drivers. | ||||
| 567 | |||||
| 568 | This should work for PostgreSQL, more recent MySQL, SQLite, and maybe some | ||||
| 569 | others. | ||||
| 570 | |||||
| 571 | =item Class::DBI::Plugin::LimitXY | ||||
| 572 | |||||
| 573 | LIMIT $offset, $rows | ||||
| 574 | |||||
| 575 | Older versions of MySQL. | ||||
| 576 | |||||
| 577 | =item Class::DBI::Plugin::LimitYX | ||||
| 578 | |||||
| 579 | LIMIT $rows, $offset | ||||
| 580 | |||||
| 581 | SQLite. | ||||
| 582 | |||||
| 583 | =item Class::DBI::Plugin::RowsTo | ||||
| 584 | |||||
| 585 | ROWS $offset TO $offset + $rows | ||||
| 586 | |||||
| 587 | InterBase, also FireBird, maybe others? | ||||
| 588 | |||||
| 589 | =back | ||||
| 590 | |||||
| 591 | =head1 TODO | ||||
| 592 | |||||
| 593 | I've only used this on an older version of MySQL. Reports of this thing | ||||
| 594 | working (or not) elsewhere would be useful. | ||||
| 595 | |||||
| 596 | It should be possible to use C<set_sql> to build the complex queries | ||||
| 597 | required by some databases to emulate LIMIT (see notes in source). | ||||
| 598 | |||||
| 599 | =head1 CAVEATS | ||||
| 600 | |||||
| 601 | This class can't implement the subselect mechanism required by some databases | ||||
| 602 | to emulate the LIMIT phrase, because it only has access to the WHERE clause, | ||||
| 603 | not the whole SQL statement. At the moment. | ||||
| 604 | |||||
| 605 | Each query issues two requests to the database - the first to count the entire | ||||
| 606 | result set, the second to retrieve the required subset of results. If your | ||||
| 607 | tables are small it may be quicker to use L<Class::DBI::Pager|Class::DBI::Pager>. | ||||
| 608 | |||||
| 609 | The C<order_by> clause means the database has to retrieve (internally) and sort | ||||
| 610 | the entire results set, before chopping out the requested subset. It's probably | ||||
| 611 | a good idea to have an index on the column(s) used to order the results. For | ||||
| 612 | huge tables, this approach to paging may be too inefficient. | ||||
| 613 | |||||
| 614 | =head1 DEPENDENCIES | ||||
| 615 | |||||
| 616 | L<SQL::Abstract|SQL::Abstract>, | ||||
| 617 | L<Data::Page|Data::Page>, | ||||
| 618 | L<Class::DBI::Plugin::AbstractCount|Class::DBI::Plugin::AbstractCount>, | ||||
| 619 | L<Class::Accessor|Class::Accessor>, | ||||
| 620 | L<Class::Data::Inheritable|Class::Data::Inheritable>, | ||||
| 621 | L<Carp|Carp>. | ||||
| 622 | |||||
| 623 | =head1 SEE ALSO | ||||
| 624 | |||||
| 625 | L<Class::DBI::Pager|Class::DBI::Pager> does a similar job, but retrieves | ||||
| 626 | the entire results set into memory before chopping out the page you want. | ||||
| 627 | |||||
| 628 | =head1 BUGS | ||||
| 629 | |||||
| 630 | Please report all bugs via the CPAN Request Tracker at | ||||
| 631 | L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Class-DBI-Plugin-Pager>. | ||||
| 632 | |||||
| 633 | =head1 COPYRIGHT AND LICENSE | ||||
| 634 | |||||
| 635 | Copyright 2004 by David Baird. | ||||
| 636 | |||||
| 637 | This library is free software; you can redistribute it and/or modify | ||||
| 638 | it under the same terms as Perl itself. | ||||
| 639 | |||||
| 640 | =head1 AUTHOR | ||||
| 641 | |||||
| 642 | David Baird, C<cpan@riverside-cms.co.uk> | ||||
| 643 |