FS/FS/Cursor.pm

   1 package FS::Cursor;
   2
   3 use strict;
   4 use vars qw($DEBUG $buffer);
   5 use base qw( Exporter );
   6 use FS::Record qw(qsearch dbdef dbh);
   7 use Data::Dumper;
   8 use Scalar::Util qw(refaddr);
   9
  10 $DEBUG = 0;
  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
  43   my $self = {
  44     query => $q,
  45     class => 'FS::' . ($q->{table} || 'Record'),
  46     buffer => [],
  47   };
  48   bless $self, $class;
  49
  50   # the class of record object to return
  51   $self->{class} = "FS::".($q->{table} || 'Record');
  52
  53   $self->{id} = sprintf('cursor%08x', refaddr($self));
  54   my $statement = "DECLARE ".$self->{id}." CURSOR FOR ".$q->{statement};
  55
  56   my $dbh = dbh;
  57   my $sth = $dbh->prepare($statement)
  58     or die $dbh->errstr;
  59   my $bind = 0;
  60   foreach my $value ( @{ $q->{value} } ) {
  61     my $bind_type = shift @{ $q->{bind_type} };
  62     $sth->bind_param($bind++, $value, $bind_type );
  63   }
  64
  65   $sth->execute or die $sth->errstr;
  66
  67   $self->{fetch} = $dbh->prepare("FETCH FORWARD $buffer FROM ".$self->{id});
  68
  69   $self;
  70 }
  71
  72 =back
  73
  74 =head1 METHODS
  75
  76 =over 4
  77
  78 =item fetch
  79
  80 Fetch the next row from the search results.
  81
  82 =cut
  83
  84 sub fetch {
  85   # might be a little more efficient to do a FETCH NEXT 1000 or something
  86   # and buffer them locally, but the semantics are simpler this way
  87   my $self = shift;
  88   if (@{ $self->{buffer} } == 0) {
  89     my $rows = $self->refill;
  90     return undef if !$rows;
  91   }
  92   $self->{class}->new(shift @{ $self->{buffer} });
  93 }
  94
  95 sub refill {
  96   my $self = shift;
  97   my $sth = $self->{fetch};
  98   $sth->execute or die $sth->errstr;
  99   my $result = $self->{fetch}->fetchall_arrayref( {} );
 100   $self->{buffer} = $result;
 101   scalar @$result;
 102 }
 103
 104 =back
 105
 106 =head1 TO DO
 107
 108 Replace all uses of qsearch with this.
 109
 110 =head1 BUGS
 111
 112 Doesn't support MySQL.
 113
 114 =head1 SEE ALSO
 115
 116 L<FS::Record>
 117
 118 =cut
 119
 120 1;