X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FStorage%2FDBI%2FCursor.pm;h=a71036ecd12325b9509fe49a3ef6fa297ee82fd0;hb=0077982b2edc8273ab4b6ea59921177667008cb3;hp=26dca846c7074140ace58b5708956a24bccc4d34;hpb=d601dc88fcedcf9b0ef3c17c29556e26179c1cdc;p=dbsrgits%2FDBIx-Class-Historic.git diff --git a/lib/DBIx/Class/Storage/DBI/Cursor.pm b/lib/DBIx/Class/Storage/DBI/Cursor.pm index 26dca84..a71036e 100644 --- a/lib/DBIx/Class/Storage/DBI/Cursor.pm +++ b/lib/DBIx/Class/Storage/DBI/Cursor.pm @@ -1,10 +1,17 @@ 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 storage args attrs/ +); + =head1 NAME DBIx::Class::Storage::DBI::Cursor - Object representing a query cursor on a @@ -13,7 +20,12 @@ resultset. =head1 SYNOPSIS my $cursor = $schema->resultset('CD')->cursor(); - my $first_cd = $cursor->next; + + # raw values off the database handle in resultset columns/select order + my @next_cd_column_values = $cursor->next; + + # list of all raw values as arrayrefs + my @all_cds_column_values = $cursor->all; =head1 DESCRIPTION @@ -30,26 +42,23 @@ information. =head2 new -=back - Returns a new L object. =cut sub new { my ($class, $storage, $args, $attrs) = @_; - #use Data::Dumper; warn Dumper(@_); $class = ref $class if ref $class; + my $new = { storage => $storage, args => $args, - pos => 0, attrs => $attrs, - pid => $$, + _dbh_gen => $storage->{_dbh_gen}, + _pos => 0, + _done => 0, }; - $new->{tid} = threads->tid if $INC{'threads.pm'}; - return bless ($new, $class); } @@ -57,49 +66,61 @@ sub new { =over 4 -=item Arguments: (none) +=item Arguments: none =item Return Value: \@row_columns =back -Advances the cursor to the next row and returns an arrayref of column values. +Advances the cursor to the next row and returns an array of column +values (the result of L method). =cut -sub next { - my ($self) = @_; - - $self->_check_forks_threads; - if ($self->{attrs}{rows} && $self->{pos} >= $self->{attrs}{rows}) { - $self->{sth}->finish if $self->{sth}->{Active}; - delete $self->{sth}; - $self->{done} = 1; +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} = ($self->{storage}->_select(@{$self->{args}}))[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; + $self->sth->fetch for 1 .. $offset; } } } - my @row = $self->{sth}->fetchrow_array; + my @row = $self->sth->fetchrow_array; if (@row) { - $self->{pos}++; + $self->{_pos}++; } else { - delete $self->{sth}; - $self->{done} = 1; + $self->sth(undef); + $self->{_done} = 1; } return @row; } +sub next { + my ($self) = @_; + $self->{storage}->dbh_do($self->can('_dbh_next'), $self); +} + =head2 all =over 4 -=item Arguments: (none) +=item Arguments: none =item Return Value: \@row_columns+ @@ -110,21 +131,28 @@ 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->_check_forks_threads; - return $self->SUPER::all if $self->{attrs}{rows}; - $self->{sth}->finish if $self->{sth}->{Active}; - delete $self->{sth}; - my ($rv, $sth) = $self->{storage}->_select(@{$self->{args}}); - return @{$sth->fetchall_arrayref}; + $self->{storage}->dbh_do($self->can('_dbh_all'), $self); } =head2 reset -=back - Resets the cursor to the beginning of the L. =cut @@ -132,39 +160,36 @@ Resets the cursor to the beginning of the L. sub reset { my ($self) = @_; - $self->_check_forks_threads; - $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) = @_; - delete $self->{sth}; - $self->{pos} = 0; - delete $self->{done}; - return $self; + $self->sth(undef); + $self->{_done} = 0; + $self->{_pos} = 0; } -sub _check_forks_threads { +sub _check_dbh_gen { my ($self) = @_; - if($INC{'threads.pm'} && $self->{tid} != threads->tid) { - $self->_soft_reset; - $self->{tid} = threads->tid; - } - - if($self->{pid} != $$) { - $self->_soft_reset; - $self->{pid} = $$; + if($self->{_dbh_gen} != $self->{storage}->{_dbh_gen}) { + $self->{_dbh_gen} = $self->{storage}->{_dbh_gen}; + $self->_soft_reset; } } sub DESTROY { - my ($self) = @_; - - $self->_check_forks_threads; - $self->{sth}->finish if $self->{sth}->{Active}; + # None of the reasons this would die matter if we're in DESTROY anyways + if (my $sth = $_[0]->sth) { + local $SIG{__WARN__} = sub {}; + try { $sth->finish } if $sth->FETCH('Active'); + } } 1;