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