packaging one directory
|
1 |
package DBIx::Custom::Result; |
update document
|
2 | |
packaging one directory
|
3 |
use strict; |
4 |
use warnings; |
|
update document
|
5 | |
6 |
use base 'Object::Simple'; |
|
cleanup
|
7 | |
packaging one directory
|
8 |
use Carp 'croak'; |
9 | ||
cleanup
|
10 |
__PACKAGE__->attr([qw/filter_check filters sth/]); |
11 | ||
12 |
sub filter { |
|
13 |
my $self = shift; |
|
cleanup
|
14 |
|
15 |
if (@_) { |
|
16 |
my $filter = ref $_[0] eq 'HASH' ? $_[0] : {@_}; |
|
17 |
|
|
18 |
foreach my $column (keys %$filter) { |
|
19 |
my $fname = $filter->{$column}; |
|
20 |
unless (ref $fname eq 'CODE') { |
|
21 |
croak qq{"$fname" is not registered"} |
|
22 |
unless exists $self->filters->{$fname}; |
|
23 |
|
|
24 |
$filter->{$column} = $self->filters->{$fname}; |
|
25 |
} |
|
cleanup
|
26 |
} |
cleanup
|
27 |
|
added experimental DBIx::Cus...
|
28 |
$self->{filter} = {%{$self->filter}, %$filter}; |
cleanup
|
29 |
|
30 |
return $self; |
|
cleanup
|
31 |
} |
32 |
|
|
added experimental DBIx::Cus...
|
33 |
return $self->{filter} ||= {}; |
34 |
} |
|
35 | ||
36 |
sub end_filter { |
|
37 |
my $self = shift; |
|
38 |
|
|
39 |
if (@_) { |
|
40 |
my $end_filter = ref $_[0] eq 'HASH' ? $_[0] : {@_}; |
|
41 |
|
|
42 |
foreach my $column (keys %$end_filter) { |
|
43 |
my $fname = $end_filter->{$column}; |
|
44 |
unless (ref $fname eq 'CODE') { |
|
45 |
croak qq{"$fname" is not registered"} |
|
46 |
unless exists $self->filters->{$fname}; |
|
47 |
|
|
48 |
$end_filter->{$column} = $self->filters->{$fname}; |
|
49 |
} |
|
50 |
} |
|
51 |
|
|
52 |
$self->{end_filter} = {%{$self->end_filter}, %$end_filter}; |
|
53 |
|
|
54 |
return $self; |
|
55 |
} |
|
56 |
|
|
57 |
return $self->{end_filter} ||= {}; |
|
cleanup
|
58 |
} |
cleanup
|
59 | |
packaging one directory
|
60 |
sub fetch { |
changed argument of tag proc...
|
61 |
my $self = shift; |
62 |
|
|
cleanup
|
63 |
# Filter |
added experimental DBIx::Cus...
|
64 |
my $filter = $self->filter; |
65 |
|
|
66 |
# End filter |
|
67 |
my $end_filter = $self->end_filter; |
|
packaging one directory
|
68 |
|
69 |
# Fetch |
|
changed argument of tag proc...
|
70 |
my @row = $self->{sth}->fetchrow_array; |
packaging one directory
|
71 |
|
cleanup
|
72 |
# No row |
update document
|
73 |
return unless @row; |
added check_filter attribute
|
74 |
|
cleanup
|
75 |
# Filtering |
added experimental iterate_a...
|
76 |
my $columns = $self->{sth}->{NAME}; |
cleanup
|
77 |
for (my $i = 0; $i < @$columns; $i++) { |
update document
|
78 |
|
changed argument of tag proc...
|
79 |
# Filter name |
cleanup
|
80 |
my $column = $columns->[$i]; |
cleanup
|
81 |
my $f = exists $filter->{$column} |
82 |
? $filter->{$column} |
|
cleanup
|
83 |
: $self->default_filter; |
added experimental DBIx::Cus...
|
84 |
my $ef = $end_filter->{$column}; |
some changed
|
85 |
|
cleanup
|
86 |
# Filtering |
cleanup
|
87 |
$row[$i] = $f->($row[$i]) if $f; |
added experimental DBIx::Cus...
|
88 |
$row[$i] = $ef->($row[$i]) if $ef; |
packaging one directory
|
89 |
} |
many many changes
|
90 | |
removed reconnect method
|
91 |
return \@row; |
92 |
} |
|
93 | ||
cleanup
|
94 |
sub fetch_all { |
95 |
my $self = shift; |
|
96 |
|
|
97 |
# Fetch all rows |
|
98 |
my $rows = []; |
|
99 |
while(my $row = $self->fetch) { |
|
100 |
push @$rows, $row; |
|
101 |
} |
|
102 |
return $rows; |
|
103 |
} |
|
104 | ||
removed reconnect method
|
105 |
sub fetch_first { |
106 |
my $self = shift; |
|
107 |
|
|
108 |
# Fetch |
|
109 |
my $row = $self->fetch; |
|
110 |
|
|
cleanup
|
111 |
# No row |
removed reconnect method
|
112 |
return unless $row; |
113 |
|
|
114 |
# Finish statement handle |
|
115 |
$self->sth->finish; |
|
116 |
|
|
117 |
return $row; |
|
118 |
} |
|
119 | ||
packaging one directory
|
120 |
sub fetch_hash { |
changed argument of tag proc...
|
121 |
my $self = shift; |
122 |
|
|
cleanup
|
123 |
# Filter |
added experimental DBIx::Cus...
|
124 |
my $filter = $self->filter; |
125 |
|
|
126 |
# End filter |
|
127 |
my $end_filter = $self->end_filter; |
|
packaging one directory
|
128 |
|
129 |
# Fetch |
|
changed argument of tag proc...
|
130 |
my $row = $self->{sth}->fetchrow_arrayref; |
packaging one directory
|
131 |
|
132 |
# Cannot fetch |
|
133 |
return unless $row; |
|
added check_filter attribute
|
134 | |
packaging one directory
|
135 |
# Filter |
136 |
my $row_hash = {}; |
|
added experimental iterate_a...
|
137 |
my $columns = $self->{sth}->{NAME}; |
cleanup
|
138 |
for (my $i = 0; $i < @$columns; $i++) { |
update document
|
139 |
|
changed argument of tag proc...
|
140 |
# Filter name |
cleanup
|
141 |
my $column = $columns->[$i]; |
cleanup
|
142 |
my $f = exists $filter->{$column} |
143 |
? $filter->{$column} |
|
cleanup
|
144 |
: $self->default_filter; |
added experimental DBIx::Cus...
|
145 |
my $ef = $end_filter->{$column}; |
add query filter error check
|
146 |
|
cleanup
|
147 |
# Filtering |
cleanup
|
148 |
$row_hash->{$column} = $f ? $f->($row->[$i]) : $row->[$i]; |
added experimental DBIx::Cus...
|
149 |
$row_hash->{$column} = $ef->($row_hash->{$column}) if $ef; |
packaging one directory
|
150 |
} |
151 |
|
|
removed reconnect method
|
152 |
return $row_hash; |
packaging one directory
|
153 |
} |
154 | ||
cleanup
|
155 |
sub fetch_hash_all { |
156 |
my $self = shift; |
|
157 |
|
|
158 |
# Fetch all rows as hash |
|
159 |
my $rows = []; |
|
160 |
while(my $row = $self->fetch_hash) { |
|
161 |
push @$rows, $row; |
|
162 |
} |
|
163 |
|
|
164 |
return $rows; |
|
165 |
} |
|
166 | ||
removed reconnect method
|
167 |
sub fetch_hash_first { |
packaging one directory
|
168 |
my $self = shift; |
169 |
|
|
170 |
# Fetch hash |
|
171 |
my $row = $self->fetch_hash; |
|
172 |
|
|
cleanup
|
173 |
# No row |
packaging one directory
|
174 |
return unless $row; |
175 |
|
|
176 |
# Finish statement handle |
|
some changed
|
177 |
$self->sth->finish; |
packaging one directory
|
178 |
|
removed reconnect method
|
179 |
return $row; |
packaging one directory
|
180 |
} |
181 | ||
renamed fetch_rows to fetch_...
|
182 |
sub fetch_hash_multi { |
packaging one directory
|
183 |
my ($self, $count) = @_; |
184 |
|
|
cleanup
|
185 |
# Row count not specified |
changed argument of tag proc...
|
186 |
croak 'Row count must be specified' |
packaging one directory
|
187 |
unless $count; |
188 |
|
|
189 |
# Fetch multi rows |
|
190 |
my $rows = []; |
|
191 |
for (my $i = 0; $i < $count; $i++) { |
|
removed reconnect method
|
192 |
my $row = $self->fetch_hash; |
193 |
last unless $row; |
|
194 |
push @$rows, $row; |
|
packaging one directory
|
195 |
} |
196 |
|
|
197 |
return unless @$rows; |
|
removed reconnect method
|
198 |
return $rows; |
packaging one directory
|
199 |
} |
200 | ||
cleanup
|
201 |
sub fetch_multi { |
202 |
my ($self, $count) = @_; |
|
packaging one directory
|
203 |
|
cleanup
|
204 |
# Row count not specifed |
205 |
croak 'Row count must be specified' |
|
206 |
unless $count; |
|
207 |
|
|
208 |
# Fetch multi rows |
|
packaging one directory
|
209 |
my $rows = []; |
cleanup
|
210 |
for (my $i = 0; $i < $count; $i++) { |
211 |
my $row = $self->fetch; |
|
212 |
last unless $row; |
|
removed reconnect method
|
213 |
push @$rows, $row; |
packaging one directory
|
214 |
} |
changed argument of tag proc...
|
215 |
|
cleanup
|
216 |
return unless @$rows; |
removed reconnect method
|
217 |
return $rows; |
packaging one directory
|
218 |
} |
219 | ||
cleanup
|
220 |
# Deprecated |
221 |
sub default_filter { |
|
222 |
my $self = shift; |
|
223 |
|
|
224 |
if (@_) { |
|
225 |
my $fname = $_[0]; |
|
226 |
if (@_ && !$fname) { |
|
227 |
$self->{default_filter} = undef; |
|
228 |
} |
|
229 |
else { |
|
230 |
croak qq{"$fname" is not registered} |
|
231 |
unless exists $self->filters->{$fname}; |
|
232 |
|
|
233 |
$self->{default_filter} = $self->filters->{$fname}; |
|
234 |
} |
|
235 |
|
|
236 |
return $self; |
|
237 |
} |
|
238 |
|
|
239 |
return $self->{default_filter}; |
|
240 |
} |
|
241 | ||
update document
|
242 |
1; |
243 | ||
packaging one directory
|
244 |
=head1 NAME |
245 | ||
cleanup
|
246 |
DBIx::Custom::Result - Result of select statement |
packaging one directory
|
247 | |
update document
|
248 |
=head1 SYNOPSIS |
cleanup
|
249 | |
250 |
Get the result of select statement. |
|
251 | ||
removed reconnect method
|
252 |
# Result |
253 |
my $result = $dbi->select(table => 'books'); |
|
cleanup
|
254 | |
255 |
Fetch row into array. |
|
removed reconnect method
|
256 |
|
257 |
# Fetch a row into array |
|
258 |
while (my $row = $result->fetch) { |
|
cleanup
|
259 |
my $author = $row->[0]; |
260 |
my $title = $row->[1]; |
|
removed reconnect method
|
261 |
|
version 0.0901
|
262 |
} |
263 |
|
|
cleanup
|
264 |
# Fetch only a first row into array |
removed reconnect method
|
265 |
my $row = $result->fetch_first; |
266 |
|
|
267 |
# Fetch multiple rows into array of array |
|
268 |
while (my $rows = $result->fetch_multi(5)) { |
|
cleanup
|
269 |
my $first_author = $rows->[0][0]; |
270 |
my $first_title = $rows->[0][1]; |
|
271 |
my $second_author = $rows->[1][0]; |
|
272 |
my $second_value = $rows->[1][1]; |
|
273 |
|
|
removed reconnect method
|
274 |
} |
275 |
|
|
276 |
# Fetch all rows into array of array |
|
277 |
my $rows = $result->fetch_all; |
|
cleanup
|
278 | |
279 |
Fetch row into hash. |
|
280 | ||
281 |
# Fetch a row into hash |
|
removed reconnect method
|
282 |
while (my $row = $result->fetch_hash) { |
cleanup
|
283 |
my $title = $row->{title}; |
284 |
my $author = $row->{author}; |
|
removed reconnect method
|
285 |
|
packaging one directory
|
286 |
} |
removed reconnect method
|
287 |
|
cleanup
|
288 |
# Fetch only a first row into hash |
removed reconnect method
|
289 |
my $row = $result->fetch_hash_first; |
290 |
|
|
291 |
# Fetch multiple rows into array of hash |
|
cleanup
|
292 |
while (my $rows = $result->fetch_hash_multi(5)) { |
293 |
my $first_title = $rows->[0]{title}; |
|
294 |
my $first_author = $rows->[0]{author}; |
|
295 |
my $second_title = $rows->[1]{title}; |
|
296 |
my $second_author = $rows->[1]{author}; |
|
removed reconnect method
|
297 |
} |
298 |
|
|
299 |
# Fetch all rows into array of hash |
|
300 |
my $rows = $result->fetch_hash_all; |
|
packaging one directory
|
301 | |
update document
|
302 |
=head1 ATTRIBUTES |
packaging one directory
|
303 | |
cleanup
|
304 |
Filters when a row is fetched. |
305 |
This overwrites C<default_filter>. |
|
removed DESTROY method(not b...
|
306 | |
cleanup
|
307 |
=head2 C<filters> |
308 | ||
309 |
my $filters = $result->filters; |
|
310 |
$result = $result->filters(\%filters); |
|
311 | ||
312 |
Resistered filters. |
|
313 | ||
314 |
=head2 C<filter_check> |
|
315 | ||
316 |
my $filter_check = $result->filter_check; |
|
317 |
$result = $result->filter_check; |
|
318 | ||
319 |
Enable filter validation. |
|
320 | ||
321 |
=head2 C<sth> |
|
322 | ||
323 |
my $sth = $reuslt->sth |
|
324 |
$result = $result->sth($sth); |
|
325 | ||
326 |
Statement handle of L<DBI>. |
|
327 | ||
update document
|
328 |
=head1 METHODS |
329 | ||
renamed build_query to creat...
|
330 |
L<DBIx::Custom::Result> inherits all methods from L<Object::Simple> |
cleanup
|
331 |
and implements the following new ones. |
packaging one directory
|
332 | |
added experimental DBIx::Cus...
|
333 |
=head2 C<(experimental) end_filter> |
334 | ||
335 |
$result = $result->end_filter(title => 'to_upper_case', |
|
336 |
author => 'to_upper_case'); |
|
337 | ||
338 |
End filters. |
|
339 |
These each filters is executed after the filters applied by C<apply_filter> of |
|
340 |
L<DBIx::Custom> or C<filter> method. |
|
341 | ||
removed DBIx::Custom commit ...
|
342 |
=head2 C<fetch> |
packaging one directory
|
343 | |
cleanup
|
344 |
my $row = $result->fetch; |
version 0.0901
|
345 | |
cleanup
|
346 |
Fetch a row into array. |
packaging one directory
|
347 | |
removed DBIx::Custom commit ...
|
348 |
=head2 C<fetch_all> |
packaging one directory
|
349 | |
cleanup
|
350 |
my $rows = $result->fetch_all; |
version 0.0901
|
351 | |
removed DESTROY method(not b...
|
352 |
Fetch all rows into array of array. |
packaging one directory
|
353 | |
cleanup
|
354 |
=head2 C<fetch_first> |
355 | ||
356 |
my $row = $result->fetch_first; |
|
357 | ||
358 |
Fetch only a first row into array and finish statment handle. |
|
359 | ||
removed DESTROY method(not b...
|
360 |
=head2 C<fetch_hash> |
packaging one directory
|
361 | |
cleanup
|
362 |
my $row = $result->fetch_hash; |
packaging one directory
|
363 | |
removed DESTROY method(not b...
|
364 |
Fetch a row into hash |
update document
|
365 | |
cleanup
|
366 |
=head2 C<fetch_hash_all> |
367 | ||
368 |
my $rows = $result->fetch_hash_all; |
|
369 | ||
370 |
Fetch all rows into array of hash. |
|
371 | ||
removed DBIx::Custom commit ...
|
372 |
=head2 C<fetch_hash_first> |
removed reconnect method
|
373 |
|
cleanup
|
374 |
my $row = $result->fetch_hash_first; |
packaging one directory
|
375 | |
removed DESTROY method(not b...
|
376 |
Fetch only first row into hash and finish statment handle. |
packaging one directory
|
377 | |
removed DESTROY method(not b...
|
378 |
=head2 C<fetch_hash_multi> |
update document
|
379 | |
cleanup
|
380 |
my $rows = $result->fetch_hash_multi(5); |
update document
|
381 |
|
removed DESTROY method(not b...
|
382 |
Fetch multiple rows into array of hash |
cleanup
|
383 |
Row count must be specified. |
update document
|
384 | |
cleanup
|
385 |
=head2 C<fetch_multi> |
packaging one directory
|
386 | |
cleanup
|
387 |
my $rows = $result->fetch_multi(5); |
388 |
|
|
389 |
Fetch multiple rows into array of array. |
|
390 |
Row count must be specified. |
|
removed DESTROY method(not b...
|
391 | |
cleanup
|
392 |
=head2 C<filter> |
393 | ||
added experimental DBIx::Cus...
|
394 |
$result = $result->filter(title => 'to_upper_case', |
395 |
author => 'to_upper_case'); |
|
396 | ||
397 |
Filters. |
|
398 |
These each filters override the filters applied by C<apply_filter> of |
|
399 |
L<DBIx::Custom>. |
|
cleanup
|
400 | |
cleanup
|
401 |
=head2 C<(deprecated) default_filter> |
402 | ||
403 |
my $default_filter = $result->default_filter; |
|
404 |
$result = $result->default_filter($filter); |
|
405 | ||
406 |
Default filter when a row is fetched. |
|
407 | ||
packaging one directory
|
408 |
=cut |