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