FS/FS/PagedSearch.pm

   1 package FS::PagedSearch;
   2
   3 use strict;
   4 use vars qw($DEBUG $default_limit @EXPORT_OK);
   5 use base qw( Exporter );
   6 use FS::Record qw(qsearch dbdef);
   7 use Data::Dumper;
   8
   9 $DEBUG = 0;
  10 $default_limit = 100;
  11
  12 @EXPORT_OK = 'psearch';
  13
  14 =head1 NAME
  15
  16 FS::PagedSearch - Iterator for querying large data sets
  17
  18 =head1 SYNOPSIS
  19
  20 use FS::PagedSearch qw(psearch);
  21
  22 my $search = psearch('table', { field => 'value' ... });
  23 $search->limit(100); #optional
  24 while ( my $row = $search->fetch ) {
  25 ...
  26 }
  27
  28 =head1 SUBROUTINES
  29
  30 =over 4
  31
  32 =item psearch ARGUMENTS
  33
  34 A wrapper around L<FS::Record::qsearch>.  Accepts all the same arguments
  35 as qsearch, except for the arrayref union query mode, and returns an
  36 FS::PagedSearch object to access the rows of the query one at a time.
  37 If the query doesn't contain an ORDER BY clause already, it will be ordered
  38 by the table's primary key.
  39
  40 =cut
  41
  42 sub psearch {
  43   # deep-copy qsearch args
  44   my $q;
  45   if ( ref($_[0]) eq 'ARRAY' ) {
  46     die "union query not supported with psearch"; #yet
  47   }
  48   elsif ( ref($_[0]) eq 'HASH' ) {
  49     %$q = %{ $_[0] };
  50   }
  51   else {
  52     $q = {
  53       'table'     => shift,
  54       'hashref'   => shift,
  55       'select'    => shift,
  56       'extra_sql' => shift,
  57       'cache_obj' => shift,
  58       'addl_from' => shift,
  59     };
  60   }
  61   warn Dumper($q) if $DEBUG > 1;
  62
  63   # clean up query
  64   my $dbdef = dbdef->table($q->{table});
  65   # qsearch just appends order_by to extra_sql, so do that ourselves
  66   $q->{extra_sql} ||= '';
  67   $q->{extra_sql} .= ' '.$q->{order_by} if $q->{order_by};
  68   $q->{order_by} = '';
  69   # and impose an ordering if needed
  70   if ( not $q->{extra_sql} =~ /order by/i ) {
  71     $q->{extra_sql} .= ' ORDER BY '.$dbdef->primary_key;
  72   }
  73   # and then we'll use order_by for LIMIT/OFFSET
  74
  75   my $self = {
  76     query     => $q,
  77     buffer    => [],
  78     offset    => 0,
  79     limit     => $default_limit,
  80     increment => 1,
  81   };
  82   bless $self, 'FS::PagedSearch';
  83
  84   $self;
  85 }
  86
  87 =back
  88
  89 =head1 METHODS
  90
  91 =over 4
  92
  93 =item fetch
  94
  95 Fetch the next row from the search results and remove it from the buffer.
  96 Returns undef if there are no more rows.
  97
  98 =cut
  99
 100 sub fetch {
 101   my $self = shift;
 102   my $b = $self->{buffer};
 103   $self->refill if @$b == 0;
 104   $self->{offset} += $self->{increment} if @$b;
 105   return shift @$b;
 106 }
 107
 108 =item adjust ROWS
 109
 110 Add ROWS to the offset counter.  This won't cause rows to be skipped in the
 111 current buffer but will affect the starting point of the next refill.
 112
 113 =cut
 114
 115 sub adjust {
 116   my $self = shift;
 117   my $r = shift;
 118   $self->{offset} += $r;
 119 }
 120
 121 =item limit [ VALUE ]
 122
 123 Set/get the number of rows to retrieve per page.  The default is 100.
 124
 125 =cut
 126
 127 sub limit {
 128   my $self = shift;
 129   my $new_limit = shift;
 130   if ( defined($new_limit) ) {
 131     $self->{limit} = $new_limit;
 132   }
 133   $self->{limit};
 134 }
 135
 136 =item increment [ VALUE ]
 137
 138 Set/get the number of rows to increment the offset for each row that's
 139 retrieved.  Defaults to 1.  If the rows are being modified in a way that
 140 removes them from the result set of the query, it's probably wise to set
 141 this to zero.  Setting it to anything else is probably nonsense.
 142
 143 =cut
 144
 145 sub increment {
 146   my $self = shift;
 147   my $new_inc = shift;
 148   if ( defined($new_inc) ) {
 149     $self->{increment} = $new_inc;
 150   }
 151   $self->{increment};
 152 }
 153
 154
 155 =item refill
 156
 157 Run the query, skipping a number of rows set by the row offset, and replace
 158 the contents of the buffer with the result.  If there are no more rows,
 159 this will just empty the buffer.  Called automatically as needed; don't call
 160 this from outside.
 161
 162 =cut
 163
 164 sub refill {
 165   my $self = shift;
 166   my $b = $self->{buffer};
 167   warn "refilling (limit ".$self->{limit}.", offset ".$self->{offset}.")\n"
 168     if $DEBUG;
 169   warn "discarding ".scalar(@$b)." rows\n" if $DEBUG and @$b;
 170   if ( $self->{limit} > 0 ) {
 171     $self->{query}->{order_by} = 'LIMIT ' . $self->{limit} .
 172                                  ' OFFSET ' . $self->{offset};
 173   }
 174   @$b = qsearch( $self->{query} );
 175   my $rows = scalar @$b;
 176   warn "$rows returned\n" if $DEBUG;
 177
 178   $rows;
 179 }
 180
 181 =back
 182
 183 =head1 SEE ALSO
 184
 185 L<FS::Record>
 186
 187 L<FS::Cursor> is an eventual replacement for this.
 188
 189 =cut
 190
 191 1;