view release on metacpan or  search on metacpan

lib/DBR/ResultSet.pm  view on Meta::CPAN

package DBR::ResultSet;

use strict;
use base 'DBR::Common';

use DBR::Misc::Dummy;
use Carp;
use Scalar::Util 'weaken';
use constant ({
	       f_next      => 0,
	       f_state     => 1,
	       f_rowcache  => 2,
	       f_query     => 3,
	       f_count     => 4,
	       f_splitval  => 5,

	       stCLEAN  => 1,
	       stACTIVE => 2,
	       stMEM    => 3,

	       FIRST  => \&_first,
	       DUMMY  => bless([],'DBR::Misc::Dummy'),
	      });


sub new {
      my ( $package, $query, $splitval ) = @_;

      #the sequence of this MUST line up with the fields above
      return bless( [
		     FIRST,    # next
		     stCLEAN,  # state
		     [],     # rowcache - placeholder
		     $query,   # query
		     undef,    # count
		     $splitval,# splitval
		     ], $package );
}


sub next { $_[0][ f_next ]->( $_[0] ) }

sub dump{
      my $self = shift;
      my @fields = map { split(/\s+/,$_) } @_;

      map { croak "invalid field '$_'" unless /^[A-Za-z0-9_\.]+$/ } @fields;


      my $code = 'while(my $rec = $self->next){ push @out, {' . "\n";

      foreach my $field ( @fields){
	    my $f = $field;
	    $f =~ s/\./->/g;
	    $code .= "'$field' => \$rec->$f,\n";
      }

      $code .= "}}";
      my @out;
      eval $code;

      die "eval returned '$@'" if $@;

      wantarray ? @out : \@out;
}

sub TO_JSON {
      my $self = shift;

lib/DBR/ResultSet.pm  view on Meta::CPAN

	    return $self->_mem_iterator; #rowcache is already full, reset the mem iterator
      }

      if( $self->[f_state] == stACTIVE ){
	    $self->[f_query]->reset; # calls finish
	    $self->[f_rowcache] = []; #not sure if this is necessary or not
	    $self->[f_state] = stCLEAN;
	    $self->[f_next]  = FIRST;
      }

      return 1;
}

sub _first{
      my $self = shift;

      $self->_execute();
      return $self->next;
}

sub _execute{
      my $self = shift;

      $self->[f_state] == stCLEAN or croak "Cannot call _execute unless in a clean state";

      if( defined( $self->[f_splitval] ) ){

	    my $rows = $self->[f_rowcache] = $self->[f_query]->fetch_segment( $self->[f_splitval] ); # Query handles the sth
	    $self->_mem_iterator;

      }else{

	    $self->_db_iterator;

      }

      return 1;
}

sub _db_iterator{
      my $self = shift;


      my $record = $self->[f_query]->get_record_obj;
      my $class  = $record->class;

      my $sth    =  $self->[f_query]->run;

      defined( my $rv = $sth->execute ) or confess 'failed to execute statement (' . $sth->errstr. ')';

      $self->[f_state] = stACTIVE;

      if( $self->[f_query]->instance->getconn->can_trust_execute_rowcount ){ # HERE - yuck... assumes this is same connection as the sth
	    $self->[f_count] = $rv + 0;
	    $self->[f_query]->_logDebug3('ROWS: ' . ($rv + 0));
      }

     

      # IMPORTANT NOTE: circular reference hazard
      weaken ($self); # Weaken the refcount

      my $endsub = sub {
	    defined($self) or return DUMMY; # technically this could be out of scope because it's a weak ref

	    $self->[f_count] ||= $sth->rows || 0;
	    $self->[f_next]  = FIRST;
	    $self->[f_state] = stCLEAN; # If we get here, then we hit the end, and no ->finish is required

	    return DUMMY; # evaluates to false
      };

      my $buddy;
      my $rows  = [];
      my $commonref;
      my $getchunk = sub {
	    $rows = $sth->fetchall_arrayref(undef,1000) || return undef; # if cache is empty, fetch more
	    
	    $commonref = [ @$rows ];
	    map {weaken $_} @$commonref;
	    $buddy = [ $commonref, $record ]; # buddy ref must contain the record object just to keep it in scope.
	    
	    return shift @$rows;
      };
      # use a closure to reduce hash lookups
      # It's very important that this closure is fast.
      # This one routine has more of an effect on speed than anything else in the rest of the code

      $self->[f_next] = sub {
	    bless(
		  (
		   [
		   (
		    shift(@$rows) || $getchunk->() || return $endsub->()
		   ),
		    $buddy
		   ]
		  ),
		  $class
		 );
      };

      return 1;

}

sub _mem_iterator{
      my $self = shift;

      my $record = $self->[f_query]->get_record_obj;
      my $class  = $record->class;

      my $buddy  = [ $self->[f_rowcache], $record ]; # buddy ref must contain the record object just to keep it in scope.

      my $rows  = $self->[f_rowcache];
      my $ct = 0;

      # use a closure to reduce hash lookups
      # It's very important that this closure is fast.
      # This one routine has more of an effect on speed than anything else in the rest of the code
      $self->[f_next] = sub {
	    bless( (
		    [
		     ($rows->[$ct++] or $ct = 0 or return DUMMY ),
		     $buddy # buddy object comes along for the ride - to keep my recmaker in scope
		    ]
		   ),	$class );
      };

      $self->[f_state] = stMEM;
      $self->[f_count] = @$rows;
      return 1;

}

sub _fetch_all{
      my $self = shift;

      if( $self->[f_state] == stCLEAN ){
	    $self->_execute;