Newer Older
367 lines | 7.522kb
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 filter {
13
    my $self = shift;
cleanup
Yuki Kimoto authored on 2010-12-22
14
    
15
    if (@_) {
16
        my $filter = ref $_[0] eq 'HASH' ? $_[0] : {@_};
17
        
18
        foreach my $column (keys %$filter) {
19
            my $fname = $filter->{$column};
20
            unless (ref $fname eq 'CODE') {
21
              croak qq{"$fname" is not registered"}
22
                unless exists $self->filters->{$fname};
23
              
24
              $filter->{$column} = $self->filters->{$fname};
25
            }
cleanup
Yuki Kimoto authored on 2010-12-21
26
        }
cleanup
Yuki Kimoto authored on 2010-12-22
27
        
28
        $self->{filter} = $filter;
29
        
30
        return $self;
cleanup
Yuki Kimoto authored on 2010-12-21
31
    }
32
    
cleanup
Yuki Kimoto authored on 2010-12-22
33
    return $self->{filter};
cleanup
Yuki Kimoto authored on 2010-12-21
34
}
cleanup
yuki-kimoto authored on 2010-01-21
35

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

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
65
    return \@row;
66
}
67

            
cleanup
yuki-kimoto authored on 2010-10-17
68
sub fetch_all {
69
    my $self = shift;
70
    
71
    # Fetch all rows
72
    my $rows = [];
73
    while(my $row = $self->fetch) {
74
        push @$rows, $row;
75
    }
76
    return $rows;
77
}
78

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
79
sub fetch_first {
80
    my $self = shift;
81
    
82
    # Fetch
83
    my $row = $self->fetch;
84
    
cleanup
yuki-kimoto authored on 2010-08-05
85
    # No row
removed reconnect method
yuki-kimoto authored on 2010-05-28
86
    return unless $row;
87
    
88
    # Finish statement handle
89
    $self->sth->finish;
90
    
91
    return $row;
92
}
93

            
packaging one directory
yuki-kimoto authored on 2009-11-16
94
sub fetch_hash {
changed argument of tag proc...
yuki-kimoto authored on 2010-08-03
95
    my $self = shift;
96
    
cleanup
yuki-kimoto authored on 2010-08-05
97
    # Filters
cleanup
Yuki Kimoto authored on 2010-12-22
98
    my $filters = $self->filters || {};
99
    my $filter  = $self->filter  || {};
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
100
    my $auto_filter = $self->{_auto_filter} || {};
101
    $filter = {%$auto_filter, %$filter};
packaging one directory
yuki-kimoto authored on 2009-11-16
102
    
103
    # Fetch
changed argument of tag proc...
yuki-kimoto authored on 2010-08-03
104
    my $row = $self->{sth}->fetchrow_arrayref;
packaging one directory
yuki-kimoto authored on 2009-11-16
105
    
106
    # Cannot fetch
107
    return unless $row;
added check_filter attribute
yuki-kimoto authored on 2010-08-08
108

            
packaging one directory
yuki-kimoto authored on 2009-11-16
109
    # Filter
110
    my $row_hash = {};
added experimental iterate_a...
Yuki Kimoto authored on 2010-12-22
111
    my $columns = $self->{sth}->{NAME};
cleanup
yuki-kimoto authored on 2010-08-05
112
    for (my $i = 0; $i < @$columns; $i++) {
update document
yuki-kimoto authored on 2010-05-27
113
        
changed argument of tag proc...
yuki-kimoto authored on 2010-08-03
114
        # Filter name
cleanup
yuki-kimoto authored on 2010-08-05
115
        my $column = $columns->[$i];
cleanup
Yuki Kimoto authored on 2010-12-21
116
        my $f  = exists $filter->{$column}
117
               ? $filter->{$column}
cleanup
Yuki Kimoto authored on 2010-12-22
118
               : $self->default_filter;
add query filter error check
yuki-kimoto authored on 2010-05-14
119
        
cleanup
yuki-kimoto authored on 2010-08-05
120
        # Filtering
cleanup
Yuki Kimoto authored on 2010-12-21
121
        $row_hash->{$column} = $f ? $f->($row->[$i]) : $row->[$i];
packaging one directory
yuki-kimoto authored on 2009-11-16
122
    }
123
    
removed reconnect method
yuki-kimoto authored on 2010-05-28
124
    return $row_hash;
packaging one directory
yuki-kimoto authored on 2009-11-16
125
}
126

            
cleanup
yuki-kimoto authored on 2010-10-17
127
sub fetch_hash_all {
128
    my $self = shift;
129
    
130
    # Fetch all rows as hash
131
    my $rows = [];
132
    while(my $row = $self->fetch_hash) {
133
        push @$rows, $row;
134
    }
135
    
136
    return $rows;
137
}
138

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
139
sub fetch_hash_first {
packaging one directory
yuki-kimoto authored on 2009-11-16
140
    my $self = shift;
141
    
142
    # Fetch hash
143
    my $row = $self->fetch_hash;
144
    
cleanup
yuki-kimoto authored on 2010-08-05
145
    # No row
packaging one directory
yuki-kimoto authored on 2009-11-16
146
    return unless $row;
147
    
148
    # Finish statement handle
some changed
yuki-kimoto authored on 2010-05-02
149
    $self->sth->finish;
packaging one directory
yuki-kimoto authored on 2009-11-16
150
    
removed reconnect method
yuki-kimoto authored on 2010-05-28
151
    return $row;
packaging one directory
yuki-kimoto authored on 2009-11-16
152
}
153

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

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

            
cleanup
Yuki Kimoto authored on 2011-01-12
192
# Deprecated
193
sub default_filter {
194
    my $self = shift;
195
    
196
    if (@_) {
197
        my $fname = $_[0];
198
        if (@_ && !$fname) {
199
            $self->{default_filter} = undef;
200
        }
201
        else {
202
            croak qq{"$fname" is not registered}
203
              unless exists $self->filters->{$fname};
204
        
205
            $self->{default_filter} = $self->filters->{$fname};
206
        }
207
        
208
        return $self;
209
    }
210
    
211
    return $self->{default_filter};
212
}
213

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

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

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

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

            
222
Get the result of select statement.
223

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

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

            
251
Fetch row into hash.
252

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

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

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

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

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

            
284
Resistered filters.
285

            
286
=head2 C<filter_check>
287

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

            
291
Enable filter validation.
292

            
293
=head2 C<sth>
294

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

            
298
Statement handle of L<DBI>.
299

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

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

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

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

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

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
317
=head2 C<fetch_first>
318

            
319
    my $row = $result->fetch_first;
320

            
321
Fetch only a first row into array and finish statment handle.
322

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
329
=head2 C<fetch_hash_all>
330

            
331
    my $rows = $result->fetch_hash_all;
332

            
333
Fetch all rows into array of hash.
334

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

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

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

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

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

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

            
cleanup
Yuki Kimoto authored on 2010-12-21
355
=head2 C<filter>
356

            
357
    $result    = $result->filter(title  => 'decode_utf8',
358
                                 author => 'decode_utf8');
359

            
cleanup
Yuki Kimoto authored on 2011-01-12
360
=head2 C<(deprecated) default_filter>
361

            
362
    my $default_filter = $result->default_filter;
363
    $result = $result->default_filter($filter);
364

            
365
Default filter when a row is fetched.
366

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