Rename internal rsrc method to be more descriptive, stop proxying it
[dbsrgits/DBIx-Class.git] / 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;