packaging one directory
|
1 |
package DBIx::Custom::Result; |
fix some bug
|
2 |
use base 'Object::Simple'; |
update document
|
3 | |
packaging one directory
|
4 |
use strict; |
5 |
use warnings; |
|
6 |
use Carp 'croak'; |
|
7 | ||
catch up with Object::Simple...
|
8 |
__PACKAGE__->attr([qw/_dbi sth fetch_filter/]); |
cleanup
|
9 |
__PACKAGE__->attr(_no_fetch_filters => sub { {} }); |
update document
|
10 | |
cleanup
|
11 |
sub new { |
12 |
my $self = shift->SUPER::new(@_); |
|
13 |
|
|
cleanup
|
14 |
$self->no_fetch_filters($self->{no_fetch_filters}) |
15 |
if exists $self->{no_fetch_filters}; |
|
cleanup
|
16 |
|
17 |
return $self; |
|
18 |
} |
|
packaging one directory
|
19 | |
cleanup
|
20 |
sub no_fetch_filters { |
21 |
my $self = shift; |
|
22 |
|
|
23 |
if (@_) { |
|
24 |
|
|
25 |
$self->{no_fetch_filters} = $_[0]; |
|
26 |
|
|
27 |
my %no_fetch_filters = map {$_ => 1} @{$self->{no_fetch_filters}}; |
|
28 |
|
|
29 |
$self->_no_fetch_filters(\%no_fetch_filters); |
|
30 |
|
|
31 |
return $self; |
|
32 |
} |
|
33 |
|
|
34 |
return $self->{no_fetch_filters}; |
|
35 |
} |
|
36 | ||
packaging one directory
|
37 |
sub fetch { |
38 |
my ($self, $type) = @_; |
|
39 |
my $sth = $self->sth; |
|
40 |
my $fetch_filter = $self->fetch_filter; |
|
41 |
|
|
42 |
# Fetch |
|
43 |
my $row = $sth->fetchrow_arrayref; |
|
44 |
|
|
45 |
# Cannot fetch |
|
46 |
return unless $row; |
|
47 |
|
|
48 |
# Filter |
|
49 |
if ($fetch_filter) { |
|
50 |
my $keys = $sth->{NAME_lc}; |
|
51 |
my $types = $sth->{TYPE}; |
|
52 |
for (my $i = 0; $i < @$keys; $i++) { |
|
cleanup
|
53 |
next if $self->_no_fetch_filters->{$keys->[$i]}; |
bind_filter argument is chan...
|
54 |
$row->[$i]= $fetch_filter->($row->[$i], $keys->[$i], $self->_dbi, |
55 |
{type => $types->[$i], sth => $sth, index => $i}); |
|
packaging one directory
|
56 |
} |
57 |
} |
|
58 |
return wantarray ? @$row : $row; |
|
59 |
} |
|
60 | ||
61 |
sub fetch_hash { |
|
62 |
my $self = shift; |
|
63 |
my $sth = $self->sth; |
|
64 |
my $fetch_filter = $self->fetch_filter; |
|
65 |
|
|
66 |
# Fetch |
|
67 |
my $row = $sth->fetchrow_arrayref; |
|
68 |
|
|
69 |
# Cannot fetch |
|
70 |
return unless $row; |
|
71 |
|
|
72 |
# Keys |
|
73 |
my $keys = $sth->{NAME_lc}; |
|
74 |
|
|
75 |
# Filter |
|
76 |
my $row_hash = {}; |
|
77 |
if ($fetch_filter) { |
|
78 |
my $types = $sth->{TYPE}; |
|
79 |
for (my $i = 0; $i < @$keys; $i++) { |
|
cleanup
|
80 |
if ($self->_no_fetch_filters->{$keys->[$i]}) { |
packaging one directory
|
81 |
$row_hash->{$keys->[$i]} = $row->[$i]; |
82 |
} |
|
83 |
else { |
|
84 |
$row_hash->{$keys->[$i]} |
|
bind_filter argument is chan...
|
85 |
= $fetch_filter->($row->[$i], $keys->[$i], $self->_dbi, |
86 |
{type => $types->[$i], sth => $sth, index => $i}); |
|
packaging one directory
|
87 |
} |
88 |
} |
|
89 |
} |
|
90 |
|
|
91 |
# No filter |
|
92 |
else { |
|
93 |
for (my $i = 0; $i < @$keys; $i++) { |
|
94 |
$row_hash->{$keys->[$i]} = $row->[$i]; |
|
95 |
} |
|
96 |
} |
|
97 |
return wantarray ? %$row_hash : $row_hash; |
|
98 |
} |
|
99 | ||
rename fetch_first to fetch_...
|
100 |
sub fetch_single { |
packaging one directory
|
101 |
my $self = shift; |
102 |
|
|
103 |
# Fetch |
|
104 |
my $row = $self->fetch; |
|
105 |
|
|
106 |
# Not exist |
|
107 |
return unless $row; |
|
108 |
|
|
109 |
# Finish statement handle |
|
110 |
$self->finish; |
|
111 |
|
|
112 |
return wantarray ? @$row : $row; |
|
113 |
} |
|
114 | ||
rename fetch_first to fetch_...
|
115 |
sub fetch_hash_single { |
packaging one directory
|
116 |
my $self = shift; |
117 |
|
|
118 |
# Fetch hash |
|
119 |
my $row = $self->fetch_hash; |
|
120 |
|
|
121 |
# Not exist |
|
122 |
return unless $row; |
|
123 |
|
|
124 |
# Finish statement handle |
|
125 |
$self->finish; |
|
126 |
|
|
127 |
return wantarray ? %$row : $row; |
|
128 |
} |
|
129 | ||
130 |
sub fetch_rows { |
|
131 |
my ($self, $count) = @_; |
|
132 |
|
|
133 |
# Not specified Row count |
|
134 |
croak("Row count must be specified") |
|
135 |
unless $count; |
|
136 |
|
|
137 |
# Fetch multi rows |
|
138 |
my $rows = []; |
|
139 |
for (my $i = 0; $i < $count; $i++) { |
|
140 |
my @row = $self->fetch; |
|
141 |
|
|
142 |
last unless @row; |
|
143 |
|
|
144 |
push @$rows, \@row; |
|
145 |
} |
|
146 |
|
|
147 |
return unless @$rows; |
|
148 |
return wantarray ? @$rows : $rows; |
|
149 |
} |
|
150 | ||
151 |
sub fetch_hash_rows { |
|
152 |
my ($self, $count) = @_; |
|
153 |
|
|
154 |
# Not specified Row count |
|
155 |
croak("Row count must be specified") |
|
156 |
unless $count; |
|
157 |
|
|
158 |
# Fetch multi rows |
|
159 |
my $rows = []; |
|
160 |
for (my $i = 0; $i < $count; $i++) { |
|
161 |
my %row = $self->fetch_hash; |
|
162 |
|
|
163 |
last unless %row; |
|
164 |
|
|
165 |
push @$rows, \%row; |
|
166 |
} |
|
167 |
|
|
168 |
return unless @$rows; |
|
169 |
return wantarray ? @$rows : $rows; |
|
170 |
} |
|
171 | ||
172 |
sub fetch_all { |
|
173 |
my $self = shift; |
|
174 |
|
|
175 |
my $rows = []; |
|
176 |
while(my @row = $self->fetch) { |
|
177 |
push @$rows, [@row]; |
|
178 |
} |
|
179 |
return wantarray ? @$rows : $rows; |
|
180 |
} |
|
181 | ||
182 |
sub fetch_hash_all { |
|
183 |
my $self = shift; |
|
184 |
|
|
185 |
my $rows = []; |
|
186 |
while(my %row = $self->fetch_hash) { |
|
187 |
push @$rows, {%row}; |
|
188 |
} |
|
189 |
return wantarray ? @$rows : $rows; |
|
190 |
} |
|
191 | ||
192 |
sub finish { shift->sth->finish } |
|
193 | ||
194 |
sub error { |
|
195 |
my $self = shift; |
|
196 |
my $sth = $self->sth; |
|
197 |
return wantarray ? ($sth->errstr, $sth->err, $sth->state) : $sth->errstr; |
|
198 |
} |
|
199 | ||
200 |
=head1 NAME |
|
201 | ||
update document
|
202 |
DBIx::Custom::Result - DBIx::Custom Resultset |
packaging one directory
|
203 | |
update document
|
204 |
=head1 Synopsis |
packaging one directory
|
205 | |
version 0.0901
|
206 |
my $result = $dbi->query($query); |
packaging one directory
|
207 |
|
version 0.0901
|
208 |
# Fetch |
209 |
while (my @row = $result->fetch) { |
|
210 |
# Do something |
|
211 |
} |
|
212 |
|
|
213 |
# Fetch hash |
|
214 |
while (my %row = $result->fetch_hash) { |
|
215 |
# Do something |
|
packaging one directory
|
216 |
} |
217 | ||
update document
|
218 |
=head1 Accessors |
packaging one directory
|
219 | |
220 |
=head2 sth |
|
221 | ||
update document
|
222 |
Set and Get statement handle |
223 | ||
version 0.0901
|
224 |
$result = $result->sth($sth); |
225 |
$sth = $reuslt->sth |
|
update document
|
226 |
|
packaging one directory
|
227 |
=head2 fetch_filter |
228 | ||
update document
|
229 |
Set and Get fetch filter |
230 | ||
version 0.0901
|
231 |
$result = $result->fetch_filter($sth); |
232 |
$fetch_filter = $result->fech_filter; |
|
packaging one directory
|
233 | |
234 |
=head2 no_fetch_filters |
|
235 | ||
update document
|
236 |
Set and Get no filter keys when fetching |
237 | ||
version 0.0901
|
238 |
$result = $result->no_fetch_filters($no_fetch_filters); |
packaging one directory
|
239 |
$no_fetch_filters = $result->no_fetch_filters; |
240 | ||
update document
|
241 |
=head1 Methods |
packaging one directory
|
242 | |
cleanup
|
243 |
=head2 new |
244 | ||
245 |
my $result = DBIx::Custom::Result->new; |
|
246 | ||
packaging one directory
|
247 |
=head2 fetch |
248 | ||
update document
|
249 |
Fetch a row |
250 | ||
version 0.0901
|
251 |
$row = $result->fetch; # array reference |
252 |
@row = $result->fecth; # array |
|
253 | ||
254 |
The following is fetch sample |
|
packaging one directory
|
255 | |
256 |
while (my $row = $result->fetch) { |
|
257 |
# do something |
|
258 |
my $val1 = $row->[0]; |
|
259 |
my $val2 = $row->[1]; |
|
260 |
} |
|
261 | ||
262 |
=head2 fetch_hash |
|
263 | ||
update document
|
264 |
Fetch row as hash |
265 | ||
version 0.0901
|
266 |
$row = $result->fetch_hash; # hash reference |
267 |
%row = $result->fetch_hash; # hash |
|
268 | ||
269 |
The following is fetch_hash sample |
|
packaging one directory
|
270 | |
271 |
while (my $row = $result->fetch_hash) { |
|
272 |
# do something |
|
273 |
my $val1 = $row->{key1}; |
|
274 |
my $val2 = $row->{key2}; |
|
275 |
} |
|
276 | ||
rename fetch_first to fetch_...
|
277 |
=head2 fetch_single |
packaging one directory
|
278 | |
update document
|
279 |
Fetch only first row(Scalar context) |
280 | ||
rename fetch_first to fetch_...
|
281 |
$row = $result->fetch_single; # array reference |
282 |
@row = $result->fetch_single; # array |
|
packaging one directory
|
283 |
|
rename fetch_first to fetch_...
|
284 |
The following is fetch_single sample |
version 0.0901
|
285 | |
rename fetch_first to fetch_...
|
286 |
$row = $result->fetch_single; |
packaging one directory
|
287 |
|
update document
|
288 |
This method fetch only first row and finish statement handle |
packaging one directory
|
289 | |
rename fetch_first to fetch_...
|
290 |
=head2 fetch_hash_single |
packaging one directory
|
291 |
|
update document
|
292 |
Fetch only first row as hash |
293 | ||
rename fetch_first to fetch_...
|
294 |
$row = $result->fetch_hash_single; # hash reference |
295 |
%row = $result->fetch_hash_single; # hash |
|
packaging one directory
|
296 |
|
rename fetch_first to fetch_...
|
297 |
The following is fetch_hash_single sample |
version 0.0901
|
298 | |
rename fetch_first to fetch_...
|
299 |
$row = $result->fetch_hash_single; |
packaging one directory
|
300 |
|
rename fetch_first to fetch_...
|
301 |
This method fetch only single row and finish statement handle |
packaging one directory
|
302 | |
303 |
=head2 fetch_rows |
|
304 | ||
update document
|
305 |
Fetch rows |
306 | ||
version 0.0901
|
307 |
$rows = $result->fetch_rows($row_count); # array ref of array ref |
308 |
@rows = $result->fetch_rows($row_count); # array of array ref |
|
packaging one directory
|
309 |
|
version 0.0901
|
310 |
The following is fetch_rows sample |
311 | ||
update document
|
312 |
while(my $rows = $result->fetch_rows(10)) { |
313 |
# do someting |
|
314 |
} |
|
packaging one directory
|
315 | |
316 |
=head2 fetch_hash_rows |
|
317 | ||
update document
|
318 |
Fetch rows as hash |
319 | ||
version 0.0901
|
320 |
$rows = $result->fetch_hash_rows($row_count); # array ref of hash ref |
321 |
@rows = $result->fetch_hash_rows($row_count); # array of hash ref |
|
packaging one directory
|
322 |
|
version 0.0901
|
323 |
The following is fetch_hash_rows sample |
324 | ||
update document
|
325 |
while(my $rows = $result->fetch_hash_rows(10)) { |
326 |
# do someting |
|
327 |
} |
|
packaging one directory
|
328 | |
329 |
=head2 fetch_all |
|
330 | ||
update document
|
331 |
Fetch all rows |
332 | ||
version 0.0901
|
333 |
$rows = $result->fetch_all; # array ref of array ref |
334 |
@rows = $result->fecth_all; # array of array ref |
|
335 | ||
336 |
The following is fetch_all sample |
|
packaging one directory
|
337 | |
338 |
my $rows = $result->fetch_all; |
|
339 | ||
340 |
=head2 fetch_hash_all |
|
341 | ||
update document
|
342 |
Fetch all row as array ref of hash ref (Scalar context) |
343 | ||
version 0.0901
|
344 |
$rows = $result->fetch_hash_all; # array ref of hash ref |
345 |
@rows = $result->fecth_all_hash; # array of hash ref |
|
346 | ||
347 |
The following is fetch_hash_all sample |
|
packaging one directory
|
348 | |
349 |
my $rows = $result->fetch_hash_all; |
|
350 | ||
351 |
=head2 error |
|
352 | ||
update document
|
353 |
Get error infomation |
354 | ||
version 0.0901
|
355 |
$error_messege = $result->error; |
356 |
($error_message, $error_number, $error_state) = $result->error; |
|
update document
|
357 |
|
packaging one directory
|
358 | |
update document
|
359 |
You can get get information. This is same as the following. |
packaging one directory
|
360 | |
361 |
$error_message : $result->sth->errstr |
|
362 |
$error_number : $result->sth->err |
|
363 |
$error_state : $result->sth->state |
|
364 | ||
365 |
=head2 finish |
|
366 | ||
update document
|
367 |
Finish statement handle |
368 | ||
packaging one directory
|
369 |
$result->finish |
370 | ||
update document
|
371 |
This is equel to |
packaging one directory
|
372 | |
373 |
$result->sth->finish; |
|
374 | ||
update document
|
375 |
=head1 See also |
376 | ||
377 |
L<DBIx::Custom> |
|
378 | ||
379 |
=head1 Author |
|
packaging one directory
|
380 | |
381 |
Yuki Kimoto, C<< <kimoto.yuki at gmail.com> >> |
|
382 | ||
383 |
Github L<http://github.com/yuki-kimoto> |
|
384 | ||
update document
|
385 |
=head1 Copyright & licence |
packaging one directory
|
386 | |
387 |
Copyright 2009 Yuki Kimoto, all rights reserved. |
|
388 | ||
389 |
This program is free software; you can redistribute it and/or modify it |
|
390 |
under the same terms as Perl itself. |
|
391 | ||
392 |
=cut |
|
catch up with Object::Simple...
|
393 | |
394 |
1; |