[svn-inject] Installing original source of libclass-dbi-plugin-pager-perl
Damyan Ivanov
16 years ago
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 ); |