lib/DBIx/Class/Storage/DBI/Cursor.pm

   1 package DBIx::Class::Storage::DBI::Cursor;
   2
   3 use strict;
   4 use warnings;
   5
   6 use base qw/DBIx::Class::Cursor/;
   7
   8 use Try::Tiny;
   9 use Scalar::Util qw/refaddr weaken/;
  10 use namespace::clean;
  11
  12 __PACKAGE__->mk_group_accessors('simple' =>
  13     qw/storage args attrs/
  14 );
  15
  16 =head1 NAME
  17
  18 DBIx::Class::Storage::DBI::Cursor - Object representing a query cursor on a
  19 resultset.
  20
  21 =head1 SYNOPSIS
  22
  23   my $cursor = $schema->resultset('CD')->cursor();
  24
  25   # raw values off the database handle in resultset columns/select order
  26   my @next_cd_column_values = $cursor->next;
  27
  28   # list of all raw values as arrayrefs
  29   my @all_cds_column_values = $cursor->all;
  30
  31 =head1 DESCRIPTION
  32
  33 A Cursor represents a query cursor on a L<DBIx::Class::ResultSet> object. It
  34 allows for traversing the result set with L</next>, retrieving all results with
  35 L</all> and resetting the cursor with L</reset>.
  36
  37 Usually, you would use the cursor methods built into L<DBIx::Class::ResultSet>
  38 to traverse it. See L<DBIx::Class::ResultSet/next>,
  39 L<DBIx::Class::ResultSet/reset> and L<DBIx::Class::ResultSet/all> for more
  40 information.
  41
  42 =head1 METHODS
  43
  44 =head2 new
  45
  46 Returns a new L<DBIx::Class::Storage::DBI::Cursor> object.
  47
  48 =cut
  49
  50 {
  51   my %cursor_registry;
  52
  53   sub new {
  54     my ($class, $storage, $args, $attrs) = @_;
  55
  56     my $self = bless {
  57       storage => $storage,
  58       args => $args,
  59       attrs => $attrs,
  60     }, ref $class || $class;
  61
  62     weaken( $cursor_registry{ refaddr($self) } = $self )
  63       if DBIx::Class::_ENV_::HAS_ITHREADS;
  64
  65     return $self;
  66   }
  67
  68   sub CLONE {
  69     for (keys %cursor_registry) {
  70       # once marked we no longer care about them, hence no
  71       # need to keep in the registry, left alone renumber the
  72       # keys (all addresses are now different)
  73       my $self = delete $cursor_registry{$_}
  74         or next;
  75
  76       $self->{_intra_thread} = 1;
  77     }
  78   }
  79 }
  80
  81 =head2 next
  82
  83 =over 4
  84
  85 =item Arguments: none
  86
  87 =item Return Value: \@row_columns
  88
  89 =back
  90
  91 Advances the cursor to the next row and returns an array of column
  92 values (the result of L<DBI/fetchrow_array> method).
  93
  94 =cut
  95
  96 sub next {
  97   my $self = shift;
  98
  99   return if $self->{_done};
 100
 101   my $sth;
 102
 103   if (
 104     $self->{attrs}{software_limit}
 105       && $self->{attrs}{rows}
 106         && ($self->{_pos}||0) >= $self->{attrs}{rows}
 107   ) {
 108     if ($sth = $self->sth) {
 109       # explicit finish will issue warnings, unlike the DESTROY below
 110       $sth->finish if $sth->FETCH('Active');
 111     }
 112     $self->{_done} = 1;
 113     return;
 114   }
 115
 116   unless ($sth = $self->sth) {
 117     (undef, $sth, undef) = $self->storage->_select( @{$self->{args}} );
 118
 119     $self->{_results} = [ (undef) x $sth->FETCH('NUM_OF_FIELDS') ];
 120     $sth->bind_columns( \( @{$self->{_results}} ) );
 121
 122     if ( $self->{attrs}{software_limit} and $self->{attrs}{offset} ) {
 123       $sth->fetch for 1 .. $self->{attrs}{offset};
 124     }
 125
 126     $self->sth($sth);
 127   }
 128
 129   if ($sth->fetch) {
 130     $self->{_pos}++;
 131     return @{$self->{_results}};
 132   } else {
 133     $self->{_done} = 1;
 134     return ();
 135   }
 136 }
 137
 138
 139 =head2 all
 140
 141 =over 4
 142
 143 =item Arguments: none
 144
 145 =item Return Value: \@row_columns+
 146
 147 =back
 148
 149 Returns a list of arrayrefs of column values for all rows in the
 150 L<DBIx::Class::ResultSet>.
 151
 152 =cut
 153
 154 sub all {
 155   my $self = shift;
 156
 157   # delegate to DBIC::Cursor which will delegate back to next()
 158   if ($self->{attrs}{software_limit}
 159         && ($self->{attrs}{offset} || $self->{attrs}{rows})) {
 160     return $self->next::method(@_);
 161   }
 162
 163   my $sth;
 164
 165   if ($sth = $self->sth) {
 166     # explicit finish will issue warnings, unlike the DESTROY below
 167     $sth->finish if ( ! $self->{_done} and $sth->FETCH('Active') );
 168     $self->sth(undef);
 169   }
 170
 171   (undef, $sth) = $self->storage->_select( @{$self->{args}} );
 172
 173   return @{$sth->fetchall_arrayref};
 174 }
 175
 176 sub sth {
 177   my $self = shift;
 178
 179   if (@_) {
 180     delete @{$self}{qw/_pos _done _pid _intra_thread/};
 181
 182     $self->{sth} = $_[0];
 183     $self->{_pid} = $$ if ! DBIx::Class::_ENV_::BROKEN_FORK and $_[0];
 184   }
 185   elsif ($self->{sth} and ! $self->{_done}) {
 186
 187     my $invalidate_handle_reason;
 188
 189     if (DBIx::Class::_ENV_::HAS_ITHREADS and $self->{_intra_thread} ) {
 190       $invalidate_handle_reason = 'Multi-thread';
 191     }
 192     elsif (!DBIx::Class::_ENV_::BROKEN_FORK and $self->{_pid} != $$ ) {
 193       $invalidate_handle_reason = 'Multi-process';
 194     }
 195
 196     if ($invalidate_handle_reason) {
 197       $self->storage->throw_exception("$invalidate_handle_reason access attempted while cursor in progress (position $self->{_pos})")
 198         if $self->{_pos};
 199
 200       # reinvokes the reset logic above
 201       $self->sth(undef);
 202     }
 203   }
 204
 205   return $self->{sth};
 206 }
 207
 208 =head2 reset
 209
 210 Resets the cursor to the beginning of the L<DBIx::Class::ResultSet>.
 211
 212 =cut
 213
 214 sub reset {
 215   $_[0]->__finish_sth if $_[0]->{sth};
 216   $_[0]->sth(undef);
 217 }
 218
 219
 220 sub DESTROY {
 221   $_[0]->__finish_sth if $_[0]->{sth};
 222 }
 223
 224 sub __finish_sth {
 225   # It is (sadly) extremely important to finish() handles we are about
 226   # to lose (due to reset() or a DESTROY() ). $rs->reset is the closest
 227   # thing the user has to getting to the underlying finish() API and some
 228   # DBDs mandate this (e.g. DBD::InterBase will segfault, DBD::Sybase
 229   # won't start a transaction sanely, etc)
 230   # We also can't use the accessor here, as it will trigger a fork/thread
 231   # check, and resetting a cursor in a child is perfectly valid
 232
 233   my $self = shift;
 234
 235   # No need to care about failures here
 236   try { local $SIG{__WARN__} = sub {}; $self->{sth}->finish } if (
 237     $self->{sth} and ! try { ! $self->{sth}->FETCH('Active') }
 238   );
 239 }
 240
 241 1;