The real workaround for txn_scope_guard being called twice
[dbsrgits/DBIx-Class-Historic.git] / lib / DBIx / Class / Storage / DBI / Cursor.pm
CommitLineData
5cf243f6 1package DBIx::Class::Storage::DBI::Cursor;
28927b50 2
28927b50 3use strict;
4use warnings;
5
1b658919 6use base 'DBIx::Class::Cursor';
a3a526cc 7
9780718f 8use Try::Tiny;
1b658919 9use Scalar::Util qw(refaddr weaken);
10use List::Util 'shuffle';
3d56e026 11use DBIx::Class::_Util 'detect_reinvoked_destructor';
fd323bf1 12use namespace::clean;
9780718f 13
a3a526cc 14__PACKAGE__->mk_group_accessors('simple' =>
a2f22854 15 qw/storage args attrs/
a3a526cc 16);
2ad62d97 17
5cf243f6 18=head1 NAME
19
20DBIx::Class::Storage::DBI::Cursor - Object representing a query cursor on a
21resultset.
22
23=head1 SYNOPSIS
24
25 my $cursor = $schema->resultset('CD')->cursor();
c564f8c3 26
27 # raw values off the database handle in resultset columns/select order
28 my @next_cd_column_values = $cursor->next;
29
30 # list of all raw values as arrayrefs
31 my @all_cds_column_values = $cursor->all;
5cf243f6 32
33=head1 DESCRIPTION
34
35A Cursor represents a query cursor on a L<DBIx::Class::ResultSet> object. It
36allows for traversing the result set with L</next>, retrieving all results with
37L</all> and resetting the cursor with L</reset>.
38
39Usually, you would use the cursor methods built into L<DBIx::Class::ResultSet>
40to traverse it. See L<DBIx::Class::ResultSet/next>,
41L<DBIx::Class::ResultSet/reset> and L<DBIx::Class::ResultSet/all> for more
42information.
43
44=head1 METHODS
45
46=head2 new
47
5cf243f6 48Returns a new L<DBIx::Class::Storage::DBI::Cursor> object.
49
50=cut
51
a2f22854 52{
53 my %cursor_registry;
2007929b 54
a2f22854 55 sub new {
56 my ($class, $storage, $args, $attrs) = @_;
1346e22d 57
a2f22854 58 my $self = bless {
59 storage => $storage,
60 args => $args,
61 attrs => $attrs,
62 }, ref $class || $class;
63
85ad63df 64 if (DBIx::Class::_ENV_::HAS_ITHREADS) {
65
66 # quick "garbage collection" pass - prevents the registry
67 # from slowly growing with a bunch of undef-valued keys
68 defined $cursor_registry{$_} or delete $cursor_registry{$_}
69 for keys %cursor_registry;
70
71 weaken( $cursor_registry{ refaddr($self) } = $self )
72 }
a2f22854 73
74 return $self;
75 }
76
77 sub CLONE {
78 for (keys %cursor_registry) {
79 # once marked we no longer care about them, hence no
80 # need to keep in the registry, left alone renumber the
81 # keys (all addresses are now different)
82 my $self = delete $cursor_registry{$_}
83 or next;
84
85 $self->{_intra_thread} = 1;
86 }
87 }
28927b50 88}
89
5cf243f6 90=head2 next
91
21b5c39d 92=over 4
93
ebc77b53 94=item Arguments: none
21b5c39d 95
d601dc88 96=item Return Value: \@row_columns
21b5c39d 97
5cf243f6 98=back
99
685dad64 100Advances the cursor to the next row and returns an array of column
101values (the result of L<DBI/fetchrow_array> method).
5cf243f6 102
103=cut
104
a2f22854 105sub next {
106 my $self = shift;
107
108 return if $self->{_done};
109
110 my $sth;
1346e22d 111
22ed9526 112 if (
113 $self->{attrs}{software_limit}
114 && $self->{attrs}{rows}
a2f22854 115 && ($self->{_pos}||0) >= $self->{attrs}{rows}
22ed9526 116 ) {
a2f22854 117 if ($sth = $self->sth) {
118 # explicit finish will issue warnings, unlike the DESTROY below
119 $sth->finish if $sth->FETCH('Active');
120 }
dfa92e5e 121 $self->{_done} = 1;
a2f22854 122 return;
cb5f2eea 123 }
dfa92e5e 124
a2f22854 125 unless ($sth = $self->sth) {
544671d4 126 (undef, $sth, undef) = $self->storage->_select( @{$self->{args}} );
127
128 $self->{_results} = [ (undef) x $sth->FETCH('NUM_OF_FIELDS') ];
129 $sth->bind_columns( \( @{$self->{_results}} ) );
a2f22854 130
131 if ( $self->{attrs}{software_limit} and $self->{attrs}{offset} ) {
132 $sth->fetch for 1 .. $self->{attrs}{offset};
5c91499f 133 }
a2f22854 134
135 $self->sth($sth);
28927b50 136 }
a2f22854 137
544671d4 138 if ($sth->fetch) {
dfa92e5e 139 $self->{_pos}++;
544671d4 140 return @{$self->{_results}};
cb5f2eea 141 } else {
dfa92e5e 142 $self->{_done} = 1;
544671d4 143 return ();
cb5f2eea 144 }
dbaee748 145}
146
a2f22854 147
5cf243f6 148=head2 all
149
21b5c39d 150=over 4
151
ebc77b53 152=item Arguments: none
21b5c39d 153
d601dc88 154=item Return Value: \@row_columns+
21b5c39d 155
5cf243f6 156=back
157
21b5c39d 158Returns a list of arrayrefs of column values for all rows in the
159L<DBIx::Class::ResultSet>.
5cf243f6 160
161=cut
162
a2f22854 163sub all {
164 my $self = shift;
165
166 # delegate to DBIC::Cursor which will delegate back to next()
167 if ($self->{attrs}{software_limit}
168 && ($self->{attrs}{offset} || $self->{attrs}{rows})) {
169 return $self->next::method(@_);
170 }
171
172 my $sth;
173
174 if ($sth = $self->sth) {
175 # explicit finish will issue warnings, unlike the DESTROY below
176 $sth->finish if ( ! $self->{_done} and $sth->FETCH('Active') );
177 $self->sth(undef);
178 }
179
180 (undef, $sth) = $self->storage->_select( @{$self->{args}} );
1346e22d 181
1b658919 182 return (
183 DBIx::Class::_ENV_::SHUFFLE_UNORDERED_RESULTSETS
184 and
185 ! $self->{attrs}{order_by}
186 )
187 ? shuffle @{$sth->fetchall_arrayref}
188 : @{$sth->fetchall_arrayref}
189 ;
1a14aa3f 190}
191
a2f22854 192sub sth {
193 my $self = shift;
194
195 if (@_) {
196 delete @{$self}{qw/_pos _done _pid _intra_thread/};
197
198 $self->{sth} = $_[0];
199 $self->{_pid} = $$ if ! DBIx::Class::_ENV_::BROKEN_FORK and $_[0];
200 }
201 elsif ($self->{sth} and ! $self->{_done}) {
202
203 my $invalidate_handle_reason;
204
205 if (DBIx::Class::_ENV_::HAS_ITHREADS and $self->{_intra_thread} ) {
206 $invalidate_handle_reason = 'Multi-thread';
207 }
208 elsif (!DBIx::Class::_ENV_::BROKEN_FORK and $self->{_pid} != $$ ) {
209 $invalidate_handle_reason = 'Multi-process';
210 }
211
212 if ($invalidate_handle_reason) {
213 $self->storage->throw_exception("$invalidate_handle_reason access attempted while cursor in progress (position $self->{_pos})")
214 if $self->{_pos};
215
216 # reinvokes the reset logic above
217 $self->sth(undef);
218 }
6296f45b 219 }
22ed9526 220
a2f22854 221 return $self->{sth};
dbaee748 222}
223
5cf243f6 224=head2 reset
225
5cf243f6 226Resets the cursor to the beginning of the L<DBIx::Class::ResultSet>.
227
228=cut
229
28927b50 230sub reset {
a2f22854 231 $_[0]->__finish_sth if $_[0]->{sth};
232 $_[0]->sth(undef);
1346e22d 233}
234
1346e22d 235
a2f22854 236sub DESTROY {
3d56e026 237 return if &detect_reinvoked_destructor;
238
a2f22854 239 $_[0]->__finish_sth if $_[0]->{sth};
28927b50 240}
241
a2f22854 242sub __finish_sth {
243 # It is (sadly) extremely important to finish() handles we are about
244 # to lose (due to reset() or a DESTROY() ). $rs->reset is the closest
245 # thing the user has to getting to the underlying finish() API and some
246 # DBDs mandate this (e.g. DBD::InterBase will segfault, DBD::Sybase
247 # won't start a transaction sanely, etc)
248 # We also can't use the accessor here, as it will trigger a fork/thread
249 # check, and resetting a cursor in a child is perfectly valid
1346e22d 250
a2f22854 251 my $self = shift;
1346e22d 252
a2f22854 253 # No need to care about failures here
254 try { local $SIG{__WARN__} = sub {}; $self->{sth}->finish } if (
255 $self->{sth} and ! try { ! $self->{sth}->FETCH('Active') }
256 );
28927b50 257}
258
a2bd3796 259=head1 FURTHER QUESTIONS?
260
261Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>.
262
263=head1 COPYRIGHT AND LICENSE
264
265This module is free software L<copyright|DBIx::Class/COPYRIGHT AND LICENSE>
266by the L<DBIx::Class (DBIC) authors|DBIx::Class/AUTHORS>. You can
267redistribute it and/or modify it under the same terms as the
268L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>.
269
270=cut
271
28927b50 2721;