X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FStorage%2FDBI%2FCursor.pm;h=eee5cbbb2232e6495da5ac84a9d26585cafee26e;hb=a6646e1b0a25acfd21cc3e32b8c479dd0f3526ef;hp=143425bc252cd00bcecfb6f4b8a26c468390d585;hpb=aeaf3ce2ab5d86cbdaca6857f5ee3c9cea3f1fd6;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Storage/DBI/Cursor.pm b/lib/DBIx/Class/Storage/DBI/Cursor.pm index 143425b..eee5cbb 100644 --- a/lib/DBIx/Class/Storage/DBI/Cursor.pm +++ b/lib/DBIx/Class/Storage/DBI/Cursor.pm @@ -1,57 +1,186 @@ package DBIx::Class::Storage::DBI::Cursor; -use base qw/DBIx::Class::Cursor/; - use strict; use warnings; +use base qw/DBIx::Class::Cursor/; + +use Try::Tiny; +use namespace::clean; + +__PACKAGE__->mk_group_accessors('simple' => + qw/sth/ +); + +=head1 NAME + +DBIx::Class::Storage::DBI::Cursor - Object representing a query cursor on a +resultset. + +=head1 SYNOPSIS + + my $cursor = $schema->resultset('CD')->cursor(); + my $first_cd = $cursor->next; + +=head1 DESCRIPTION + +A Cursor represents a query cursor on a L object. It +allows for traversing the result set with L, retrieving all results with +L and resetting the cursor with L. + +Usually, you would use the cursor methods built into L +to traverse it. See L, +L and L for more +information. + +=head1 METHODS + +=head2 new + +Returns a new L object. + +=cut + sub new { - my ($it_class, $sth, $args, $attrs) = @_; - #use Data::Dumper; warn Dumper(@_); - $it_class = ref $it_class if ref $it_class; + my ($class, $storage, $args, $attrs) = @_; + $class = ref $class if ref $class; + my $new = { - sth => $sth, + storage => $storage, args => $args, pos => 0, - attrs => $attrs }; - return bless ($new, $it_class); + attrs => $attrs, + _dbh_gen => $storage->{_dbh_gen}, + }; + + return bless ($new, $class); } -sub next { - my ($self) = @_; - return if $self->{attrs}{rows} - && $self->{pos} >= $self->{attrs}{rows}; # + $self->{attrs}{offset}); - my $sth = $self->{sth}; - unless ($self->{live_sth}) { - $sth->execute(@{$self->{args} || []}); - $self->{live_sth} = 1; +=head2 next + +=over 4 + +=item Arguments: none + +=item Return Value: \@row_columns + +=back + +Advances the cursor to the next row and returns an array of column +values (the result of L method). + +=cut + +sub _dbh_next { + my ($storage, $dbh, $self) = @_; + + $self->_check_dbh_gen; + if ( + $self->{attrs}{software_limit} + && $self->{attrs}{rows} + && $self->{pos} >= $self->{attrs}{rows} + ) { + $self->sth->finish if $self->sth->{Active}; + $self->sth(undef); + $self->{done} = 1; + } + return if $self->{done}; + unless ($self->sth) { + $self->sth(($storage->_select(@{$self->{args}}))[1]); + if ($self->{attrs}{software_limit}) { + if (my $offset = $self->{attrs}{offset}) { + $self->sth->fetch for 1 .. $offset; + } + } + } + my @row = $self->sth->fetchrow_array; + if (@row) { + $self->{pos}++; + } else { + $self->sth(undef); + $self->{done} = 1; } - my @row = $sth->fetchrow_array; - $self->{pos}++ if @row; return @row; } -sub all { +sub next { my ($self) = @_; - return $self->SUPER::all if $self->{attrs}{rows}; - my $sth = $self->{sth}; - $sth->finish if $sth->{Active}; - $sth->execute(@{$self->{args} || []}); - delete $self->{live_sth}; + $self->{storage}->dbh_do($self->can('_dbh_next'), $self); +} + +=head2 all + +=over 4 + +=item Arguments: none + +=item Return Value: \@row_columns+ + +=back + +Returns a list of arrayrefs of column values for all rows in the +L. + +=cut + +sub _dbh_all { + my ($storage, $dbh, $self) = @_; + + $self->_check_dbh_gen; + $self->sth->finish if $self->sth && $self->sth->{Active}; + $self->sth(undef); + my ($rv, $sth) = $storage->_select(@{$self->{args}}); return @{$sth->fetchall_arrayref}; } +sub all { + my ($self) = @_; + if ($self->{attrs}{software_limit} + && ($self->{attrs}{offset} || $self->{attrs}{rows})) { + return $self->next::method; + } + + $self->{storage}->dbh_do($self->can('_dbh_all'), $self); +} + +=head2 reset + +Resets the cursor to the beginning of the L. + +=cut + sub reset { my ($self) = @_; - $self->{sth}->finish if $self->{sth}->{Active}; + + # No need to care about failures here + try { $self->sth->finish } + if $self->sth && $self->sth->{Active}; + $self->_soft_reset; + return undef; +} + +sub _soft_reset { + my ($self) = @_; + + $self->sth(undef); + delete $self->{done}; $self->{pos} = 0; - $self->{live_sth} = 0; - return $self; } -sub DESTROY { +sub _check_dbh_gen { my ($self) = @_; - $self->{sth}->finish if $self->{sth}->{Active}; + + if($self->{_dbh_gen} != $self->{storage}->{_dbh_gen}) { + $self->{_dbh_gen} = $self->{storage}->{_dbh_gen}; + $self->_soft_reset; + } +} + +sub DESTROY { + # None of the reasons this would die matter if we're in DESTROY anyways + if (my $sth = $_[0]->sth) { + try { $sth->finish } if $sth->FETCH('Active'); + } } 1;