add package details to invoice when using agent wholesale bulk billing, RT#28456
[freeside.git] / 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;