FS/FS/Cursor.pm

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