Class-DBI-Plugin-Pager-0.566000755001750001750 012025354610 16552 5ustar00pixelheadpixelhead000000000000Class-DBI-Plugin-Pager-0.566/META.json000444001750001750 354012025354610 20332 0ustar00pixelheadpixelhead000000000000{ "abstract" : "paged queries for CDBI", "author" : [ "David Baird", "Nikolay S. " ], "dynamic_config" : 1, "generated_by" : "Module::Build version 0.4003, CPAN::Meta::Converter version 2.120921", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Class-DBI-Plugin-Pager", "prereqs" : { "configure" : { "requires" : { "Module::Build" : "0.40" } }, "runtime" : { "requires" : { "Carp" : "0", "Class::DBI" : "0.9", "Class::DBI::Plugin::AbstractCount" : "0", "Class::Data::Inheritable" : "0", "Data::Page" : "2", "SQL::Abstract" : "1.61", "Test::Exception" : "0", "Test::More" : "0", "Test::Warn" : "0", "UNIVERSAL::require" : "0" } } }, "provides" : { "Class::DBI::Plugin::Pager" : { "file" : "lib/Class/DBI/Plugin/Pager.pm", "version" : "0.566" }, "Class::DBI::Plugin::Pager::LimitOffset" : { "file" : "lib/Class/DBI/Plugin/Pager/LimitOffset.pm", "version" : 0 }, "Class::DBI::Plugin::Pager::LimitXY" : { "file" : "lib/Class/DBI/Plugin/Pager/LimitXY.pm", "version" : 0 }, "Class::DBI::Plugin::Pager::LimitYX" : { "file" : "lib/Class/DBI/Plugin/Pager/LimitYX.pm", "version" : 0 }, "Class::DBI::Plugin::Pager::RowsTo" : { "file" : "lib/Class/DBI/Plugin/Pager/RowsTo.pm", "version" : 0 } }, "release_status" : "stable", "resources" : { "repository" : { "url" : "git://github.com/majesticcpan/class-dbi-plugin-pager.git" } }, "version" : "0.566" } Class-DBI-Plugin-Pager-0.566/MANIFEST000444001750001750 56712025354610 20030 0ustar00pixelheadpixelhead000000000000Build.PL Changes lib/Class/DBI/Plugin/Pager.pm lib/Class/DBI/Plugin/Pager/LimitOffset.pm lib/Class/DBI/Plugin/Pager/LimitXY.pm lib/Class/DBI/Plugin/Pager/LimitYX.pm lib/Class/DBI/Plugin/Pager/RowsTo.pm MANIFEST This list of files README t/00.load.t t/01.load_subclass.t t/02.main.t t/03.subclass.t t/04.auto_syntax.t t/pod-coverage.t t/pod.t Makefile.PL META.yml META.json Class-DBI-Plugin-Pager-0.566/Makefile.PL000444001750001750 136512025354610 20666 0ustar00pixelheadpixelhead000000000000# Note: this file was auto-generated by Module::Build::Compat version 0.4003 use ExtUtils::MakeMaker; WriteMakefile ( 'NAME' => 'Class::DBI::Plugin::Pager', 'VERSION_FROM' => 'lib/Class/DBI/Plugin/Pager.pm', 'PREREQ_PM' => { 'Carp' => 0, 'Class::DBI' => '0.9', 'Class::DBI::Plugin::AbstractCount' => 0, 'Class::Data::Inheritable' => 0, 'Data::Page' => 2, 'SQL::Abstract' => '1.61', 'Test::Exception' => 0, 'Test::More' => 0, 'Test::Warn' => 0, 'UNIVERSAL::require' => 0 }, 'INSTALLDIRS' => 'site', 'EXE_FILES' => [], 'PL_FILES' => {} ) ; Class-DBI-Plugin-Pager-0.566/README000555001750001750 140712025354610 17574 0ustar00pixelheadpixelhead000000000000Class-DBI-Plugin-Pager Adds a pager method to your class that can query using SQL::Abstract where clauses, and limit the number of rows returned to a specific subset. INSTALLATION To install this module, run the following commands: perl Build.PL ./Build ./Build test ./Build install DEPENDENCIES L, L, L, L, L, L. COPYRIGHT AND LICENCE This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Copyright (C) 2004-2012 David R. Baird Copyright (C) 2012 Nikolay S. CClass-DBI-Plugin-Pager-0.566/META.yml000444001750001750 231112025354610 20155 0ustar00pixelheadpixelhead000000000000--- abstract: 'paged queries for CDBI' author: - 'David Baird' - 'Nikolay S. ' build_requires: {} configure_requires: Module::Build: 0.40 dynamic_config: 1 generated_by: 'Module::Build version 0.4003, CPAN::Meta::Converter version 2.120921' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: Class-DBI-Plugin-Pager provides: Class::DBI::Plugin::Pager: file: lib/Class/DBI/Plugin/Pager.pm version: 0.566 Class::DBI::Plugin::Pager::LimitOffset: file: lib/Class/DBI/Plugin/Pager/LimitOffset.pm version: 0 Class::DBI::Plugin::Pager::LimitXY: file: lib/Class/DBI/Plugin/Pager/LimitXY.pm version: 0 Class::DBI::Plugin::Pager::LimitYX: file: lib/Class/DBI/Plugin/Pager/LimitYX.pm version: 0 Class::DBI::Plugin::Pager::RowsTo: file: lib/Class/DBI/Plugin/Pager/RowsTo.pm version: 0 requires: Carp: 0 Class::DBI: 0.9 Class::DBI::Plugin::AbstractCount: 0 Class::Data::Inheritable: 0 Data::Page: 2 SQL::Abstract: 1.61 Test::Exception: 0 Test::More: 0 Test::Warn: 0 UNIVERSAL::require: 0 resources: repository: git://github.com/majesticcpan/class-dbi-plugin-pager.git version: 0.566 Class-DBI-Plugin-Pager-0.566/Changes000444001750001750 442512025354610 20207 0ustar00pixelheadpixelhead000000000000Revision history for Class-DBI-Plugin-Pager 0.566 Sun September 16 16:45:00 2012 - code repository moved to github - pod changes 0.564 Mon August 16 13:36:00 2012 - fixed version issues 0.563 Mon August 16 03:54:00 2012 - maintainance release 0.562_01 Mon August 13 00:25:00 2012 - maintainance developer release. fixing test case that was broken because SQL::Abstract (patch from Ansgar Burchardt and Tim Retout) - SQL::Abstract 1.61 is now required - new co-maintainer Nikolay S. (~MAJESTIC) 0.561 Sun July 31 15:10:00 2005 - avoid bug in Class::DBI::Plugin::AbstractCount 0.04 which dies if a WHERE clause includes keys that are not columns (specifically, { 1 => 1 } ) (patch from Will Hawes) - unspecified WHERE clause defaults to {} (equivalent to { 1 => 1 }, i.e. retrieve all) - fixed warnings issued when less than a full set of positional arguments are supplied - reported by Ask Bjorn Hansen - new dependency on Test::Warn 0.56 Fri June 17 09:45:00 2005 - don't die, just warn (and don't install pager() method) in import() if can't find the CDBI class (Chia-liang Kao - making it safe for perl -MClass::DBI::Plugin::Pager which some system uses to check if a module can be loaded). 0.55 Sat Jan 15 00:50:00 2005 - fixed _setup_pager() to pass $self->abstract_attr in the count_search_where() call (reported by forehead) - added retrieve_all() method (requested by forehead) 0.54 Fri Jan 14 23:10:00 2005 - can now pass the where clause as an ARRAYREF when using positional arguments (reported by Gabor Szabo) 0.53 Fri Dec 17 22:25:00 2004 - caught up with changes in Data::Page v2 0.521 Fri Dec 10 17:00:00 2004 - fixed quoting bug in Build.PL (reported by Max Maischein) 0.52 Thu Dec 9 23:10:00 2004 - patch to accept order_by arguments in the same way as CDBI::AbstractSearch uses (Vince Veselosky) - reorganised test files a bit, added POD tests 0.51 Sat Oct 23 01:31:00 2004 - minor POD fixes, REALLY added LimitYX subclass 0.5 Sat Oct 23 01:31:00 2004 - minor POD fixes, added LimitYX subclass 0.4 Fri Oct 22 00:41:07 2004 - original version; created by h2xs 1.21 with options -XAn Class::DBI::Plugin::Pager Class-DBI-Plugin-Pager-0.566/Build.PL000444001750001750 201012025354610 20174 0ustar00pixelheadpixelhead000000000000use strict; use warnings; use Module::Build; my $builder = Module::Build->new( module_name => 'Class::DBI::Plugin::Pager', license => 'perl', dist_author => ['David Baird', 'Nikolay S. '], dist_version_from => 'lib/Class/DBI/Plugin/Pager.pm', meta_add => { resources => { repository => 'git://github.com/majesticcpan/class-dbi-plugin-pager.git', }, }, requires => { 'Test::More' => 0, 'Test::Exception' => 0, 'Test::Warn' => 0, 'Class::DBI' => 0.90, 'SQL::Abstract' => 1.61, 'Data::Page' => 2, 'Class::DBI::Plugin::AbstractCount' => 0, 'Class::Data::Inheritable' => 0, 'UNIVERSAL::require' => 0, Carp => 0, }, add_to_cleanup => [ 'Class-DBI-Plugin-Pager-*' ], create_makefile_pl => 'traditional', ); $builder->create_build_script; Class-DBI-Plugin-Pager-0.566/t000755001750001750 012025354610 17015 5ustar00pixelheadpixelhead000000000000Class-DBI-Plugin-Pager-0.566/t/00.load.t000444001750001750 24312025354610 20453 0ustar00pixelheadpixelhead000000000000use Test::More tests => 1; BEGIN { require_ok( 'Class::DBI::Plugin::Pager' ); } diag( "Testing Class::DBI::Plugin::Pager $Class::DBI::Plugin::Pager::VERSION" ); Class-DBI-Plugin-Pager-0.566/t/02.main.t000444001750001750 1356212025354610 20532 0ustar00pixelheadpixelhead000000000000#!/usr/bin/perl use strict; use warnings; use Test::More tests => 31; use Test::Exception; # use Data::Dumper::Simple; # this represents a single page of results my @dataset = qw( fee fi fo foo fum ); { package TestApp; use base 'Class::DBI'; use Class::DBI::Plugin::Pager; sub count_search_where { 27 } # the '@_' appends the class name, SQL and bind values passed in from # search_where_limitable sub retrieve_from_sql { @dataset, @_ } sub __driver { 'MySQL' } # LimitOffset syntax } my $where = { 'this' => 'that' }; my $order_by = [ 'fig' ]; my ( $pager, @results ); #lives_ok { ( $pager, @results ) = TestApp->search_where_paged( { this => 'that' }, # { order_by => 'fig' }, # scalar( @dataset ), # 3, # ) } 'survived search_where_paged'; # it's ugly - @results contains @dataset, 'TestApp', $phrase, @bind_values # because of TestApp::retrieve_from_sql overriding the real CDBI::retrieve_from_sql, # instead of being a list of CDBI objects lives_ok { ( $pager, @results ) = TestApp->pager->search_where( { this => 'that' }, { order_by => 'fig' }, scalar( @dataset ), 3, ) } 'survived search_where'; ok( @results > 0, 'got some results' ); is($results[-2], '( this = ? ) ORDER BY fig LIMIT 5 OFFSET 10', 'search_where results'); lives_ok { $pager = TestApp->pager } 'get pager - no args'; isa_ok( $pager, 'Data::Page', 'the pager' ); lives_ok { $pager->page( 3 ) } 'set page'; lives_ok { $pager->per_page( scalar( @dataset ) ) } 'set per_page'; lives_ok { $pager->where( $where ) } 'set where'; lives_ok { $pager->order_by( $order_by ) } 'set order_by'; lives_ok { @results = $pager->search_where } 'search_where'; is_deeply( \@results, [ @dataset, 'TestApp', '( this = ? ) ORDER BY fig LIMIT 5 OFFSET 10', 'that' ], 'LimitOffset results' ); is_deeply( [ $pager->current_page, $pager->total_entries, $pager->last_page, ], [ 3, 27, int( 27 / scalar( @dataset ) ) + 1 ], 'pager numbers' ); # ----------------------- my %conf = ( page => 3, per_page => scalar( @dataset ), where => $where, order_by => $order_by, syntax => 'RowsTo', ); lives_ok { $pager = TestApp->pager( %conf ) } 'pager - named args'; lives_ok { @results = $pager->search_where } 'search_where'; is_deeply( \@results, [ @dataset, 'TestApp', '( this = ? ) ORDER BY fig ROWS 10 TO 15', 'that' ], 'RowsTo results' ); $pager = TestApp->pager; $conf{syntax} = 'LimitXY'; lives_ok { @results = $pager->search_where( %conf ) } 'search_where - named args'; is_deeply( \@results, [ @dataset, 'TestApp', '( this = ? ) ORDER BY fig LIMIT 10, 5', 'that' ], 'LimitXY results' ); my @args = ( $where, $order_by, scalar( @dataset ), 3, 'RowsTo' ); lives_ok { $pager = TestApp->pager( @args ) } 'pager - positional args'; lives_ok { @results = $pager->search_where } 'search_where'; is_deeply( \@results, [ @dataset, 'TestApp', '( this = ? ) ORDER BY fig ROWS 10 TO 15', 'that' ], 'RowsTo results' ); # accepts arrayref 'where' clause - first with named args, then with positional $pager = undef; @results = (); $conf{ where } = [ age => {'<=', 80}, age => {'>=', 20}, city => 'Jerusalem', ]; $conf{ abstract_attr } = { logic => 'AND' }; lives_ok { $pager = TestApp->pager( %conf ) } 'new pager - arrayref where (named args)'; lives_ok { @results = $pager->search_where } 'search_where'; is_deeply( \@results, [ @dataset, 'TestApp', '( ( age <= ? AND age >= ? AND city = ? ) ) ORDER BY fig LIMIT 10, 5', '80', '20', 'Jerusalem', ], 'arrayref where (named args) results' ); $pager = undef; @results = (); # ok( @{ $conf{ where } }, 'where not eaten' ); $conf{ where } = [ age => {'<=', 80}, age => {'>=', 20}, city => 'Jerusalem', ]; $args[0] = $conf{ where }; # ok( @{ $args[0] }, 'where not eaten' ); lives_ok { $pager = TestApp->pager( $args[0], { logic => 'AND' }, @args[1..$#args] ) } 'new pager - arrayref where (positional args)'; lives_ok { @results = $pager->search_where } 'search_where'; is_deeply( \@results, [ @dataset, 'TestApp', '( ( age <= ? AND age >= ? AND city = ? ) ) ORDER BY fig ROWS 10 TO 15', '80', '20', 'Jerusalem', ], 'arrayref where (positional args) results' ); # retrieve_all $pager = undef; @results = (); @args = ( $order_by, scalar( @dataset ), 3, 'RowsTo' ); lives_ok { $pager = TestApp->pager } 'no args constructor'; lives_ok { @results = $pager->retrieve_all( @args ) } '@args passed to retrieve_all'; #is_deeply( \@results, [ @dataset, 'TestApp', '( 1 = ? ) ORDER BY fig ROWS 10 TO 15', '1' ], 'retrieve_all results' ); is_deeply( \@results, [ @dataset, 'TestApp', ' 1=1 ORDER BY fig ROWS 10 TO 15' ], 'retrieve_all results' ); $pager = TestApp->pager; $pager->order_by( $order_by ); $pager->per_page( scalar( @dataset ) ); $pager->page( 3 ); $pager->set_syntax( 'RowsTo' ); lives_ok { @results = $pager->retrieve_all } 'retrieve_all without args'; #is_deeply( \@results, [ @dataset, 'TestApp', '( 1 = ? ) ORDER BY fig ROWS 10 TO 15', '1' ], 'retrieve_all results' ); is_deeply( \@results, [ @dataset, 'TestApp', ' 1=1 ORDER BY fig ROWS 10 TO 15' ], 'retrieve_all results' ); #use YAML; #warn Dump( $pager ); Class-DBI-Plugin-Pager-0.566/t/03.subclass.t000444001750001750 512712025354610 21404 0ustar00pixelheadpixelhead000000000000#!/usr/bin/perl use strict; use warnings; use Test::More tests => 20; use Test::Exception; # this represents a single page of results my @dataset = qw( fee fi fo foo fum ); { package TestApp; use base 'Class::DBI'; use Class::DBI::Plugin::Pager::LimitXY; sub count_search_where { 27 } # the '@_' appends the class name, SQL and bind values passed in from # search_where_limitable sub retrieve_from_sql { @dataset, @_ } sub __driver { die 'TestApp->__driver should not be called if pager is a subclass' } } my $where = { this => 'that' }; my $order_by = [ 'fig' ]; my ( $pager, @results ); lives_ok { $pager = TestApp->pager } 'get pager - no args'; isa_ok( $pager, 'Data::Page', 'the pager' ); lives_ok { $pager->page( 3 ) } 'set page'; lives_ok { $pager->per_page( scalar( @dataset ) ) } 'set per_page'; lives_ok { $pager->where( $where ) } 'set where'; lives_ok { $pager->order_by( $order_by ) } 'set order_by'; lives_ok { @results = $pager->search_where } 'search_where'; is_deeply( \@results, [ @dataset, 'TestApp', '( this = ? ) ORDER BY fig LIMIT 10, 5', 'that' ], 'LimitXY results' ); is_deeply( [ $pager->current_page, $pager->total_entries, $pager->last_page, ], [ 3, 27, int( 27 / scalar( @dataset ) ) + 1 ], 'pager numbers' ); # ----------------------- my %conf = ( page => 3, per_page => scalar( @dataset ), where => $where, order_by => $order_by, ); lives_ok { $pager = TestApp->pager( %conf ) } 'pager - named args'; lives_ok { @results = $pager->search_where } 'search_where'; is_deeply( \@results, [ @dataset, 'TestApp', '( this = ? ) ORDER BY fig LIMIT 10, 5', 'that' ], 'LimitXY results' ); lives_ok { $pager = TestApp->pager( %conf, syntax => 'RowsTo' ) } 'pager - named args, switched RowsTo syntax'; lives_ok { @results = $pager->search_where } 'search_where'; is_deeply( \@results, [ @dataset, 'TestApp', '( this = ? ) ORDER BY fig ROWS 10 TO 15', 'that' ], 'RowsTo results' ); my @args = ( $where, $order_by, scalar( @dataset ), 3 ); lives_ok { $pager = TestApp->pager( @args ) } 'pager - positional args'; lives_ok { @results = $pager->search_where } 'search_where'; is_deeply( \@results, [ @dataset, 'TestApp', '( this = ? ) ORDER BY fig ROWS 10 TO 15', 'that' ], 'LimitXY results' ); $pager = TestApp->pager; lives_ok { @results = $pager->search_where( @args ) } 'search_where - positional args'; is_deeply( \@results, [ @dataset, 'TestApp', '( this = ? ) ORDER BY fig ROWS 10 TO 15', 'that' ], 'LimitXY results' ); #use YAML; #warn Dump( $pager ); Class-DBI-Plugin-Pager-0.566/t/pod-coverage.t000444001750001750 35612025354610 21676 0ustar00pixelheadpixelhead000000000000#!perl -T use Test::More; eval "use Test::Pod::Coverage 1.04"; plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@; #all_pod_coverage_ok(); plan tests => 1; pod_coverage_ok( 'Class::DBI::Plugin::Pager' ); Class-DBI-Plugin-Pager-0.566/t/pod.t000444001750001750 21412025354610 20076 0ustar00pixelheadpixelhead000000000000#!perl -T use Test::More; eval "use Test::Pod 1.14"; plan skip_all => "Test::Pod 1.14 required for testing POD" if $@; all_pod_files_ok(); Class-DBI-Plugin-Pager-0.566/t/04.auto_syntax.t000444001750001750 163312025354610 22142 0ustar00pixelheadpixelhead000000000000#!/usr/bin/perl use strict; use warnings; use Test::More tests => 1; use Test::Exception; # this represents a single page of results my @dataset = qw( fee fi fo foo fum ); { package TestApp; use base 'Class::DBI'; use Class::DBI::Plugin::Pager; sub count_search_where { 27 } # the '@_' appends the class name, SQL and bind values passed in from # search_where_limitable sub retrieve_from_sql { @dataset, @_ } sub __driver { 'InterBase' } # RowsTo syntax } my $where = { this => 'that' }; my $order_by = [ 'fig' ]; my $per_page = scalar( @dataset ); my $page = 3; my $pager = TestApp->pager; my @results = $pager->search_where( $where, $order_by, $per_page, $page ); is_deeply( [ @results ], [ @dataset, 'TestApp', '( this = ? ) ORDER BY fig ROWS 10 TO 15', 'that' ], 'expected results for RowsTo' ); #use YAML; #warn Dump( $pager ); Class-DBI-Plugin-Pager-0.566/t/01.load_subclass.t000444001750001750 25312025354610 22354 0ustar00pixelheadpixelhead000000000000#!/usr/bin/perl package TestApp; use base 'Class::DBI'; use strict; use warnings; use Test::More tests => 1; use_ok ( 'Class::DBI::Plugin::Pager::LimitOffset' ); Class-DBI-Plugin-Pager-0.566/lib000755001750001750 012025354610 17320 5ustar00pixelheadpixelhead000000000000Class-DBI-Plugin-Pager-0.566/lib/Class000755001750001750 012025354610 20365 5ustar00pixelheadpixelhead000000000000Class-DBI-Plugin-Pager-0.566/lib/Class/DBI000755001750001750 012025354610 20763 5ustar00pixelheadpixelhead000000000000Class-DBI-Plugin-Pager-0.566/lib/Class/DBI/Plugin000755001750001750 012025354610 22221 5ustar00pixelheadpixelhead000000000000Class-DBI-Plugin-Pager-0.566/lib/Class/DBI/Plugin/Pager.pm000555001750001750 4315612025354610 24006 0ustar00pixelheadpixelhead000000000000package Class::DBI::Plugin::Pager; use strict; use warnings; use Carp; use UNIVERSAL::require; use SQL::Abstract; use base qw( Data::Page Class::Data::Inheritable ); use vars qw( $VERSION ); $VERSION = '0.566'; # D::P inherits from Class::Accessor::Chained::Fast __PACKAGE__->mk_accessors( qw( where abstract_attr per_page page order_by _cdbi_app ) ); __PACKAGE__->mk_classdata( '_syntax' ); __PACKAGE__->mk_classdata( '_pager_class' ); =head1 NAME Class::DBI::Plugin::Pager - paged queries for CDBI =head1 DESCRIPTION Adds a pager method to your class that can query using SQL::Abstract where clauses, and limit the number of rows returned to a specific subset. =head1 SYNOPSIS package CD; use base 'Class::DBI'; use Class::DBI::Plugin::AbstractCount; # pager needs this use Class::DBI::Plugin::Pager; # or to use a different syntax # use Class::DBI::Plugin::Pager::RowsTo; __PACKAGE__->set_db(...); # in a nearby piece of code... use CD; # see SQL::Abstract for how to specify the query my $where = { ... }; my $order_by => [ qw( foo bar ) ]; # bit by bit: my $pager = CD->pager; $pager->per_page( 10 ); $pager->page( 3 ); $pager->where( $where ); $pager->order_by( $order_by ); $pager->set_syntax( 'RowsTo' ); my @cds = $pager->search_where; # or all at once my $pager = CD->pager( $where, $order_by, 10, 3 ); my @cds = $pager->search_where; # or my $pager = CD->pager; my @cds = $pager->search_where( $where, $order_by, 10, 3 ); # $pager isa Data::Page # @cds contains the CDs just for the current page =head1 METHODS =over =item import Loads the C method into the CDBI app. =cut sub import { my ( $class ) = @_; # the pager class or subclass __PACKAGE__->_pager_class( $class ); my $caller; # find the app - supports subclassing (My::Pager is_a CDBI::P::Pager, not_a CDBI) foreach my $level ( 0 .. 10 ) { $caller = caller( $level ); last if UNIVERSAL::isa( $caller, 'Class::DBI' ) } warn( "can't find the CDBI app" ), return unless $caller; #croak( "can't find the CDBI app" ) unless $caller; no strict 'refs'; *{"$caller\::pager"} = \&pager; } =item pager( [$where, [$abstract_attr]], [$order_by], [$per_page], [$page], [$syntax] ) Also accepts named arguments: where => $where, abstract_attr => $attr, order_by => $order_by, per_page => $per_page, page => $page, syntax => $syntax Returns a pager object. This subclasses L. Note that for positional arguments, C<$abstract_attr> can only be passed if preceded by a C<$where> argument. C<$abstract_attr> can contain the C<$order_by> setting (just as in L). =over 4 =item configuration The named arguments all exist as get/set methods. =over 4 =item where A hashref specifying the query. See L. =item abstract_attr A hashref specifying extra options to be passed through to the L constructor. =item order_by Single column name or arrayref of column names for the ORDER BY clause. Defaults to the primary key(s) if not set. =item per_page Number of results per page. =item page The pager will retrieve results just for this page. Defaults to 1. =item syntax Change the way the 'limit' clause is constructed. See C. Default is C. =back =back =cut sub pager { my $cdbi = shift; my $class = __PACKAGE__->_pager_class; my $self = bless {}, $class; $self->_cdbi_app( $cdbi ); # This has to come before _init, so the caller can choose to set the syntax # instead. But don't auto-set if we're a subclass. $self->auto_set_syntax if $class eq __PACKAGE__; $self->_init( @_ ); return $self; } # _init is also called by results, so preserve any existing settings if # new settings are not provided sub _init { my $self = shift; return unless @_; my ( $where, $abstract_attr, $order_by, $per_page, $page, $syntax ); if ( ref( $_[0] ) or $_[0] =~ /^\d+$/ ) { $where = shift if ref $_[0]; # SQL::Abstract accepts a hashref or an arrayref $abstract_attr = shift if ref $_[0] eq 'HASH'; # $order_by = shift unless $_[0] =~ /^\d+$/; # $per_page = shift if $_[0] =~ /^\d+$/; # $page = shift if $_[0] =~ /^\d+$/; $order_by = shift unless $_[0] and $_[0] =~ /^\d+$/; $per_page = shift if $_[0] and $_[0] =~ /^\d+$/; $page = shift if $_[0] and $_[0] =~ /^\d+$/; $syntax = shift; } else { my %args = @_; $where = $args{where}; $abstract_attr = $args{abstract_attr}; $order_by = $args{order_by}; $per_page = $args{per_page}; $page = $args{page}; $syntax = $args{syntax}; } # Emulate AbstractSearch's search_where ordering -VV 20041209 $order_by = delete $$abstract_attr{order_by} if ($abstract_attr and !$order_by); $self->per_page( $per_page ) if $per_page; $self->set_syntax( $syntax ) if $syntax; $self->abstract_attr( $abstract_attr )if $abstract_attr; $self->where( $where ) if $where; $self->order_by( $order_by ) if $order_by; $self->page( $page ) if $page; } =item search_where Retrieves results from the pager. Accepts the same arguments as the C method. =cut # like CDBI::AbstractSearch::search_where, with extra limitations sub search_where { my $self = shift; $self->_init( @_ ); $self->_setup_pager; my $cdbi = $self->_cdbi_app; my $order_by = $self->order_by || [ $cdbi->primary_columns ]; my $where = $self->where; my $syntax = $self->_syntax || $self->set_syntax; my $limit_phrase = $self->$syntax; my $sql = SQL::Abstract->new( %{ $self->abstract_attr || {} } ); $order_by = [ $order_by ] unless ref $order_by; my ( $phrase, @bind ) = $sql->where( $where, $order_by ); # If the phrase starts with the ORDER clause (i.e. no WHERE spec), then we are # emulating a { 1 => 1 } search, but avoiding the bug in Class::DBI::Plugin::AbstractCount 0.04, # so we need to replace the spec - patch from Will Hawes if ( $phrase =~ /^\s*ORDER\s*/i ) { $phrase = ' 1=1' . $phrase; } $phrase .= ' ' . $limit_phrase; $phrase =~ s/^\s*WHERE\s*//i; return $cdbi->retrieve_from_sql( $phrase, @bind ); } =item retrieve_all Convenience method, generates a WHERE clause that matches all rows from the table. Accepts the same arguments as the C or C methods, except that no WHERE clause should be specified. Note that the argument parsing routine called by the C method cannot cope with positional arguments that lack a WHERE clause, so either use named arguments, or the 'bit by bit' approach, or pass the arguments directly to C. =cut sub retrieve_all { my $self = shift; my $get_all = {}; # { 1 => 1 }; unless ( @_ ) { # already set pager up via method calls $self->where( $get_all ); return $self->search_where; } my @args = ( ref( $_[0] ) or $_[0] =~ /^\d+$/ ) ? ( $get_all, @_ ) : # send an array ( where => $get_all, @_ ); # send a hash return $self->search_where( @args ); } sub _setup_pager { my ( $self ) = @_; my $where = $self->where || {}; # fix { 1 => 1 } as a special case - Class::DBI::Plugin::AbstractCount 0.04 has a bug in # its column-checking code if ( ref( $where ) eq 'HASH' and $where->{1} ) { $where = {}; $self->where( {} ); } my $per_page = $self->per_page || croak( 'no. of entries per page not specified' ); my $cdbi = $self->_cdbi_app; my $count = $cdbi->count_search_where( $where, $self->abstract_attr ); my $page = $self->page || 1; $self->total_entries( $count ); $self->entries_per_page( $per_page ); $self->current_page( $page ); croak( 'Fewer than one entry per page!' ) if $self->entries_per_page < 1; $self->current_page( $self->first_page ) unless defined $self->current_page; $self->current_page( $self->first_page ) if $self->current_page < $self->first_page; $self->current_page( $self->last_page ) if $self->current_page > $self->last_page; } # SQL::Abstract::_recurse_where eats the WHERE clause #sub where { # my ( $self, $where_ref ) = @_; # # return $self->_where unless $where_ref; # # my $where_copy; # # if ( ref( $where_ref ) eq 'HASH' ) { # $where_copy = { %$where_ref }; # } # elsif ( ref( $where_ref ) eq 'ARRAY' ) # { # $where_copy = [ @$where_ref ]; # } # else # { # die "WHERE clause [$where_ref] must be specified as an ARRAYREF or HASHREF"; # } # # # this will get eaten, but the caller's value is now protected # $self->_where( $where_copy ); #} =item set_syntax( [ $name || $class || $coderef ] ) Changes the syntax used to generate the C or other phrase that restricts the results set to the required page. The syntax is implemented as a method called on the pager, which can be queried to provide the C<$rows> and C<$offset> parameters (see the subclasses included in this distribution). =over 4 =item $class A class with a C method. =item $name Name of a class in the C namespace, which has a C method. =item $coderef Will be called as a method on the pager object, so receives the pager as its argument. =item (no args) Called without args, will default to C, which causes L to be used. =back =cut sub set_syntax { my ( $proto, $syntax ) = @_; # pick up default from subclass, or load from LimitOffset $syntax ||= $proto->can( 'make_limit' ); $syntax ||= 'LimitOffset'; if ( ref( $syntax ) eq 'CODE' ) { $proto->_syntax( $syntax ); return $syntax; } my $format_class = $syntax =~ '::' ? $syntax : "Class::DBI::Plugin::Pager::$syntax"; $format_class->require || croak "error loading $format_class: $UNIVERSAL::require::ERROR"; my $formatter = $format_class->can( 'make_limit' ) || croak "no make_limit method in $format_class"; $proto->_syntax( $formatter ); return $formatter; } =item auto_set_syntax This is called automatically when you call C, and attempts to set the syntax automatically. If you are using a subclass of the pager, this method will not be called. Will C if using Oracle or DB2, since there is no simple syntax for limiting the results set. DB2 has a C keyword, but that seems to apply to a cursor and I don't know if there is a cursor available to the pager. There should probably be others to add to the unsupported list. Supports the following drivers: DRIVER CDBI::P::Pager subclass my %supported = ( pg => 'LimitOffset', mysql => 'LimitOffset', # older versions need LimitXY sqlite => 'LimitOffset', # or LimitYX sqlite2 => 'LimitOffset', # or LimitYX interbase => 'RowsTo', firebird => 'RowsTo', ); Older versions of MySQL should use the LimitXY syntax. You'll need to set it manually, either by C, or by passing C 'LimitXY'> to a method call, or call C directly. Any driver not in the supported or unsupported lists defaults to LimitOffset. Any additions to the supported and unsupported lists gratefully received. =cut sub auto_set_syntax { my ( $self ) = @_; # not an exhaustive list my %not_supported = ( oracle => 'Oracle', db2 => 'DB2', ); # additions welcome my %supported = ( pg => 'LimitOffset', mysql => 'LimitOffset', # older versions need LimitXY sqlite => 'LimitOffset', # or LimitYX sqlite2 => 'LimitOffset', # or LimitYX interbase => 'RowsTo', firebird => 'RowsTo', ); my $cdbi = $self->_cdbi_app; my $driver = lc( $cdbi->__driver ); die __PACKAGE__ . " can't build limit clauses for $not_supported{ $driver }" if $not_supported{ $driver }; #warn sprintf "Setting syntax to %s for $driver", $supported{ $driver } || 'LimitOffset'; $self->set_syntax( $supported{ $driver } || 'LimitOffset' ); } 1; __END__ #=for notes # #Would this work? # #with $limit and $offset defined. # #my $last = $limit + $offset # #my $order_by_str = join( ', ', @$order_by ) # #$cdbi->set_sql( emulate_limit => <<''); # SELECT * FROM ( # SELECT TOP $limit * FROM ( # SELECT TOP $last __ESSENTIAL__ # FROM __TABLE__ # ORDER BY $order_by_str ASC # ) AS foo ORDER BY $order_by_str DESC # ) AS bar ORDER BY $order_by_str ASC # # #e.g. MS Access (thanks Emanuele Zeppieri) # #to add LIMIT/OFFSET to this query: # #SELECT my_column #FROM my_table #ORDER BY my_column ASC # #say with the values LIMIT=5 OFFSET=10, you have to resort to the TOP #clause and re-write it this way: # #SELECT * FROM ( # SELECT TOP 5 * FROM ( # SELECT TOP 15 my_column # FROM my_table # ORDER BY my_column ASC # ) AS foo ORDER BY my_column DESC #) AS bar ORDER BY my_column ASC # #=cut =back =head2 SUBCLASSING The 'limit' syntax can be set by using a subclass, e.g. use Class::DBI::Plugin::Pager::RowsTo; instead of setting at runtime. A subclass looks like this: package Class::DBI::Plugin::Pager::RowsTo; use base 'Class::DBI::Plugin::Pager'; sub make_limit { my ( $self ) = @_; my $offset = $self->skipped; my $rows = $self->entries_per_page; my $last = $rows + $offset; return "ROWS $offset TO $last"; } 1; You can omit the C and switch syntax by calling C<$pager-Eset_syntax( 'RowsTo' )>. Or you can leave in the C and still say C<$pager-Eset_syntax( 'RowsTo' )>, because in this case the class is Cd and the C in the base class doesn't get called. Or something. At any rate, It Works. The subclasses implement the following LIMIT syntaxes: =over =item Class::DBI::Plugin::Pager::LimitOffset LIMIT $rows OFFSET $offset This is the default if your driver is not in the list of known drivers. This should work for PostgreSQL, more recent MySQL, SQLite, and maybe some others. =item Class::DBI::Plugin::LimitXY LIMIT $offset, $rows Older versions of MySQL. =item Class::DBI::Plugin::LimitYX LIMIT $rows, $offset SQLite. =item Class::DBI::Plugin::RowsTo ROWS $offset TO $offset + $rows InterBase, also FireBird, maybe others? =back =head1 TODO I've only used this on an older version of MySQL. Reports of this thing working (or not) elsewhere would be useful. It should be possible to use C to build the complex queries required by some databases to emulate LIMIT (see notes in source). =head1 CAVEATS This class can't implement the subselect mechanism required by some databases to emulate the LIMIT phrase, because it only has access to the WHERE clause, not the whole SQL statement. At the moment. Each query issues two requests to the database - the first to count the entire result set, the second to retrieve the required subset of results. If your tables are small it may be quicker to use L. The C clause means the database has to retrieve (internally) and sort the entire results set, before chopping out the requested subset. It's probably a good idea to have an index on the column(s) used to order the results. For huge tables, this approach to paging may be too inefficient. =head1 SOURCE CODE The source code for this module is hosted on GitHub L. Feel free to fork the repository and submit pull requests! =head1 DEPENDENCIES L, L, L, L, L, L. =head1 SEE ALSO L does a similar job, but retrieves the entire results set into memory before chopping out the page you want. =head1 BUGS Please report all bugs via the CPAN Request Tracker at L. =head1 COPYRIGHT AND LICENSE Copyright 2004-2012 by David Baird. Copyright 2012 Nikolay S. C This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 AUTHOR David Baird Class-DBI-Plugin-Pager-0.566/lib/Class/DBI/Plugin/Pager000755001750001750 012025354610 23257 5ustar00pixelheadpixelhead000000000000Class-DBI-Plugin-Pager-0.566/lib/Class/DBI/Plugin/Pager/RowsTo.pm000444001750001750 50112025354610 25163 0ustar00pixelheadpixelhead000000000000package Class::DBI::Plugin::Pager::RowsTo; use strict; use warnings; use base 'Class::DBI::Plugin::Pager'; sub make_limit { my ( $self ) = @_; my $offset = $self->skipped; my $rows = $self->entries_per_page; my $last = $rows + $offset; return "ROWS $offset TO $last"; } 1; Class-DBI-Plugin-Pager-0.566/lib/Class/DBI/Plugin/Pager/LimitXY.pm000444001750001750 43412025354610 25272 0ustar00pixelheadpixelhead000000000000package Class::DBI::Plugin::Pager::LimitXY; use strict; use warnings; use base 'Class::DBI::Plugin::Pager'; sub make_limit { my ( $self ) = @_; my $offset = $self->skipped; my $rows = $self->entries_per_page; return "LIMIT $offset, $rows"; } 1; Class-DBI-Plugin-Pager-0.566/lib/Class/DBI/Plugin/Pager/LimitYX.pm000444001750001750 51412025354610 25271 0ustar00pixelheadpixelhead000000000000package Class::DBI::Plugin::Pager::LimitYX; use strict; use warnings; use base 'Class::DBI::Plugin::Pager'; sub make_limit { my ( $self ) = @_; my $offset = $self->skipped; my $rows = $self->entries_per_page; # SQLite (but it can also use LimitOffset) return "LIMIT $rows, $offset"; } 1; Class-DBI-Plugin-Pager-0.566/lib/Class/DBI/Plugin/Pager/LimitOffset.pm000444001750001750 45012025354610 26156 0ustar00pixelheadpixelhead000000000000package Class::DBI::Plugin::Pager::LimitOffset; use strict; use warnings; use base 'Class::DBI::Plugin::Pager'; sub make_limit { my ( $self ) = @_; my $offset = $self->skipped; my $rows = $self->entries_per_page; return "LIMIT $rows OFFSET $offset"; } 1;