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 | |
9780718f |
8 | use Try::Tiny; |
1b658919 |
9 | use Scalar::Util qw(refaddr weaken); |
10 | use List::Util 'shuffle'; |
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 | } |
86 | } |
28927b50 |
87 | } |
88 | |
5cf243f6 |
89 | =head2 next |
90 | |
21b5c39d |
91 | =over 4 |
92 | |
ebc77b53 |
93 | =item Arguments: none |
21b5c39d |
94 | |
d601dc88 |
95 | =item Return Value: \@row_columns |
21b5c39d |
96 | |
5cf243f6 |
97 | =back |
98 | |
685dad64 |
99 | Advances the cursor to the next row and returns an array of column |
100 | values (the result of L<DBI/fetchrow_array> method). |
5cf243f6 |
101 | |
102 | =cut |
103 | |
a2f22854 |
104 | sub next { |
105 | my $self = shift; |
106 | |
107 | return if $self->{_done}; |
108 | |
109 | my $sth; |
1346e22d |
110 | |
22ed9526 |
111 | if ( |
112 | $self->{attrs}{software_limit} |
113 | && $self->{attrs}{rows} |
a2f22854 |
114 | && ($self->{_pos}||0) >= $self->{attrs}{rows} |
22ed9526 |
115 | ) { |
a2f22854 |
116 | if ($sth = $self->sth) { |
117 | # explicit finish will issue warnings, unlike the DESTROY below |
118 | $sth->finish if $sth->FETCH('Active'); |
119 | } |
dfa92e5e |
120 | $self->{_done} = 1; |
a2f22854 |
121 | return; |
cb5f2eea |
122 | } |
dfa92e5e |
123 | |
a2f22854 |
124 | unless ($sth = $self->sth) { |
544671d4 |
125 | (undef, $sth, undef) = $self->storage->_select( @{$self->{args}} ); |
126 | |
127 | $self->{_results} = [ (undef) x $sth->FETCH('NUM_OF_FIELDS') ]; |
128 | $sth->bind_columns( \( @{$self->{_results}} ) ); |
a2f22854 |
129 | |
130 | if ( $self->{attrs}{software_limit} and $self->{attrs}{offset} ) { |
131 | $sth->fetch for 1 .. $self->{attrs}{offset}; |
5c91499f |
132 | } |
a2f22854 |
133 | |
134 | $self->sth($sth); |
28927b50 |
135 | } |
a2f22854 |
136 | |
544671d4 |
137 | if ($sth->fetch) { |
dfa92e5e |
138 | $self->{_pos}++; |
544671d4 |
139 | return @{$self->{_results}}; |
cb5f2eea |
140 | } else { |
dfa92e5e |
141 | $self->{_done} = 1; |
544671d4 |
142 | return (); |
cb5f2eea |
143 | } |
dbaee748 |
144 | } |
145 | |
a2f22854 |
146 | |
5cf243f6 |
147 | =head2 all |
148 | |
21b5c39d |
149 | =over 4 |
150 | |
ebc77b53 |
151 | =item Arguments: none |
21b5c39d |
152 | |
d601dc88 |
153 | =item Return Value: \@row_columns+ |
21b5c39d |
154 | |
5cf243f6 |
155 | =back |
156 | |
21b5c39d |
157 | Returns a list of arrayrefs of column values for all rows in the |
158 | L<DBIx::Class::ResultSet>. |
5cf243f6 |
159 | |
160 | =cut |
161 | |
a2f22854 |
162 | sub all { |
163 | my $self = shift; |
164 | |
165 | # delegate to DBIC::Cursor which will delegate back to next() |
166 | if ($self->{attrs}{software_limit} |
167 | && ($self->{attrs}{offset} || $self->{attrs}{rows})) { |
168 | return $self->next::method(@_); |
169 | } |
170 | |
171 | my $sth; |
172 | |
173 | if ($sth = $self->sth) { |
174 | # explicit finish will issue warnings, unlike the DESTROY below |
175 | $sth->finish if ( ! $self->{_done} and $sth->FETCH('Active') ); |
176 | $self->sth(undef); |
177 | } |
178 | |
179 | (undef, $sth) = $self->storage->_select( @{$self->{args}} ); |
1346e22d |
180 | |
1b658919 |
181 | return ( |
182 | DBIx::Class::_ENV_::SHUFFLE_UNORDERED_RESULTSETS |
183 | and |
184 | ! $self->{attrs}{order_by} |
185 | ) |
186 | ? shuffle @{$sth->fetchall_arrayref} |
187 | : @{$sth->fetchall_arrayref} |
188 | ; |
1a14aa3f |
189 | } |
190 | |
a2f22854 |
191 | sub sth { |
192 | my $self = shift; |
193 | |
194 | if (@_) { |
195 | delete @{$self}{qw/_pos _done _pid _intra_thread/}; |
196 | |
197 | $self->{sth} = $_[0]; |
198 | $self->{_pid} = $$ if ! DBIx::Class::_ENV_::BROKEN_FORK and $_[0]; |
199 | } |
200 | elsif ($self->{sth} and ! $self->{_done}) { |
201 | |
202 | my $invalidate_handle_reason; |
203 | |
204 | if (DBIx::Class::_ENV_::HAS_ITHREADS and $self->{_intra_thread} ) { |
205 | $invalidate_handle_reason = 'Multi-thread'; |
206 | } |
207 | elsif (!DBIx::Class::_ENV_::BROKEN_FORK and $self->{_pid} != $$ ) { |
208 | $invalidate_handle_reason = 'Multi-process'; |
209 | } |
210 | |
211 | if ($invalidate_handle_reason) { |
212 | $self->storage->throw_exception("$invalidate_handle_reason access attempted while cursor in progress (position $self->{_pos})") |
213 | if $self->{_pos}; |
214 | |
215 | # reinvokes the reset logic above |
216 | $self->sth(undef); |
217 | } |
6296f45b |
218 | } |
22ed9526 |
219 | |
a2f22854 |
220 | return $self->{sth}; |
dbaee748 |
221 | } |
222 | |
5cf243f6 |
223 | =head2 reset |
224 | |
5cf243f6 |
225 | Resets the cursor to the beginning of the L<DBIx::Class::ResultSet>. |
226 | |
227 | =cut |
228 | |
28927b50 |
229 | sub reset { |
a2f22854 |
230 | $_[0]->__finish_sth if $_[0]->{sth}; |
231 | $_[0]->sth(undef); |
1346e22d |
232 | } |
233 | |
1346e22d |
234 | |
a2f22854 |
235 | sub DESTROY { |
236 | $_[0]->__finish_sth if $_[0]->{sth}; |
28927b50 |
237 | } |
238 | |
a2f22854 |
239 | sub __finish_sth { |
240 | # It is (sadly) extremely important to finish() handles we are about |
241 | # to lose (due to reset() or a DESTROY() ). $rs->reset is the closest |
242 | # thing the user has to getting to the underlying finish() API and some |
243 | # DBDs mandate this (e.g. DBD::InterBase will segfault, DBD::Sybase |
244 | # won't start a transaction sanely, etc) |
245 | # We also can't use the accessor here, as it will trigger a fork/thread |
246 | # check, and resetting a cursor in a child is perfectly valid |
1346e22d |
247 | |
a2f22854 |
248 | my $self = shift; |
1346e22d |
249 | |
a2f22854 |
250 | # No need to care about failures here |
251 | try { local $SIG{__WARN__} = sub {}; $self->{sth}->finish } if ( |
252 | $self->{sth} and ! try { ! $self->{sth}->FETCH('Active') } |
253 | ); |
28927b50 |
254 | } |
255 | |
a2bd3796 |
256 | =head1 FURTHER QUESTIONS? |
257 | |
258 | Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>. |
259 | |
260 | =head1 COPYRIGHT AND LICENSE |
261 | |
262 | This module is free software L<copyright|DBIx::Class/COPYRIGHT AND LICENSE> |
263 | by the L<DBIx::Class (DBIC) authors|DBIx::Class/AUTHORS>. You can |
264 | redistribute it and/or modify it under the same terms as the |
265 | L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>. |
266 | |
267 | =cut |
268 | |
28927b50 |
269 | 1; |