Newer Older
351 lines | 7.453kb
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

            
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
10
__PACKAGE__->attr([qw/default_filter filter
11
                      filter_check filters sth/]);
cleanup
yuki-kimoto authored on 2010-01-21
12

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

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
48
    return \@row;
49
}
50

            
cleanup
yuki-kimoto authored on 2010-10-17
51
sub fetch_all {
52
    my $self = shift;
53
    
54
    # Fetch all rows
55
    my $rows = [];
56
    while(my $row = $self->fetch) {
57
        push @$rows, $row;
58
    }
59
    return $rows;
60
}
61

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
62
sub fetch_first {
63
    my $self = shift;
64
    
65
    # Fetch
66
    my $row = $self->fetch;
67
    
cleanup
yuki-kimoto authored on 2010-08-05
68
    # No row
removed reconnect method
yuki-kimoto authored on 2010-05-28
69
    return unless $row;
70
    
71
    # Finish statement handle
72
    $self->sth->finish;
73
    
74
    return $row;
75
}
76

            
packaging one directory
yuki-kimoto authored on 2009-11-16
77
sub fetch_hash {
changed argument of tag proc...
yuki-kimoto authored on 2010-08-03
78
    my $self = shift;
79
    
cleanup
yuki-kimoto authored on 2010-08-05
80
    # Filters
added check_filter attribute
yuki-kimoto authored on 2010-08-08
81
    my $filters = $self->{filters} || {};
82
    my $filter  = $self->{filter}  || {};
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
83
    my $auto_filter = $self->{_auto_filter} || {};
84
    $filter = {%$auto_filter, %$filter};
packaging one directory
yuki-kimoto authored on 2009-11-16
85
    
86
    # Fetch
changed argument of tag proc...
yuki-kimoto authored on 2010-08-03
87
    my $row = $self->{sth}->fetchrow_arrayref;
packaging one directory
yuki-kimoto authored on 2009-11-16
88
    
89
    # Cannot fetch
90
    return unless $row;
added check_filter attribute
yuki-kimoto authored on 2010-08-08
91

            
92
    # Check filter
93
    $self->_check_filter($filters, $filter, 
94
                         $self->default_filter, $self->sth)
95
      if $self->{filter_check};
96

            
packaging one directory
yuki-kimoto authored on 2009-11-16
97
    # Filter
98
    my $row_hash = {};
cleanup
yuki-kimoto authored on 2010-08-05
99
    my $columns = $self->{sth}->{NAME_lc};
100
    for (my $i = 0; $i < @$columns; $i++) {
update document
yuki-kimoto authored on 2010-05-27
101
        
changed argument of tag proc...
yuki-kimoto authored on 2010-08-03
102
        # Filter name
cleanup
yuki-kimoto authored on 2010-08-05
103
        my $column = $columns->[$i];
added check_filter attribute
yuki-kimoto authored on 2010-08-08
104
        my $fname  = exists $filter->{$column}
105
                   ? $filter->{$column}
changed argument of tag proc...
yuki-kimoto authored on 2010-08-03
106
                   : $self->{default_filter};
add query filter error check
yuki-kimoto authored on 2010-05-14
107
        
cleanup
yuki-kimoto authored on 2010-08-05
108
        # Filtering
changed argument of tag proc...
yuki-kimoto authored on 2010-08-03
109
        $row_hash->{$column}
added check_filter attribute
yuki-kimoto authored on 2010-08-08
110
          = $fname ? $filters->{$fname}->($row->[$i]) 
changed argument of tag proc...
yuki-kimoto authored on 2010-08-03
111
                   : $row->[$i];
packaging one directory
yuki-kimoto authored on 2009-11-16
112
    }
113
    
removed reconnect method
yuki-kimoto authored on 2010-05-28
114
    return $row_hash;
packaging one directory
yuki-kimoto authored on 2009-11-16
115
}
116

            
cleanup
yuki-kimoto authored on 2010-10-17
117
sub fetch_hash_all {
118
    my $self = shift;
119
    
120
    # Fetch all rows as hash
121
    my $rows = [];
122
    while(my $row = $self->fetch_hash) {
123
        push @$rows, $row;
124
    }
125
    
126
    return $rows;
127
}
128

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
129
sub fetch_hash_first {
packaging one directory
yuki-kimoto authored on 2009-11-16
130
    my $self = shift;
131
    
132
    # Fetch hash
133
    my $row = $self->fetch_hash;
134
    
cleanup
yuki-kimoto authored on 2010-08-05
135
    # No row
packaging one directory
yuki-kimoto authored on 2009-11-16
136
    return unless $row;
137
    
138
    # Finish statement handle
some changed
yuki-kimoto authored on 2010-05-02
139
    $self->sth->finish;
packaging one directory
yuki-kimoto authored on 2009-11-16
140
    
removed reconnect method
yuki-kimoto authored on 2010-05-28
141
    return $row;
packaging one directory
yuki-kimoto authored on 2009-11-16
142
}
143

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

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

            
added check_filter attribute
yuki-kimoto authored on 2010-08-08
182
sub _check_filter {
183
    my ($self, $filters, $filter, $default_filter, $sth) = @_;
184
    
185
    # Filter name not exists
186
    foreach my $fname (values %$filter) {
187
        croak qq{Fetch filter "$fname" is not registered}
188
          unless exists $filters->{$fname};
189
    }
190
    
191
    # Default filter name not exists
192
    croak qq{Default fetch filter "$default_filter" is not registered}
193
      if $default_filter && ! exists $filters->{$default_filter};
194
}
195

            
update document
yuki-kimoto authored on 2010-01-30
196
1;
197

            
packaging one directory
yuki-kimoto authored on 2009-11-16
198
=head1 NAME
199

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

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

            
204
Get the result of select statement.
205

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

            
209
Fetch row into array.
removed reconnect method
yuki-kimoto authored on 2010-05-28
210
    
211
    # Fetch a row into array
212
    while (my $row = $result->fetch) {
cleanup
yuki-kimoto authored on 2010-08-05
213
        my $author = $row->[0];
214
        my $title  = $row->[1];
removed reconnect method
yuki-kimoto authored on 2010-05-28
215
        
version 0.0901
yuki-kimoto authored on 2009-12-17
216
    }
217
    
cleanup
yuki-kimoto authored on 2010-08-05
218
    # Fetch only a first row into array
removed reconnect method
yuki-kimoto authored on 2010-05-28
219
    my $row = $result->fetch_first;
220
    
221
    # Fetch multiple rows into array of array
222
    while (my $rows = $result->fetch_multi(5)) {
cleanup
yuki-kimoto authored on 2010-08-05
223
        my $first_author  = $rows->[0][0];
224
        my $first_title   = $rows->[0][1];
225
        my $second_author = $rows->[1][0];
226
        my $second_value  = $rows->[1][1];
227
    
removed reconnect method
yuki-kimoto authored on 2010-05-28
228
    }
229
    
230
    # Fetch all rows into array of array
231
    my $rows = $result->fetch_all;
cleanup
yuki-kimoto authored on 2010-08-05
232

            
233
Fetch row into hash.
234

            
235
    # Fetch a row into hash
removed reconnect method
yuki-kimoto authored on 2010-05-28
236
    while (my $row = $result->fetch_hash) {
cleanup
yuki-kimoto authored on 2010-08-05
237
        my $title  = $row->{title};
238
        my $author = $row->{author};
removed reconnect method
yuki-kimoto authored on 2010-05-28
239
        
packaging one directory
yuki-kimoto authored on 2009-11-16
240
    }
removed reconnect method
yuki-kimoto authored on 2010-05-28
241
    
cleanup
yuki-kimoto authored on 2010-08-05
242
    # Fetch only a first row into hash
removed reconnect method
yuki-kimoto authored on 2010-05-28
243
    my $row = $result->fetch_hash_first;
244
    
245
    # Fetch multiple rows into array of hash
cleanup
yuki-kimoto authored on 2010-08-05
246
    while (my $rows = $result->fetch_hash_multi(5)) {
247
        my $first_title   = $rows->[0]{title};
248
        my $first_author  = $rows->[0]{author};
249
        my $second_title  = $rows->[1]{title};
250
        my $second_author = $rows->[1]{author};
251
    
removed reconnect method
yuki-kimoto authored on 2010-05-28
252
    }
253
    
254
    # Fetch all rows into array of hash
255
    my $rows = $result->fetch_hash_all;
packaging one directory
yuki-kimoto authored on 2009-11-16
256

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

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

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

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

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
275
=head2 C<filters>
276

            
277
    my $filters = $result->filters;
278
    $result     = $result->filters(\%filters);
279

            
280
Resistered filters.
281

            
282
=head2 C<filter_check>
283

            
284
    my $filter_check = $result->filter_check;
285
    $result          = $result->filter_check;
286

            
287
Enable filter validation.
288

            
289
=head2 C<sth>
290

            
291
    my $sth = $reuslt->sth
292
    $result = $result->sth($sth);
293

            
294
Statement handle of L<DBI>.
295

            
update document
yuki-kimoto authored on 2010-01-30
296
=head1 METHODS
297

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

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

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

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

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
313
=head2 C<fetch_first>
314

            
315
    my $row = $result->fetch_first;
316

            
317
Fetch only a first row into array and finish statment handle.
318

            
removed DESTROY method(not b...
yuki-kimoto authored on 2010-07-18
319
=head2 C<fetch_hash>
packaging one directory
yuki-kimoto authored on 2009-11-16
320

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
325
=head2 C<fetch_hash_all>
326

            
327
    my $rows = $result->fetch_hash_all;
328

            
329
Fetch all rows into array of hash.
330

            
removed DBIx::Custom commit ...
yuki-kimoto authored on 2010-07-14
331
=head2 C<fetch_hash_first>
removed reconnect method
yuki-kimoto authored on 2010-05-28
332
    
cleanup
yuki-kimoto authored on 2010-08-05
333
    my $row = $result->fetch_hash_first;
packaging one directory
yuki-kimoto authored on 2009-11-16
334

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

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
346
    my $rows = $result->fetch_multi(5);
347
    
348
Fetch multiple rows into array of array.
349
Row count must be specified.
removed DESTROY method(not b...
yuki-kimoto authored on 2010-07-18
350

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