Newer Older
357 lines | 7.254kb
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-12-21
10
__PACKAGE__->attr([qw/filter_check filters sth/]);
11

            
12
sub default_filter {
13
    my $self = shift;
14
    my $fname = $_[0];
15
    
16
    if (@_ && !$fname) {
17
        $self->{_default_filter} = undef;
18
    }
19
    else {
20
        croak qq{"$fname" is not registered}
21
          unless exists $self->filters->{$fname};
22
    
23
        $self->{_default_filter} = $self->filters->{$fname};
24
    }
25
    
26
    return $self;
27
}
28

            
29
sub filter {
30
    my $self = shift;
31
    my $filter = ref $_[0] eq 'HASH' ? $_[0] : {@_};
32
    
33
    foreach my $column (keys %$filter) {
34
        my $fname = $filter->{$column};
35
        unless (ref $fname eq 'CODE') {
36
          croak qq{"$fname" is not registered"}
37
            unless exists $self->filters->{$fname};
38
          
39
          $filter->{$column} = $self->filters->{$fname};
40
        }
41
    }
42
    
43
    $self->{_filter} = $filter;
44
    
45
    return $self;
46
}
cleanup
yuki-kimoto authored on 2010-01-21
47

            
packaging one directory
yuki-kimoto authored on 2009-11-16
48
sub fetch {
changed argument of tag proc...
yuki-kimoto authored on 2010-08-03
49
    my $self = shift;
50
    
cleanup
yuki-kimoto authored on 2010-08-05
51
    # Filters
added check_filter attribute
yuki-kimoto authored on 2010-08-08
52
    my $filters = $self->{filters} || {};
cleanup
Yuki Kimoto authored on 2010-12-21
53
    my $filter  = $self->{_filter}  || {};
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
54
    my $auto_filter = $self->{_auto_filter} || {};
55
    $filter = {%$auto_filter, %$filter};
packaging one directory
yuki-kimoto authored on 2009-11-16
56
    
57
    # Fetch
changed argument of tag proc...
yuki-kimoto authored on 2010-08-03
58
    my @row = $self->{sth}->fetchrow_array;
packaging one directory
yuki-kimoto authored on 2009-11-16
59
    
cleanup
yuki-kimoto authored on 2010-08-05
60
    # No row
update document
yuki-kimoto authored on 2010-05-27
61
    return unless @row;
added check_filter attribute
yuki-kimoto authored on 2010-08-08
62
    
cleanup
yuki-kimoto authored on 2010-08-05
63
    # Filtering
added experimental iterate_a...
Yuki Kimoto authored on 2010-12-22
64
    my $columns = $self->{sth}->{NAME};
cleanup
yuki-kimoto authored on 2010-08-05
65
    for (my $i = 0; $i < @$columns; $i++) {
update document
yuki-kimoto authored on 2010-05-27
66
        
changed argument of tag proc...
yuki-kimoto authored on 2010-08-03
67
        # Filter name
cleanup
yuki-kimoto authored on 2010-08-05
68
        my $column = $columns->[$i];
cleanup
Yuki Kimoto authored on 2010-12-21
69
        my $f  = exists $filter->{$column}
70
               ? $filter->{$column}
71
               : $self->{_default_filter};
some changed
yuki-kimoto authored on 2010-05-02
72
        
cleanup
yuki-kimoto authored on 2010-08-05
73
        # Filtering
cleanup
Yuki Kimoto authored on 2010-12-21
74
        $row[$i] = $f->($row[$i]) if $f;
packaging one directory
yuki-kimoto authored on 2009-11-16
75
    }
many many changes
yuki-kimoto authored on 2010-04-30
76

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
77
    return \@row;
78
}
79

            
cleanup
yuki-kimoto authored on 2010-10-17
80
sub fetch_all {
81
    my $self = shift;
82
    
83
    # Fetch all rows
84
    my $rows = [];
85
    while(my $row = $self->fetch) {
86
        push @$rows, $row;
87
    }
88
    return $rows;
89
}
90

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
91
sub fetch_first {
92
    my $self = shift;
93
    
94
    # Fetch
95
    my $row = $self->fetch;
96
    
cleanup
yuki-kimoto authored on 2010-08-05
97
    # No row
removed reconnect method
yuki-kimoto authored on 2010-05-28
98
    return unless $row;
99
    
100
    # Finish statement handle
101
    $self->sth->finish;
102
    
103
    return $row;
104
}
105

            
packaging one directory
yuki-kimoto authored on 2009-11-16
106
sub fetch_hash {
changed argument of tag proc...
yuki-kimoto authored on 2010-08-03
107
    my $self = shift;
108
    
cleanup
yuki-kimoto authored on 2010-08-05
109
    # Filters
added check_filter attribute
yuki-kimoto authored on 2010-08-08
110
    my $filters = $self->{filters} || {};
cleanup
Yuki Kimoto authored on 2010-12-21
111
    my $filter  = $self->{_filter}  || {};
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
112
    my $auto_filter = $self->{_auto_filter} || {};
113
    $filter = {%$auto_filter, %$filter};
packaging one directory
yuki-kimoto authored on 2009-11-16
114
    
115
    # Fetch
changed argument of tag proc...
yuki-kimoto authored on 2010-08-03
116
    my $row = $self->{sth}->fetchrow_arrayref;
packaging one directory
yuki-kimoto authored on 2009-11-16
117
    
118
    # Cannot fetch
119
    return unless $row;
added check_filter attribute
yuki-kimoto authored on 2010-08-08
120

            
packaging one directory
yuki-kimoto authored on 2009-11-16
121
    # Filter
122
    my $row_hash = {};
added experimental iterate_a...
Yuki Kimoto authored on 2010-12-22
123
    my $columns = $self->{sth}->{NAME};
cleanup
yuki-kimoto authored on 2010-08-05
124
    for (my $i = 0; $i < @$columns; $i++) {
update document
yuki-kimoto authored on 2010-05-27
125
        
changed argument of tag proc...
yuki-kimoto authored on 2010-08-03
126
        # Filter name
cleanup
yuki-kimoto authored on 2010-08-05
127
        my $column = $columns->[$i];
cleanup
Yuki Kimoto authored on 2010-12-21
128
        my $f  = exists $filter->{$column}
129
               ? $filter->{$column}
130
               : $self->{_default_filter};
add query filter error check
yuki-kimoto authored on 2010-05-14
131
        
cleanup
yuki-kimoto authored on 2010-08-05
132
        # Filtering
cleanup
Yuki Kimoto authored on 2010-12-21
133
        $row_hash->{$column} = $f ? $f->($row->[$i]) : $row->[$i];
packaging one directory
yuki-kimoto authored on 2009-11-16
134
    }
135
    
removed reconnect method
yuki-kimoto authored on 2010-05-28
136
    return $row_hash;
packaging one directory
yuki-kimoto authored on 2009-11-16
137
}
138

            
cleanup
yuki-kimoto authored on 2010-10-17
139
sub fetch_hash_all {
140
    my $self = shift;
141
    
142
    # Fetch all rows as hash
143
    my $rows = [];
144
    while(my $row = $self->fetch_hash) {
145
        push @$rows, $row;
146
    }
147
    
148
    return $rows;
149
}
150

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
151
sub fetch_hash_first {
packaging one directory
yuki-kimoto authored on 2009-11-16
152
    my $self = shift;
153
    
154
    # Fetch hash
155
    my $row = $self->fetch_hash;
156
    
cleanup
yuki-kimoto authored on 2010-08-05
157
    # No row
packaging one directory
yuki-kimoto authored on 2009-11-16
158
    return unless $row;
159
    
160
    # Finish statement handle
some changed
yuki-kimoto authored on 2010-05-02
161
    $self->sth->finish;
packaging one directory
yuki-kimoto authored on 2009-11-16
162
    
removed reconnect method
yuki-kimoto authored on 2010-05-28
163
    return $row;
packaging one directory
yuki-kimoto authored on 2009-11-16
164
}
165

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

            
cleanup
yuki-kimoto authored on 2010-10-17
185
sub fetch_multi {
186
    my ($self, $count) = @_;
packaging one directory
yuki-kimoto authored on 2009-11-16
187
    
cleanup
yuki-kimoto authored on 2010-10-17
188
    # Row count not specifed
189
    croak 'Row count must be specified'
190
      unless $count;
191
    
192
    # Fetch multi rows
packaging one directory
yuki-kimoto authored on 2009-11-16
193
    my $rows = [];
cleanup
yuki-kimoto authored on 2010-10-17
194
    for (my $i = 0; $i < $count; $i++) {
195
        my $row = $self->fetch;
196
        last unless $row;
removed reconnect method
yuki-kimoto authored on 2010-05-28
197
        push @$rows, $row;
packaging one directory
yuki-kimoto authored on 2009-11-16
198
    }
changed argument of tag proc...
yuki-kimoto authored on 2010-08-03
199
    
cleanup
yuki-kimoto authored on 2010-10-17
200
    return unless @$rows;
removed reconnect method
yuki-kimoto authored on 2010-05-28
201
    return $rows;
packaging one directory
yuki-kimoto authored on 2009-11-16
202
}
203

            
update document
yuki-kimoto authored on 2010-01-30
204
1;
205

            
packaging one directory
yuki-kimoto authored on 2009-11-16
206
=head1 NAME
207

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

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

            
212
Get the result of select statement.
213

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

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

            
241
Fetch row into hash.
242

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
270
=head2 C<filters>
271

            
272
    my $filters = $result->filters;
273
    $result     = $result->filters(\%filters);
274

            
275
Resistered filters.
276

            
277
=head2 C<filter_check>
278

            
279
    my $filter_check = $result->filter_check;
280
    $result          = $result->filter_check;
281

            
282
Enable filter validation.
283

            
284
=head2 C<sth>
285

            
286
    my $sth = $reuslt->sth
287
    $result = $result->sth($sth);
288

            
289
Statement handle of L<DBI>.
290

            
update document
yuki-kimoto authored on 2010-01-30
291
=head1 METHODS
292

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

            
cleanup
Yuki Kimoto authored on 2010-12-21
296
=head2 C<(deprecated) default_filter>
297

            
298
    $result = $result->default_filter($filter);
299

            
300
Default filter when a row is fetched.
301

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
330
Fetch all rows into array of hash.
331

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

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

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

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

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

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

            
cleanup
Yuki Kimoto authored on 2010-12-21
352
=head2 C<filter>
353

            
354
    $result    = $result->filter(title  => 'decode_utf8',
355
                                 author => 'decode_utf8');
356

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