I was wrong about 2d12a809 - the crash is real
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Storage / DBI / Cursor.pm
1 package DBIx::Class::Storage::DBI::Cursor;
2
3 use strict;
4 use warnings;
5
6 use base qw/DBIx::Class::Cursor/;
7
8 use Try::Tiny;
9 use namespace::clean;
10
11 __PACKAGE__->mk_group_accessors('simple' =>
12     qw/sth storage args attrs/
13 );
14
15 =head1 NAME
16
17 DBIx::Class::Storage::DBI::Cursor - Object representing a query cursor on a
18 resultset.
19
20 =head1 SYNOPSIS
21
22   my $cursor = $schema->resultset('CD')->cursor();
23
24   # raw values off the database handle in resultset columns/select order
25   my @next_cd_column_values = $cursor->next;
26
27   # list of all raw values as arrayrefs
28   my @all_cds_column_values = $cursor->all;
29
30 =head1 DESCRIPTION
31
32 A Cursor represents a query cursor on a L<DBIx::Class::ResultSet> object. It
33 allows for traversing the result set with L</next>, retrieving all results with
34 L</all> and resetting the cursor with L</reset>.
35
36 Usually, you would use the cursor methods built into L<DBIx::Class::ResultSet>
37 to traverse it. See L<DBIx::Class::ResultSet/next>,
38 L<DBIx::Class::ResultSet/reset> and L<DBIx::Class::ResultSet/all> for more
39 information.
40
41 =head1 METHODS
42
43 =head2 new
44
45 Returns a new L<DBIx::Class::Storage::DBI::Cursor> object.
46
47 =cut
48
49 sub new {
50   my ($class, $storage, $args, $attrs) = @_;
51   $class = ref $class if ref $class;
52
53   my $new = {
54     storage => $storage,
55     args => $args,
56     attrs => $attrs,
57     _dbh_gen => $storage->{_dbh_gen},
58     _pos => 0,
59     _done => 0,
60   };
61
62   return bless ($new, $class);
63 }
64
65 =head2 next
66
67 =over 4
68
69 =item Arguments: none
70
71 =item Return Value: \@row_columns
72
73 =back
74
75 Advances the cursor to the next row and returns an array of column
76 values (the result of L<DBI/fetchrow_array> method).
77
78 =cut
79
80 sub _dbh_next {
81   my ($storage, $dbh, $self) = @_;
82
83   $self->_check_dbh_gen;
84   if (
85     $self->{attrs}{software_limit}
86       && $self->{attrs}{rows}
87         && $self->{_pos} >= $self->{attrs}{rows}
88   ) {
89     $self->sth->finish if $self->sth->{Active};
90     $self->sth(undef);
91     $self->{_done} = 1;
92   }
93
94   return if $self->{_done};
95
96   unless ($self->sth) {
97     $self->sth(($storage->_select(@{$self->{args}}))[1]);
98     if ($self->{attrs}{software_limit}) {
99       if (my $offset = $self->{attrs}{offset}) {
100         $self->sth->fetch for 1 .. $offset;
101       }
102     }
103   }
104   my @row = $self->sth->fetchrow_array;
105   if (@row) {
106     $self->{_pos}++;
107   } else {
108     $self->sth(undef);
109     $self->{_done} = 1;
110   }
111   return @row;
112 }
113
114 sub next {
115   my ($self) = @_;
116   $self->{storage}->dbh_do($self->can('_dbh_next'), $self);
117 }
118
119 =head2 all
120
121 =over 4
122
123 =item Arguments: none
124
125 =item Return Value: \@row_columns+
126
127 =back
128
129 Returns a list of arrayrefs of column values for all rows in the
130 L<DBIx::Class::ResultSet>.
131
132 =cut
133
134 sub _dbh_all {
135   my ($storage, $dbh, $self) = @_;
136
137   $self->_check_dbh_gen;
138   $self->sth->finish if $self->sth && $self->sth->{Active};
139   $self->sth(undef);
140   my ($rv, $sth) = $storage->_select(@{$self->{args}});
141   return @{$sth->fetchall_arrayref};
142 }
143
144 sub all {
145   my ($self) = @_;
146   if ($self->{attrs}{software_limit}
147         && ($self->{attrs}{offset} || $self->{attrs}{rows})) {
148     return $self->next::method;
149   }
150
151   $self->{storage}->dbh_do($self->can('_dbh_all'), $self);
152 }
153
154 =head2 reset
155
156 Resets the cursor to the beginning of the L<DBIx::Class::ResultSet>.
157
158 =cut
159
160 sub reset {
161   my ($self) = @_;
162
163   # No need to care about failures here
164   try { $self->sth->finish }
165     if $self->sth && $self->sth->{Active};
166   $self->_soft_reset;
167   return undef;
168 }
169
170 sub _soft_reset {
171   my ($self) = @_;
172
173   $self->sth(undef);
174   $self->{_done} = 0;
175   $self->{_pos} = 0;
176 }
177
178 sub _check_dbh_gen {
179   my ($self) = @_;
180
181   if($self->{_dbh_gen} != $self->{storage}->{_dbh_gen}) {
182     $self->{_dbh_gen} = $self->{storage}->{_dbh_gen};
183     $self->_soft_reset;
184   }
185 }
186
187 sub DESTROY {
188   # None of the reasons this would die matter if we're in DESTROY anyways
189   if (my $sth = $_[0]->sth) {
190     local $SIG{__WARN__} = sub {};
191     try { $sth->finish } if $sth->FETCH('Active');
192   }
193 }
194
195 1;