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