Commit | Line | Data |
5cf243f6 |
1 | package DBIx::Class::Storage::DBI::Cursor; |
28927b50 |
2 | |
28927b50 |
3 | use strict; |
4 | use warnings; |
5 | |
1b658919 |
6 | use base 'DBIx::Class::Cursor'; |
a3a526cc |
7 | |
1b658919 |
8 | use Scalar::Util qw(refaddr weaken); |
9 | use List::Util 'shuffle'; |
ddcc02d1 |
10 | use DBIx::Class::_Util qw( detected_reinvoked_destructor dbic_internal_try ); |
fd323bf1 |
11 | use namespace::clean; |
9780718f |
12 | |
a3a526cc |
13 | __PACKAGE__->mk_group_accessors('simple' => |
a2f22854 |
14 | qw/storage args attrs/ |
a3a526cc |
15 | ); |
2ad62d97 |
16 | |
5cf243f6 |
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(); |
c564f8c3 |
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; |
5cf243f6 |
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 | |
5cf243f6 |
47 | Returns a new L<DBIx::Class::Storage::DBI::Cursor> object. |
48 | |
49 | =cut |
50 | |
a2f22854 |
51 | { |
52 | my %cursor_registry; |
2007929b |
53 | |
a2f22854 |
54 | sub new { |
55 | my ($class, $storage, $args, $attrs) = @_; |
1346e22d |
56 | |
a2f22854 |
57 | my $self = bless { |
58 | storage => $storage, |
59 | args => $args, |
60 | attrs => $attrs, |
61 | }, ref $class || $class; |
62 | |
85ad63df |
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 | } |
a2f22854 |
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 | } |
d52fc26d |
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; |
a2f22854 |
91 | } |
28927b50 |
92 | } |
93 | |
5cf243f6 |
94 | =head2 next |
95 | |
21b5c39d |
96 | =over 4 |
97 | |
ebc77b53 |
98 | =item Arguments: none |
21b5c39d |
99 | |
d601dc88 |
100 | =item Return Value: \@row_columns |
21b5c39d |
101 | |
5cf243f6 |
102 | =back |
103 | |
685dad64 |
104 | Advances the cursor to the next row and returns an array of column |
105 | values (the result of L<DBI/fetchrow_array> method). |
5cf243f6 |
106 | |
107 | =cut |
108 | |
a2f22854 |
109 | sub next { |
110 | my $self = shift; |
111 | |
112 | return if $self->{_done}; |
113 | |
114 | my $sth; |
1346e22d |
115 | |
22ed9526 |
116 | if ( |
117 | $self->{attrs}{software_limit} |
118 | && $self->{attrs}{rows} |
a2f22854 |
119 | && ($self->{_pos}||0) >= $self->{attrs}{rows} |
22ed9526 |
120 | ) { |
a2f22854 |
121 | if ($sth = $self->sth) { |
122 | # explicit finish will issue warnings, unlike the DESTROY below |
123 | $sth->finish if $sth->FETCH('Active'); |
124 | } |
dfa92e5e |
125 | $self->{_done} = 1; |
a2f22854 |
126 | return; |
cb5f2eea |
127 | } |
dfa92e5e |
128 | |
a2f22854 |
129 | unless ($sth = $self->sth) { |
544671d4 |
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}} ) ); |
a2f22854 |
134 | |
135 | if ( $self->{attrs}{software_limit} and $self->{attrs}{offset} ) { |
136 | $sth->fetch for 1 .. $self->{attrs}{offset}; |
5c91499f |
137 | } |
a2f22854 |
138 | |
139 | $self->sth($sth); |
28927b50 |
140 | } |
a2f22854 |
141 | |
544671d4 |
142 | if ($sth->fetch) { |
dfa92e5e |
143 | $self->{_pos}++; |
544671d4 |
144 | return @{$self->{_results}}; |
cb5f2eea |
145 | } else { |
dfa92e5e |
146 | $self->{_done} = 1; |
544671d4 |
147 | return (); |
cb5f2eea |
148 | } |
dbaee748 |
149 | } |
150 | |
a2f22854 |
151 | |
5cf243f6 |
152 | =head2 all |
153 | |
21b5c39d |
154 | =over 4 |
155 | |
ebc77b53 |
156 | =item Arguments: none |
21b5c39d |
157 | |
d601dc88 |
158 | =item Return Value: \@row_columns+ |
21b5c39d |
159 | |
5cf243f6 |
160 | =back |
161 | |
21b5c39d |
162 | Returns a list of arrayrefs of column values for all rows in the |
163 | L<DBIx::Class::ResultSet>. |
5cf243f6 |
164 | |
165 | =cut |
166 | |
a2f22854 |
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}} ); |
1346e22d |
185 | |
1b658919 |
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 | ; |
1a14aa3f |
194 | } |
195 | |
a2f22854 |
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 | } |
6296f45b |
223 | } |
22ed9526 |
224 | |
a2f22854 |
225 | return $self->{sth}; |
dbaee748 |
226 | } |
227 | |
5cf243f6 |
228 | =head2 reset |
229 | |
5cf243f6 |
230 | Resets the cursor to the beginning of the L<DBIx::Class::ResultSet>. |
231 | |
232 | =cut |
233 | |
28927b50 |
234 | sub reset { |
a2f22854 |
235 | $_[0]->__finish_sth if $_[0]->{sth}; |
236 | $_[0]->sth(undef); |
d52fc26d |
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; |
1346e22d |
242 | } |
243 | |
1346e22d |
244 | |
a2f22854 |
245 | sub DESTROY { |
e1d9e578 |
246 | return if &detected_reinvoked_destructor; |
3d56e026 |
247 | |
a2f22854 |
248 | $_[0]->__finish_sth if $_[0]->{sth}; |
d52fc26d |
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; |
28927b50 |
254 | } |
255 | |
a2f22854 |
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 |
1346e22d |
264 | |
a2f22854 |
265 | my $self = shift; |
1346e22d |
266 | |
a2f22854 |
267 | # No need to care about failures here |
ddcc02d1 |
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 | } |
a2f22854 |
279 | ); |
d52fc26d |
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; |
28927b50 |
285 | } |
286 | |
a2bd3796 |
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 | |
28927b50 |
300 | 1; |