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 'DBIx::Class::Cursor';
   7
   8 use Scalar::Util qw(refaddr weaken);
   9 use List::Util 'shuffle';
  10 use DBIx::Class::_Util qw( detected_reinvoked_destructor dbic_internal_try );
  11 use namespace::clean;
  12
  13 __PACKAGE__->mk_group_accessors('simple' =>
  14     qw/storage args attrs/
  15 );
  16
  17 =head1 NAME
  18
  19 DBIx::Class::Storage::DBI::Cursor - Object representing a query cursor on a
  20 resultset.
  21
  22 =head1 SYNOPSIS
  23
  24   my $cursor = $schema->resultset('CD')->cursor();
  25
  26   # raw values off the database handle in resultset columns/select order
  27   my @next_cd_column_values = $cursor->next;
  28
  29   # list of all raw values as arrayrefs
  30   my @all_cds_column_values = $cursor->all;
  31
  32 =head1 DESCRIPTION
  33
  34 A Cursor represents a query cursor on a L<DBIx::Class::ResultSet> object. It
  35 allows for traversing the result set with L</next>, retrieving all results with
  36 L</all> and resetting the cursor with L</reset>.
  37
  38 Usually, you would use the cursor methods built into L<DBIx::Class::ResultSet>
  39 to traverse it. See L<DBIx::Class::ResultSet/next>,
  40 L<DBIx::Class::ResultSet/reset> and L<DBIx::Class::ResultSet/all> for more
  41 information.
  42
  43 =head1 METHODS
  44
  45 =head2 new
  46
  47 Returns a new L<DBIx::Class::Storage::DBI::Cursor> object.
  48
  49 =cut
  50
  51 {
  52   my %cursor_registry;
  53
  54   sub new {
  55     my ($class, $storage, $args, $attrs) = @_;
  56
  57     my $self = bless {
  58       storage => $storage,
  59       args => $args,
  60       attrs => $attrs,
  61     }, ref $class || $class;
  62
  63     if (DBIx::Class::_ENV_::HAS_ITHREADS) {
  64
  65       # quick "garbage collection" pass - prevents the registry
  66       # from slowly growing with a bunch of undef-valued keys
  67       defined $cursor_registry{$_} or delete $cursor_registry{$_}
  68         for keys %cursor_registry;
  69
  70       weaken( $cursor_registry{ refaddr($self) } = $self )
  71     }
  72
  73     return $self;
  74   }
  75
  76   sub CLONE {
  77     for (keys %cursor_registry) {
  78       # once marked we no longer care about them, hence no
  79       # need to keep in the registry, left alone renumber the
  80       # keys (all addresses are now different)
  81       my $self = delete $cursor_registry{$_}
  82         or next;
  83
  84       $self->{_intra_thread} = 1;
  85     }
  86
  87     # Dummy NEXTSTATE ensuring the all temporaries on the stack are garbage
  88     # collected before leaving this scope. Depending on the code above, this
  89     # may very well be just a preventive measure guarding future modifications
  90     undef;
  91   }
  92 }
  93
  94 =head2 next
  95
  96 =over 4
  97
  98 =item Arguments: none
  99
 100 =item Return Value: \@row_columns
 101
 102 =back
 103
 104 Advances the cursor to the next row and returns an array of column
 105 values (the result of L<DBI/fetchrow_array> method).
 106
 107 =cut
 108
 109 sub next {
 110   my $self = shift;
 111
 112   return if $self->{_done};
 113
 114   my $sth;
 115
 116   if (
 117     $self->{attrs}{software_limit}
 118       && $self->{attrs}{rows}
 119         && ($self->{_pos}||0) >= $self->{attrs}{rows}
 120   ) {
 121     if ($sth = $self->sth) {
 122       # explicit finish will issue warnings, unlike the DESTROY below
 123       $sth->finish if $sth->FETCH('Active');
 124     }
 125     $self->{_done} = 1;
 126     return;
 127   }
 128
 129   unless ($sth = $self->sth) {
 130     (undef, $sth, undef) = $self->storage->_select( @{$self->{args}} );
 131
 132     $self->{_results} = [ (undef) x $sth->FETCH('NUM_OF_FIELDS') ];
 133     $sth->bind_columns( \( @{$self->{_results}} ) );
 134
 135     if ( $self->{attrs}{software_limit} and $self->{attrs}{offset} ) {
 136       $sth->fetch for 1 .. $self->{attrs}{offset};
 137     }
 138
 139     $self->sth($sth);
 140   }
 141
 142   if ($sth->fetch) {
 143     $self->{_pos}++;
 144     return @{$self->{_results}};
 145   } else {
 146     $self->{_done} = 1;
 147     return ();
 148   }
 149 }
 150
 151
 152 =head2 all
 153
 154 =over 4
 155
 156 =item Arguments: none
 157
 158 =item Return Value: \@row_columns+
 159
 160 =back
 161
 162 Returns a list of arrayrefs of column values for all rows in the
 163 L<DBIx::Class::ResultSet>.
 164
 165 =cut
 166
 167 sub all {
 168   my $self = shift;
 169
 170   # delegate to DBIC::Cursor which will delegate back to next()
 171   if ($self->{attrs}{software_limit}
 172         && ($self->{attrs}{offset} || $self->{attrs}{rows})) {
 173     return $self->next::method(@_);
 174   }
 175
 176   my $sth;
 177
 178   if ($sth = $self->sth) {
 179     # explicit finish will issue warnings, unlike the DESTROY below
 180     $sth->finish if ( ! $self->{_done} and $sth->FETCH('Active') );
 181     $self->sth(undef);
 182   }
 183
 184   (undef, $sth) = $self->storage->_select( @{$self->{args}} );
 185
 186   return (
 187     DBIx::Class::_ENV_::SHUFFLE_UNORDERED_RESULTSETS
 188       and
 189     ! $self->{attrs}{order_by}
 190   )
 191     ? shuffle @{$sth->fetchall_arrayref}
 192     : @{$sth->fetchall_arrayref}
 193   ;
 194 }
 195
 196 sub sth {
 197   my $self = shift;
 198
 199   if (@_) {
 200     delete @{$self}{qw/_pos _done _pid _intra_thread/};
 201
 202     $self->{sth} = $_[0];
 203     $self->{_pid} = $$ if ! DBIx::Class::_ENV_::BROKEN_FORK and $_[0];
 204   }
 205   elsif ($self->{sth} and ! $self->{_done}) {
 206
 207     my $invalidate_handle_reason;
 208
 209     if (DBIx::Class::_ENV_::HAS_ITHREADS and $self->{_intra_thread} ) {
 210       $invalidate_handle_reason = 'Multi-thread';
 211     }
 212     elsif (!DBIx::Class::_ENV_::BROKEN_FORK and $self->{_pid} != $$ ) {
 213       $invalidate_handle_reason = 'Multi-process';
 214     }
 215
 216     if ($invalidate_handle_reason) {
 217       $self->storage->throw_exception("$invalidate_handle_reason access attempted while cursor in progress (position $self->{_pos})")
 218         if $self->{_pos};
 219
 220       # reinvokes the reset logic above
 221       $self->sth(undef);
 222     }
 223   }
 224
 225   return $self->{sth};
 226 }
 227
 228 =head2 reset
 229
 230 Resets the cursor to the beginning of the L<DBIx::Class::ResultSet>.
 231
 232 =cut
 233
 234 sub reset {
 235   $_[0]->__finish_sth if $_[0]->{sth};
 236   $_[0]->sth(undef);
 237
 238   # Dummy NEXTSTATE ensuring the all temporaries on the stack are garbage
 239   # collected before leaving this scope. Depending on the code above, this
 240   # may very well be just a preventive measure guarding future modifications
 241   undef;
 242 }
 243
 244
 245 sub DESTROY {
 246   return if &detected_reinvoked_destructor;
 247
 248   $_[0]->__finish_sth if $_[0]->{sth};
 249
 250   # Dummy NEXTSTATE ensuring the all temporaries on the stack are garbage
 251   # collected before leaving this scope. Depending on the code above, this
 252   # may very well be just a preventive measure guarding future modifications
 253   undef;
 254 }
 255
 256 sub __finish_sth {
 257   # It is (sadly) extremely important to finish() handles we are about
 258   # to lose (due to reset() or a DESTROY() ). $rs->reset is the closest
 259   # thing the user has to getting to the underlying finish() API and some
 260   # DBDs mandate this (e.g. DBD::InterBase will segfault, DBD::Sybase
 261   # won't start a transaction sanely, etc)
 262   # We also can't use the accessor here, as it will trigger a fork/thread
 263   # check, and resetting a cursor in a child is perfectly valid
 264
 265   my $self = shift;
 266
 267   # No need to care about failures here
 268   dbic_internal_try {
 269     local $SIG{__WARN__} = sub {};
 270     $self->{sth}->finish
 271   } if (
 272     $self->{sth}
 273       and
 274     # weird double-negative to catch the case of ->FETCH throwing
 275     # and attempt a finish *anyway*
 276     ! dbic_internal_try {
 277       ! $self->{sth}->FETCH('Active')
 278     }
 279   );
 280
 281   # Dummy NEXTSTATE ensuring the all temporaries on the stack are garbage
 282   # collected before leaving this scope. Depending on the code above, this
 283   # may very well be just a preventive measure guarding future modifications
 284   undef;
 285 }
 286
 287 =head1 FURTHER QUESTIONS?
 288
 289 Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>.
 290
 291 =head1 COPYRIGHT AND LICENSE
 292
 293 This module is free software L<copyright|DBIx::Class/COPYRIGHT AND LICENSE>
 294 by the L<DBIx::Class (DBIC) authors|DBIx::Class/AUTHORS>. You can
 295 redistribute it and/or modify it under the same terms as the
 296 L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>.
 297
 298 =cut
 299
 300 1;