Newer Older
366 lines | 7.509kb
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
    
cleanup
Yuki Kimoto authored on 2010-12-22
15
    if (@_) {
16
        my $fname = $_[0];
17
        if (@_ && !$fname) {
18
            $self->{default_filter} = undef;
19
        }
20
        else {
21
            croak qq{"$fname" is not registered}
22
              unless exists $self->filters->{$fname};
23
        
24
            $self->{default_filter} = $self->filters->{$fname};
25
        }
26
        
27
        return $self;
cleanup
Yuki Kimoto authored on 2010-12-21
28
    }
29
    
cleanup
Yuki Kimoto authored on 2010-12-22
30
    return $self->{default_filter};
cleanup
Yuki Kimoto authored on 2010-12-21
31
}
32

            
33
sub filter {
34
    my $self = shift;
cleanup
Yuki Kimoto authored on 2010-12-22
35
    
36
    if (@_) {
37
        my $filter = ref $_[0] eq 'HASH' ? $_[0] : {@_};
38
        
39
        foreach my $column (keys %$filter) {
40
            my $fname = $filter->{$column};
41
            unless (ref $fname eq 'CODE') {
42
              croak qq{"$fname" is not registered"}
43
                unless exists $self->filters->{$fname};
44
              
45
              $filter->{$column} = $self->filters->{$fname};
46
            }
cleanup
Yuki Kimoto authored on 2010-12-21
47
        }
cleanup
Yuki Kimoto authored on 2010-12-22
48
        
49
        $self->{filter} = $filter;
50
        
51
        return $self;
cleanup
Yuki Kimoto authored on 2010-12-21
52
    }
53
    
cleanup
Yuki Kimoto authored on 2010-12-22
54
    return $self->{filter};
cleanup
Yuki Kimoto authored on 2010-12-21
55
}
cleanup
yuki-kimoto authored on 2010-01-21
56

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

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
86
    return \@row;
87
}
88

            
cleanup
yuki-kimoto authored on 2010-10-17
89
sub fetch_all {
90
    my $self = shift;
91
    
92
    # Fetch all rows
93
    my $rows = [];
94
    while(my $row = $self->fetch) {
95
        push @$rows, $row;
96
    }
97
    return $rows;
98
}
99

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
100
sub fetch_first {
101
    my $self = shift;
102
    
103
    # Fetch
104
    my $row = $self->fetch;
105
    
cleanup
yuki-kimoto authored on 2010-08-05
106
    # No row
removed reconnect method
yuki-kimoto authored on 2010-05-28
107
    return unless $row;
108
    
109
    # Finish statement handle
110
    $self->sth->finish;
111
    
112
    return $row;
113
}
114

            
packaging one directory
yuki-kimoto authored on 2009-11-16
115
sub fetch_hash {
changed argument of tag proc...
yuki-kimoto authored on 2010-08-03
116
    my $self = shift;
117
    
cleanup
yuki-kimoto authored on 2010-08-05
118
    # Filters
cleanup
Yuki Kimoto authored on 2010-12-22
119
    my $filters = $self->filters || {};
120
    my $filter  = $self->filter  || {};
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
121
    my $auto_filter = $self->{_auto_filter} || {};
122
    $filter = {%$auto_filter, %$filter};
packaging one directory
yuki-kimoto authored on 2009-11-16
123
    
124
    # Fetch
changed argument of tag proc...
yuki-kimoto authored on 2010-08-03
125
    my $row = $self->{sth}->fetchrow_arrayref;
packaging one directory
yuki-kimoto authored on 2009-11-16
126
    
127
    # Cannot fetch
128
    return unless $row;
added check_filter attribute
yuki-kimoto authored on 2010-08-08
129

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

            
cleanup
yuki-kimoto authored on 2010-10-17
148
sub fetch_hash_all {
149
    my $self = shift;
150
    
151
    # Fetch all rows as hash
152
    my $rows = [];
153
    while(my $row = $self->fetch_hash) {
154
        push @$rows, $row;
155
    }
156
    
157
    return $rows;
158
}
159

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
160
sub fetch_hash_first {
packaging one directory
yuki-kimoto authored on 2009-11-16
161
    my $self = shift;
162
    
163
    # Fetch hash
164
    my $row = $self->fetch_hash;
165
    
cleanup
yuki-kimoto authored on 2010-08-05
166
    # No row
packaging one directory
yuki-kimoto authored on 2009-11-16
167
    return unless $row;
168
    
169
    # Finish statement handle
some changed
yuki-kimoto authored on 2010-05-02
170
    $self->sth->finish;
packaging one directory
yuki-kimoto authored on 2009-11-16
171
    
removed reconnect method
yuki-kimoto authored on 2010-05-28
172
    return $row;
packaging one directory
yuki-kimoto authored on 2009-11-16
173
}
174

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

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

            
update document
yuki-kimoto authored on 2010-01-30
213
1;
214

            
packaging one directory
yuki-kimoto authored on 2009-11-16
215
=head1 NAME
216

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

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

            
221
Get the result of select statement.
222

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

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

            
250
Fetch row into hash.
251

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
278
=head2 C<filters>
279

            
280
    my $filters = $result->filters;
281
    $result     = $result->filters(\%filters);
282

            
283
Resistered filters.
284

            
285
=head2 C<filter_check>
286

            
287
    my $filter_check = $result->filter_check;
288
    $result          = $result->filter_check;
289

            
290
Enable filter validation.
291

            
292
=head2 C<sth>
293

            
294
    my $sth = $reuslt->sth
295
    $result = $result->sth($sth);
296

            
297
Statement handle of L<DBI>.
298

            
update document
yuki-kimoto authored on 2010-01-30
299
=head1 METHODS
300

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

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

            
cleanup
Yuki Kimoto authored on 2010-12-22
306
    my $default_filter = $result->default_filter;
cleanup
Yuki Kimoto authored on 2010-12-21
307
    $result = $result->default_filter($filter);
308

            
309
Default filter when a row is fetched.
310

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

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

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

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
323
=head2 C<fetch_first>
324

            
325
    my $row = $result->fetch_first;
326

            
327
Fetch only a first row into array and finish statment handle.
328

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
335
=head2 C<fetch_hash_all>
336

            
337
    my $rows = $result->fetch_hash_all;
338

            
339
Fetch all rows into array of hash.
340

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

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

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
356
    my $rows = $result->fetch_multi(5);
357
    
358
Fetch multiple rows into array of array.
359
Row count must be specified.
removed DESTROY method(not b...
yuki-kimoto authored on 2010-07-18
360

            
cleanup
Yuki Kimoto authored on 2010-12-21
361
=head2 C<filter>
362

            
363
    $result    = $result->filter(title  => 'decode_utf8',
364
                                 author => 'decode_utf8');
365

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