Newer Older
356 lines | 7.637kb
packaging one directory
yuki-kimoto authored on 2009-11-16
1
package DBIx::Custom::Result;
update document
yuki-kimoto authored on 2009-11-17
2

            
packaging one directory
yuki-kimoto authored on 2009-11-16
3
use strict;
4
use warnings;
update document
yuki-kimoto authored on 2010-01-30
5

            
6
use base 'Object::Simple';
cleanup
yuki-kimoto authored on 2010-02-11
7

            
packaging one directory
yuki-kimoto authored on 2009-11-16
8
use Carp 'croak';
9

            
cleanup
yuki-kimoto authored on 2010-10-17
10
__PACKAGE__->attr([qw/default_filter filter filter_check filters sth/]);
cleanup
yuki-kimoto authored on 2010-01-21
11

            
packaging one directory
yuki-kimoto authored on 2009-11-16
12
sub fetch {
changed argument of tag proc...
yuki-kimoto authored on 2010-08-03
13
    my $self = shift;
14
    
cleanup
yuki-kimoto authored on 2010-08-05
15
    # Filters
added check_filter attribute
yuki-kimoto authored on 2010-08-08
16
    my $filters = $self->{filters} || {};
17
    my $filter  = $self->{filter}  || {};
packaging one directory
yuki-kimoto authored on 2009-11-16
18
    
19
    # Fetch
changed argument of tag proc...
yuki-kimoto authored on 2010-08-03
20
    my @row = $self->{sth}->fetchrow_array;
packaging one directory
yuki-kimoto authored on 2009-11-16
21
    
cleanup
yuki-kimoto authored on 2010-08-05
22
    # No row
update document
yuki-kimoto authored on 2010-05-27
23
    return unless @row;
added check_filter attribute
yuki-kimoto authored on 2010-08-08
24
    
25
    # Check filter
26
    $self->_check_filter($filters, $filter, 
27
                         $self->default_filter, $self->sth)
28
      if $self->{filter_check};
29
    
cleanup
yuki-kimoto authored on 2010-08-05
30
    # Filtering
31
    my $columns = $self->{sth}->{NAME_lc};
32
    for (my $i = 0; $i < @$columns; $i++) {
update document
yuki-kimoto authored on 2010-05-27
33
        
changed argument of tag proc...
yuki-kimoto authored on 2010-08-03
34
        # Filter name
cleanup
yuki-kimoto authored on 2010-08-05
35
        my $column = $columns->[$i];
added check_filter attribute
yuki-kimoto authored on 2010-08-08
36
        my $fname  = exists $filter->{$column}
37
                   ? $filter->{$column}
changed argument of tag proc...
yuki-kimoto authored on 2010-08-03
38
                   : $self->{default_filter};
some changed
yuki-kimoto authored on 2010-05-02
39
        
cleanup
yuki-kimoto authored on 2010-08-05
40
        # Filtering
added check_filter attribute
yuki-kimoto authored on 2010-08-08
41
        $row[$i] = $filters->{$fname}->($row[$i])
changed argument of tag proc...
yuki-kimoto authored on 2010-08-03
42
          if $fname;
packaging one directory
yuki-kimoto authored on 2009-11-16
43
    }
many many changes
yuki-kimoto authored on 2010-04-30
44

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
45
    return \@row;
46
}
47

            
cleanup
yuki-kimoto authored on 2010-10-17
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
yuki-kimoto authored on 2010-05-28
59
sub fetch_first {
60
    my $self = shift;
61
    
62
    # Fetch
63
    my $row = $self->fetch;
64
    
cleanup
yuki-kimoto authored on 2010-08-05
65
    # No row
removed reconnect method
yuki-kimoto authored on 2010-05-28
66
    return unless $row;
67
    
68
    # Finish statement handle
69
    $self->sth->finish;
70
    
71
    return $row;
72
}
73

            
packaging one directory
yuki-kimoto authored on 2009-11-16
74
sub fetch_hash {
changed argument of tag proc...
yuki-kimoto authored on 2010-08-03
75
    my $self = shift;
76
    
cleanup
yuki-kimoto authored on 2010-08-05
77
    # Filters
added check_filter attribute
yuki-kimoto authored on 2010-08-08
78
    my $filters = $self->{filters} || {};
79
    my $filter  = $self->{filter}  || {};
packaging one directory
yuki-kimoto authored on 2009-11-16
80
    
81
    # Fetch
changed argument of tag proc...
yuki-kimoto authored on 2010-08-03
82
    my $row = $self->{sth}->fetchrow_arrayref;
packaging one directory
yuki-kimoto authored on 2009-11-16
83
    
84
    # Cannot fetch
85
    return unless $row;
added check_filter attribute
yuki-kimoto authored on 2010-08-08
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
yuki-kimoto authored on 2009-11-16
92
    # Filter
93
    my $row_hash = {};
cleanup
yuki-kimoto authored on 2010-08-05
94
    my $columns = $self->{sth}->{NAME_lc};
95
    for (my $i = 0; $i < @$columns; $i++) {
update document
yuki-kimoto authored on 2010-05-27
96
        
changed argument of tag proc...
yuki-kimoto authored on 2010-08-03
97
        # Filter name
cleanup
yuki-kimoto authored on 2010-08-05
98
        my $column = $columns->[$i];
added check_filter attribute
yuki-kimoto authored on 2010-08-08
99
        my $fname  = exists $filter->{$column}
100
                   ? $filter->{$column}
changed argument of tag proc...
yuki-kimoto authored on 2010-08-03
101
                   : $self->{default_filter};
add query filter error check
yuki-kimoto authored on 2010-05-14
102
        
cleanup
yuki-kimoto authored on 2010-08-05
103
        # Filtering
changed argument of tag proc...
yuki-kimoto authored on 2010-08-03
104
        $row_hash->{$column}
added check_filter attribute
yuki-kimoto authored on 2010-08-08
105
          = $fname ? $filters->{$fname}->($row->[$i]) 
changed argument of tag proc...
yuki-kimoto authored on 2010-08-03
106
                   : $row->[$i];
packaging one directory
yuki-kimoto authored on 2009-11-16
107
    }
108
    
removed reconnect method
yuki-kimoto authored on 2010-05-28
109
    return $row_hash;
packaging one directory
yuki-kimoto authored on 2009-11-16
110
}
111

            
cleanup
yuki-kimoto authored on 2010-10-17
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
yuki-kimoto authored on 2010-05-28
124
sub fetch_hash_first {
packaging one directory
yuki-kimoto authored on 2009-11-16
125
    my $self = shift;
126
    
127
    # Fetch hash
128
    my $row = $self->fetch_hash;
129
    
cleanup
yuki-kimoto authored on 2010-08-05
130
    # No row
packaging one directory
yuki-kimoto authored on 2009-11-16
131
    return unless $row;
132
    
133
    # Finish statement handle
some changed
yuki-kimoto authored on 2010-05-02
134
    $self->sth->finish;
packaging one directory
yuki-kimoto authored on 2009-11-16
135
    
removed reconnect method
yuki-kimoto authored on 2010-05-28
136
    return $row;
packaging one directory
yuki-kimoto authored on 2009-11-16
137
}
138

            
renamed fetch_rows to fetch_...
yuki-kimoto authored on 2010-05-01
139
sub fetch_hash_multi {
packaging one directory
yuki-kimoto authored on 2009-11-16
140
    my ($self, $count) = @_;
141
    
cleanup
yuki-kimoto authored on 2010-08-05
142
    # Row count not specified
changed argument of tag proc...
yuki-kimoto authored on 2010-08-03
143
    croak 'Row count must be specified'
packaging one directory
yuki-kimoto authored on 2009-11-16
144
      unless $count;
145
    
146
    # Fetch multi rows
147
    my $rows = [];
148
    for (my $i = 0; $i < $count; $i++) {
removed reconnect method
yuki-kimoto authored on 2010-05-28
149
        my $row = $self->fetch_hash;
150
        last unless $row;
151
        push @$rows, $row;
packaging one directory
yuki-kimoto authored on 2009-11-16
152
    }
153
    
154
    return unless @$rows;
removed reconnect method
yuki-kimoto authored on 2010-05-28
155
    return $rows;
packaging one directory
yuki-kimoto authored on 2009-11-16
156
}
157

            
cleanup
yuki-kimoto authored on 2010-10-17
158
sub fetch_multi {
159
    my ($self, $count) = @_;
packaging one directory
yuki-kimoto authored on 2009-11-16
160
    
cleanup
yuki-kimoto authored on 2010-10-17
161
    # Row count not specifed
162
    croak 'Row count must be specified'
163
      unless $count;
164
    
165
    # Fetch multi rows
packaging one directory
yuki-kimoto authored on 2009-11-16
166
    my $rows = [];
cleanup
yuki-kimoto authored on 2010-10-17
167
    for (my $i = 0; $i < $count; $i++) {
168
        my $row = $self->fetch;
169
        last unless $row;
removed reconnect method
yuki-kimoto authored on 2010-05-28
170
        push @$rows, $row;
packaging one directory
yuki-kimoto authored on 2009-11-16
171
    }
changed argument of tag proc...
yuki-kimoto authored on 2010-08-03
172
    
cleanup
yuki-kimoto authored on 2010-10-17
173
    return unless @$rows;
removed reconnect method
yuki-kimoto authored on 2010-05-28
174
    return $rows;
packaging one directory
yuki-kimoto authored on 2009-11-16
175
}
176

            
added check_filter attribute
yuki-kimoto authored on 2010-08-08
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
yuki-kimoto authored on 2010-01-30
201
1;
202

            
packaging one directory
yuki-kimoto authored on 2009-11-16
203
=head1 NAME
204

            
cleanup
yuki-kimoto authored on 2010-08-05
205
DBIx::Custom::Result - Result of select statement
packaging one directory
yuki-kimoto authored on 2009-11-16
206

            
update document
yuki-kimoto authored on 2010-01-30
207
=head1 SYNOPSIS
cleanup
yuki-kimoto authored on 2010-08-05
208

            
209
Get the result of select statement.
210

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
211
    # Result
212
    my $result = $dbi->select(table => 'books');
cleanup
yuki-kimoto authored on 2010-08-05
213

            
214
Fetch row into array.
removed reconnect method
yuki-kimoto authored on 2010-05-28
215
    
216
    # Fetch a row into array
217
    while (my $row = $result->fetch) {
cleanup
yuki-kimoto authored on 2010-08-05
218
        my $author = $row->[0];
219
        my $title  = $row->[1];
removed reconnect method
yuki-kimoto authored on 2010-05-28
220
        
version 0.0901
yuki-kimoto authored on 2009-12-17
221
    }
222
    
cleanup
yuki-kimoto authored on 2010-08-05
223
    # Fetch only a first row into array
removed reconnect method
yuki-kimoto authored on 2010-05-28
224
    my $row = $result->fetch_first;
225
    
226
    # Fetch multiple rows into array of array
227
    while (my $rows = $result->fetch_multi(5)) {
cleanup
yuki-kimoto authored on 2010-08-05
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
yuki-kimoto authored on 2010-05-28
233
    }
234
    
235
    # Fetch all rows into array of array
236
    my $rows = $result->fetch_all;
cleanup
yuki-kimoto authored on 2010-08-05
237

            
238
Fetch row into hash.
239

            
240
    # Fetch a row into hash
removed reconnect method
yuki-kimoto authored on 2010-05-28
241
    while (my $row = $result->fetch_hash) {
cleanup
yuki-kimoto authored on 2010-08-05
242
        my $title  = $row->{title};
243
        my $author = $row->{author};
removed reconnect method
yuki-kimoto authored on 2010-05-28
244
        
packaging one directory
yuki-kimoto authored on 2009-11-16
245
    }
removed reconnect method
yuki-kimoto authored on 2010-05-28
246
    
cleanup
yuki-kimoto authored on 2010-08-05
247
    # Fetch only a first row into hash
removed reconnect method
yuki-kimoto authored on 2010-05-28
248
    my $row = $result->fetch_hash_first;
249
    
250
    # Fetch multiple rows into array of hash
cleanup
yuki-kimoto authored on 2010-08-05
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
yuki-kimoto authored on 2010-05-28
257
    }
258
    
259
    # Fetch all rows into array of hash
260
    my $rows = $result->fetch_hash_all;
packaging one directory
yuki-kimoto authored on 2009-11-16
261

            
update document
yuki-kimoto authored on 2010-01-30
262
=head1 ATTRIBUTES
packaging one directory
yuki-kimoto authored on 2009-11-16
263

            
removed DESTROY method(not b...
yuki-kimoto authored on 2010-07-18
264
=head2 C<default_filter>
many many changes
yuki-kimoto authored on 2010-04-30
265

            
cleanup
yuki-kimoto authored on 2010-08-03
266
    my $default_filter = $result->default_filter;
267
    $result            = $result->default_filter('decode_utf8');
many many changes
yuki-kimoto authored on 2010-04-30
268

            
cleanup
yuki-kimoto authored on 2010-08-05
269
Default filter when a row is fetched.
packaging one directory
yuki-kimoto authored on 2009-11-16
270

            
removed DESTROY method(not b...
yuki-kimoto authored on 2010-07-18
271
=head2 C<filter>
update document
yuki-kimoto authored on 2009-11-19
272

            
cleanup
yuki-kimoto authored on 2010-08-03
273
    my $filter = $result->filter;
cleanup
yuki-kimoto authored on 2010-08-05
274
    $result    = $result->filter({title  => 'decode_utf8',
275
                                  author => 'decode_utf8'});
packaging one directory
yuki-kimoto authored on 2009-11-16
276

            
cleanup
yuki-kimoto authored on 2010-08-05
277
Filters when a row is fetched.
278
This overwrites C<default_filter>.
removed DESTROY method(not b...
yuki-kimoto authored on 2010-07-18
279

            
cleanup
yuki-kimoto authored on 2010-10-17
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
yuki-kimoto authored on 2010-01-30
301
=head1 METHODS
302

            
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
303
L<DBIx::Custom::Result> inherits all methods from L<Object::Simple>
cleanup
yuki-kimoto authored on 2010-08-05
304
and implements the following new ones.
packaging one directory
yuki-kimoto authored on 2009-11-16
305

            
removed DBIx::Custom commit ...
yuki-kimoto authored on 2010-07-14
306
=head2 C<fetch>
packaging one directory
yuki-kimoto authored on 2009-11-16
307

            
cleanup
yuki-kimoto authored on 2010-08-05
308
    my $row = $result->fetch;
version 0.0901
yuki-kimoto authored on 2009-12-17
309

            
cleanup
yuki-kimoto authored on 2010-08-05
310
Fetch a row into array.
packaging one directory
yuki-kimoto authored on 2009-11-16
311

            
removed DBIx::Custom commit ...
yuki-kimoto authored on 2010-07-14
312
=head2 C<fetch_all>
packaging one directory
yuki-kimoto authored on 2009-11-16
313

            
cleanup
yuki-kimoto authored on 2010-08-05
314
    my $rows = $result->fetch_all;
version 0.0901
yuki-kimoto authored on 2009-12-17
315

            
removed DESTROY method(not b...
yuki-kimoto authored on 2010-07-18
316
Fetch all rows into array of array.
packaging one directory
yuki-kimoto authored on 2009-11-16
317

            
cleanup
yuki-kimoto authored on 2010-10-17
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...
yuki-kimoto authored on 2010-07-18
324
=head2 C<fetch_hash>
packaging one directory
yuki-kimoto authored on 2009-11-16
325

            
cleanup
yuki-kimoto authored on 2010-08-05
326
    my $row = $result->fetch_hash;
packaging one directory
yuki-kimoto authored on 2009-11-16
327

            
removed DESTROY method(not b...
yuki-kimoto authored on 2010-07-18
328
Fetch a row into hash
update document
yuki-kimoto authored on 2009-11-19
329

            
cleanup
yuki-kimoto authored on 2010-10-17
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 ...
yuki-kimoto authored on 2010-07-14
336
=head2 C<fetch_hash_first>
removed reconnect method
yuki-kimoto authored on 2010-05-28
337
    
cleanup
yuki-kimoto authored on 2010-08-05
338
    my $row = $result->fetch_hash_first;
packaging one directory
yuki-kimoto authored on 2009-11-16
339

            
removed DESTROY method(not b...
yuki-kimoto authored on 2010-07-18
340
Fetch only first row into hash and finish statment handle.
packaging one directory
yuki-kimoto authored on 2009-11-16
341

            
removed DESTROY method(not b...
yuki-kimoto authored on 2010-07-18
342
=head2 C<fetch_hash_multi>
update document
yuki-kimoto authored on 2009-11-19
343

            
cleanup
yuki-kimoto authored on 2010-08-05
344
    my $rows = $result->fetch_hash_multi(5);
update document
yuki-kimoto authored on 2009-11-19
345
    
removed DESTROY method(not b...
yuki-kimoto authored on 2010-07-18
346
Fetch multiple rows into array of hash
cleanup
yuki-kimoto authored on 2010-08-05
347
Row count must be specified.
update document
yuki-kimoto authored on 2009-11-19
348

            
cleanup
yuki-kimoto authored on 2010-10-17
349
=head2 C<fetch_multi>
packaging one directory
yuki-kimoto authored on 2009-11-16
350

            
cleanup
yuki-kimoto authored on 2010-10-17
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...
yuki-kimoto authored on 2010-07-18
355

            
packaging one directory
yuki-kimoto authored on 2009-11-16
356
=cut