view release on metacpan or  search on metacpan

lib/DBIO/Storage/DBI/Cursor.pm  view on Meta::CPAN

package DBIO::Storage::DBI::Cursor;
# ABSTRACT: Object representing a query cursor on a resultset.

use strict;
use warnings;

use base 'DBIO::Cursor';

use Try::Tiny;
use Scalar::Util qw(refaddr weaken);
use DBIO::Util qw(has_ithreads is_windows shuffle_unordered_resultsets);
use namespace::clean;

__PACKAGE__->mk_group_accessors('simple' =>
    qw/storage args attrs/
);


{
  my %cursor_registry;

  sub new {
    my ($class, $storage, $args, $attrs) = @_;

    my $self = bless {
      storage => $storage,
      args => $args,
      attrs => $attrs,
    }, ref $class || $class;

    if (has_ithreads) {

      # quick "garbage collection" pass - prevents the registry
      # from slowly growing with a bunch of undef-valued keys
      defined $cursor_registry{$_} or delete $cursor_registry{$_}
        for keys %cursor_registry;

      weaken( $cursor_registry{ refaddr($self) } = $self )
    }

    return $self;
  }

  sub CLONE {
    for (keys %cursor_registry) {
      # once marked we no longer care about them, hence no
      # need to keep in the registry, left alone renumber the
      # keys (all addresses are now different)
      my $self = delete $cursor_registry{$_}
        or next;

      $self->{_intra_thread} = 1;
    }
  }
}


sub next {
  my $self = shift;

  return if $self->{_done};

  my $sth;

  if (
    $self->{attrs}{software_limit}
      && $self->{attrs}{rows}
        && ($self->{_pos}||0) >= $self->{attrs}{rows}
  ) {
    if ($sth = $self->sth) {
      # explicit finish will issue warnings, unlike the DESTROY below
      $sth->finish if $sth->FETCH('Active');
    }
    $self->{_done} = 1;
    return;
  }

  unless ($sth = $self->sth) {
    (undef, $sth, undef) = $self->storage->_select( @{$self->{args}} );

    $self->{_results} = [ (undef) x $sth->FETCH('NUM_OF_FIELDS') ];
    $sth->bind_columns( \( @{$self->{_results}} ) );

    if ( $self->{attrs}{software_limit} and $self->{attrs}{offset} ) {
      $sth->fetch for 1 .. $self->{attrs}{offset};
    }

    $self->sth($sth);
  }

  if ($sth->fetch) {
    $self->{_pos}++;
    return @{$self->{_results}};
  } else {
    $self->{_done} = 1;
    return ();
  }
}