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