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