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