Newer Older
361 lines | 7.283kb
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
        
cleanup
Yuki Kimoto authored on 2011-01-12
28
        $self->{filter} = {%{$self->filter || {}}, %$filter};
cleanup
Yuki Kimoto authored on 2010-12-22
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 2011-01-12
39
    # Filter
cleanup
Yuki Kimoto authored on 2010-12-22
40
    my $filter  = $self->{filter}  || {};
packaging one directory
yuki-kimoto authored on 2009-11-16
41
    
42
    # Fetch
changed argument of tag proc...
yuki-kimoto authored on 2010-08-03
43
    my @row = $self->{sth}->fetchrow_array;
packaging one directory
yuki-kimoto authored on 2009-11-16
44
    
cleanup
yuki-kimoto authored on 2010-08-05
45
    # No row
update document
yuki-kimoto authored on 2010-05-27
46
    return unless @row;
added check_filter attribute
yuki-kimoto authored on 2010-08-08
47
    
cleanup
yuki-kimoto authored on 2010-08-05
48
    # Filtering
added experimental iterate_a...
Yuki Kimoto authored on 2010-12-22
49
    my $columns = $self->{sth}->{NAME};
cleanup
yuki-kimoto authored on 2010-08-05
50
    for (my $i = 0; $i < @$columns; $i++) {
update document
yuki-kimoto authored on 2010-05-27
51
        
changed argument of tag proc...
yuki-kimoto authored on 2010-08-03
52
        # Filter name
cleanup
yuki-kimoto authored on 2010-08-05
53
        my $column = $columns->[$i];
cleanup
Yuki Kimoto authored on 2010-12-21
54
        my $f  = exists $filter->{$column}
55
               ? $filter->{$column}
cleanup
Yuki Kimoto authored on 2010-12-22
56
               : $self->default_filter;
some changed
yuki-kimoto authored on 2010-05-02
57
        
cleanup
yuki-kimoto authored on 2010-08-05
58
        # Filtering
cleanup
Yuki Kimoto authored on 2010-12-21
59
        $row[$i] = $f->($row[$i]) if $f;
packaging one directory
yuki-kimoto authored on 2009-11-16
60
    }
many many changes
yuki-kimoto authored on 2010-04-30
61

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
62
    return \@row;
63
}
64

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

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

            
packaging one directory
yuki-kimoto authored on 2009-11-16
91
sub fetch_hash {
changed argument of tag proc...
yuki-kimoto authored on 2010-08-03
92
    my $self = shift;
93
    
cleanup
Yuki Kimoto authored on 2011-01-12
94
    # Filter
cleanup
Yuki Kimoto authored on 2010-12-22
95
    my $filter  = $self->filter  || {};
packaging one directory
yuki-kimoto authored on 2009-11-16
96
    
97
    # Fetch
changed argument of tag proc...
yuki-kimoto authored on 2010-08-03
98
    my $row = $self->{sth}->fetchrow_arrayref;
packaging one directory
yuki-kimoto authored on 2009-11-16
99
    
100
    # Cannot fetch
101
    return unless $row;
added check_filter attribute
yuki-kimoto authored on 2010-08-08
102

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

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

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

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

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

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

            
update document
yuki-kimoto authored on 2010-01-30
208
1;
209

            
packaging one directory
yuki-kimoto authored on 2009-11-16
210
=head1 NAME
211

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

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

            
216
Get the result of select statement.
217

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

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

            
245
Fetch row into hash.
246

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
273
=head2 C<filters>
274

            
275
    my $filters = $result->filters;
276
    $result     = $result->filters(\%filters);
277

            
278
Resistered filters.
279

            
280
=head2 C<filter_check>
281

            
282
    my $filter_check = $result->filter_check;
283
    $result          = $result->filter_check;
284

            
285
Enable filter validation.
286

            
287
=head2 C<sth>
288

            
289
    my $sth = $reuslt->sth
290
    $result = $result->sth($sth);
291

            
292
Statement handle of L<DBI>.
293

            
update document
yuki-kimoto authored on 2010-01-30
294
=head1 METHODS
295

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

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

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

            
cleanup
yuki-kimoto authored on 2010-08-05
303
Fetch a row into array.
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_all>
packaging one directory
yuki-kimoto authored on 2009-11-16
306

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
311
=head2 C<fetch_first>
312

            
313
    my $row = $result->fetch_first;
314

            
315
Fetch only a first row into array and finish statment handle.
316

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

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

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

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

            
325
    my $rows = $result->fetch_hash_all;
326

            
327
Fetch all rows into array of hash.
328

            
removed DBIx::Custom commit ...
yuki-kimoto authored on 2010-07-14
329
=head2 C<fetch_hash_first>
removed reconnect method
yuki-kimoto authored on 2010-05-28
330
    
cleanup
yuki-kimoto authored on 2010-08-05
331
    my $row = $result->fetch_hash_first;
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 only first row into hash and finish statment handle.
packaging one directory
yuki-kimoto authored on 2009-11-16
334

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

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

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

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

            
cleanup
Yuki Kimoto authored on 2010-12-21
349
=head2 C<filter>
350

            
351
    $result    = $result->filter(title  => 'decode_utf8',
352
                                 author => 'decode_utf8');
353

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

            
356
    my $default_filter = $result->default_filter;
357
    $result = $result->default_filter($filter);
358

            
359
Default filter when a row is fetched.
360

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