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   # save for later, so forked children will not destroy me when they exit
  53   $self->{pid} = $$;
  54
  55   $self->{id} = sprintf('cursor%08x', refaddr($self));
  56   my $statement = "DECLARE ".$self->{id}." CURSOR FOR ".$q->{statement};
  57
  58   my $sth = dbh->prepare($statement)
  59     or die dbh->errstr;
  60   my $bind = 1;
  61   foreach my $value ( @{ $q->{value} } ) {
  62     my $bind_type = shift @{ $q->{bind_type} };
  63     $sth->bind_param($bind++, $value, $bind_type );
  64   }
  65
  66   $sth->execute or die $sth->errstr;
  67
  68   $self->{fetch} = dbh->prepare("FETCH FORWARD $buffer FROM ".$self->{id});
  69
  70   $self;
  71 }
  72
  73 =back
  74
  75 =head1 METHODS
  76
  77 =over 4
  78
  79 =item fetch
  80
  81 Fetch the next row from the search results.
  82
  83 =cut
  84
  85 sub fetch {
  86   # might be a little more efficient to do a FETCH NEXT 1000 or something
  87   # and buffer them locally, but the semantics are simpler this way
  88   my $self = shift;
  89   if (@{ $self->{buffer} } == 0) {
  90     my $rows = $self->refill;
  91     return undef if !$rows;
  92   }
  93   $self->{class}->new(shift @{ $self->{buffer} });
  94 }
  95
  96 sub refill {
  97   my $self = shift;
  98   my $sth = $self->{fetch};
  99   $sth->execute or die $sth->errstr;
 100   my $result = $self->{fetch}->fetchall_arrayref( {} );
 101   $self->{buffer} = $result;
 102   scalar @$result;
 103 }
 104
 105 sub DESTROY {
 106   my $self = shift;
 107   return unless $self->{pid} eq $$;
 108   dbh->do('CLOSE '. $self->{id}) or die dbh->errstr; # clean-up the cursor in Pg
 109 }
 110
 111 sub DESTROY {
 112   my $self = shift;
 113   my $statement = "CLOSE ".$self->{id};
 114   dbh->do($statement);
 115 }
 116
 117 =back
 118
 119 =head1 TO DO
 120
 121 Replace all uses of qsearch with this.
 122
 123 =head1 BUGS
 124
 125 Doesn't support MySQL.
 126
 127 The cursor will close prematurely if any code issues a rollback/commit. If
 128 you need protection against this use qsearch or fork and get a new dbh
 129 handle.
 130 Normally this issue will represent itself this message.
 131 ERROR: cursor "cursorXXXXXXX" does not exist.
 132
 133 =head1 SEE ALSO
 134
 135 L<FS::Record>
 136
 137 =cut
 138
 139 1;