FS/FS/Cursor.pm

   1 package FS::Cursor;
   2
   3 use strict;
   4 use vars qw($DEBUG $buffer);
   5 use FS::Record qw(dbh);
   6 use Scalar::Util qw(refaddr);
   7
   8 $DEBUG = 0;
   9
  10 # this might become a parameter at some point, but right now, you can
  11 # "local $FS::Cursor::buffer = X;"
  12 $buffer = 200;
  13
  14 =head1 NAME
  15
  16 FS::Cursor - Iterator for querying large data sets
  17
  18 =head1 SYNOPSIS
  19
  20 use FS::Cursor;
  21
  22 my $search = FS::Cursor->new('table', { field => 'value' ... });
  23 while ( my $row = $search->fetch ) {
  24 ...
  25 }
  26
  27 =head1 CLASS METHODS
  28
  29 =over 4
  30
  31 =item new ARGUMENTS
  32
  33 Constructs a cursored search.  Accepts all the same arguments as qsearch,
  34 and returns an FS::Cursor object to fetch the rows one at a time.
  35
  36 =cut
  37
  38 sub new {
  39   my $class = shift;
  40   my $q = FS::Record::_query(@_); # builds the statement and parameter list
  41
  42   my $self = {
  43     query => $q,
  44     class => 'FS::' . ($q->{table} || 'Record'),
  45     buffer => [],
  46   };
  47   bless $self, $class;
  48
  49   # the class of record object to return
  50   $self->{class} = "FS::".($q->{table} || 'Record');
  51
  52   $self->{id} = sprintf('cursor%08x', refaddr($self));
  53   my $statement = "DECLARE ".$self->{id}." CURSOR FOR ".$q->{statement};
  54
  55   my $sth = dbh->prepare($statement)
  56     or die dbh->errstr;
  57   my $bind = 0;
  58   foreach my $value ( @{ $q->{value} } ) {
  59     my $bind_type = shift @{ $q->{bind_type} };
  60     $sth->bind_param($bind++, $value, $bind_type );
  61   }
  62
  63   $sth->execute or die $sth->errstr;
  64
  65   $self->{fetch} = dbh->prepare("FETCH FORWARD $buffer FROM ".$self->{id});
  66
  67   $self;
  68 }
  69
  70 =back
  71
  72 =head1 METHODS
  73
  74 =over 4
  75
  76 =item fetch
  77
  78 Fetch the next row from the search results.
  79
  80 =cut
  81
  82 sub fetch {
  83   # might be a little more efficient to do a FETCH NEXT 1000 or something
  84   # and buffer them locally, but the semantics are simpler this way
  85   my $self = shift;
  86   if (@{ $self->{buffer} } == 0) {
  87     my $rows = $self->refill;
  88     return undef if !$rows;
  89   }
  90   $self->{class}->new(shift @{ $self->{buffer} });
  91 }
  92
  93 sub refill {
  94   my $self = shift;
  95   my $sth = $self->{fetch};
  96   $sth->execute or die $sth->errstr;
  97   my $result = $self->{fetch}->fetchall_arrayref( {} );
  98   $self->{buffer} = $result;
  99   scalar @$result;
 100 }
 101
 102 sub DESTROY {
 103   my $self = shift;
 104   dbh->do('CLOSE '. $self->{id}) or die dbh->errstr; # clean-up the cursor in Pg
 105 }
 106
 107 =back
 108
 109 =head1 TO DO
 110
 111 Replace all uses of qsearch with this.
 112
 113 =head1 BUGS
 114
 115 Doesn't support MySQL.
 116
 117 =head1 SEE ALSO
 118
 119 L<FS::Record>
 120
 121 =cut
 122
 123 1;