Newer Older
329 lines | 6.779kb
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
    
cleanup
yuki-kimoto authored on 2010-08-05
28
    # Filtering
29
    my $columns = $self->{sth}->{NAME_lc};
30
    for (my $i = 0; $i < @$columns; $i++) {
update document
yuki-kimoto authored on 2010-05-27
31
        
changed argument of tag proc...
yuki-kimoto authored on 2010-08-03
32
        # Filter name
cleanup
yuki-kimoto authored on 2010-08-05
33
        my $column = $columns->[$i];
added check_filter attribute
yuki-kimoto authored on 2010-08-08
34
        my $fname  = exists $filter->{$column}
35
                   ? $filter->{$column}
changed argument of tag proc...
yuki-kimoto authored on 2010-08-03
36
                   : $self->{default_filter};
some changed
yuki-kimoto authored on 2010-05-02
37
        
cleanup
yuki-kimoto authored on 2010-08-05
38
        # Filtering
cleanup
kimoto.yuki@gmail.com authored on 2010-12-21
39
        $row[$i] = ref $fname ? $fname->($row[$i]) 
40
                 : $filters->{$fname}->($row[$i])
changed argument of tag proc...
yuki-kimoto authored on 2010-08-03
41
          if $fname;
packaging one directory
yuki-kimoto authored on 2009-11-16
42
    }
many many changes
yuki-kimoto authored on 2010-04-30
43

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
44
    return \@row;
45
}
46

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

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

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

            
packaging one directory
yuki-kimoto authored on 2009-11-16
88
    # Filter
89
    my $row_hash = {};
cleanup
yuki-kimoto authored on 2010-08-05
90
    my $columns = $self->{sth}->{NAME_lc};
91
    for (my $i = 0; $i < @$columns; $i++) {
update document
yuki-kimoto authored on 2010-05-27
92
        
changed argument of tag proc...
yuki-kimoto authored on 2010-08-03
93
        # Filter name
cleanup
yuki-kimoto authored on 2010-08-05
94
        my $column = $columns->[$i];
added check_filter attribute
yuki-kimoto authored on 2010-08-08
95
        my $fname  = exists $filter->{$column}
96
                   ? $filter->{$column}
changed argument of tag proc...
yuki-kimoto authored on 2010-08-03
97
                   : $self->{default_filter};
add query filter error check
yuki-kimoto authored on 2010-05-14
98
        
cleanup
yuki-kimoto authored on 2010-08-05
99
        # Filtering
changed argument of tag proc...
yuki-kimoto authored on 2010-08-03
100
        $row_hash->{$column}
cleanup
kimoto.yuki@gmail.com authored on 2010-12-21
101
          = ref $fname ? $fname->($row->[$i])
102
          : $fname     ? $filters->{$fname}->($row->[$i]) 
103
          : $row->[$i];
packaging one directory
yuki-kimoto authored on 2009-11-16
104
    }
105
    
removed reconnect method
yuki-kimoto authored on 2010-05-28
106
    return $row_hash;
packaging one directory
yuki-kimoto authored on 2009-11-16
107
}
108

            
cleanup
yuki-kimoto authored on 2010-10-17
109
sub fetch_hash_all {
110
    my $self = shift;
111
    
112
    # Fetch all rows as hash
113
    my $rows = [];
114
    while(my $row = $self->fetch_hash) {
115
        push @$rows, $row;
116
    }
117
    
118
    return $rows;
119
}
120

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
121
sub fetch_hash_first {
packaging one directory
yuki-kimoto authored on 2009-11-16
122
    my $self = shift;
123
    
124
    # Fetch hash
125
    my $row = $self->fetch_hash;
126
    
cleanup
yuki-kimoto authored on 2010-08-05
127
    # No row
packaging one directory
yuki-kimoto authored on 2009-11-16
128
    return unless $row;
129
    
130
    # Finish statement handle
some changed
yuki-kimoto authored on 2010-05-02
131
    $self->sth->finish;
packaging one directory
yuki-kimoto authored on 2009-11-16
132
    
removed reconnect method
yuki-kimoto authored on 2010-05-28
133
    return $row;
packaging one directory
yuki-kimoto authored on 2009-11-16
134
}
135

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

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

            
update document
yuki-kimoto authored on 2010-01-30
174
1;
175

            
packaging one directory
yuki-kimoto authored on 2009-11-16
176
=head1 NAME
177

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

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

            
182
Get the result of select statement.
183

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

            
187
Fetch row into array.
removed reconnect method
yuki-kimoto authored on 2010-05-28
188
    
189
    # Fetch a row into array
190
    while (my $row = $result->fetch) {
cleanup
yuki-kimoto authored on 2010-08-05
191
        my $author = $row->[0];
192
        my $title  = $row->[1];
removed reconnect method
yuki-kimoto authored on 2010-05-28
193
        
version 0.0901
yuki-kimoto authored on 2009-12-17
194
    }
195
    
cleanup
yuki-kimoto authored on 2010-08-05
196
    # Fetch only a first row into array
removed reconnect method
yuki-kimoto authored on 2010-05-28
197
    my $row = $result->fetch_first;
198
    
199
    # Fetch multiple rows into array of array
200
    while (my $rows = $result->fetch_multi(5)) {
cleanup
yuki-kimoto authored on 2010-08-05
201
        my $first_author  = $rows->[0][0];
202
        my $first_title   = $rows->[0][1];
203
        my $second_author = $rows->[1][0];
204
        my $second_value  = $rows->[1][1];
205
    
removed reconnect method
yuki-kimoto authored on 2010-05-28
206
    }
207
    
208
    # Fetch all rows into array of array
209
    my $rows = $result->fetch_all;
cleanup
yuki-kimoto authored on 2010-08-05
210

            
211
Fetch row into hash.
212

            
213
    # Fetch a row into hash
removed reconnect method
yuki-kimoto authored on 2010-05-28
214
    while (my $row = $result->fetch_hash) {
cleanup
yuki-kimoto authored on 2010-08-05
215
        my $title  = $row->{title};
216
        my $author = $row->{author};
removed reconnect method
yuki-kimoto authored on 2010-05-28
217
        
packaging one directory
yuki-kimoto authored on 2009-11-16
218
    }
removed reconnect method
yuki-kimoto authored on 2010-05-28
219
    
cleanup
yuki-kimoto authored on 2010-08-05
220
    # Fetch only a first row into hash
removed reconnect method
yuki-kimoto authored on 2010-05-28
221
    my $row = $result->fetch_hash_first;
222
    
223
    # Fetch multiple rows into array of hash
cleanup
yuki-kimoto authored on 2010-08-05
224
    while (my $rows = $result->fetch_hash_multi(5)) {
225
        my $first_title   = $rows->[0]{title};
226
        my $first_author  = $rows->[0]{author};
227
        my $second_title  = $rows->[1]{title};
228
        my $second_author = $rows->[1]{author};
229
    
removed reconnect method
yuki-kimoto authored on 2010-05-28
230
    }
231
    
232
    # Fetch all rows into array of hash
233
    my $rows = $result->fetch_hash_all;
packaging one directory
yuki-kimoto authored on 2009-11-16
234

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

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

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

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

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
253
=head2 C<filters>
254

            
255
    my $filters = $result->filters;
256
    $result     = $result->filters(\%filters);
257

            
258
Resistered filters.
259

            
260
=head2 C<filter_check>
261

            
262
    my $filter_check = $result->filter_check;
263
    $result          = $result->filter_check;
264

            
265
Enable filter validation.
266

            
267
=head2 C<sth>
268

            
269
    my $sth = $reuslt->sth
270
    $result = $result->sth($sth);
271

            
272
Statement handle of L<DBI>.
273

            
update document
yuki-kimoto authored on 2010-01-30
274
=head1 METHODS
275

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

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

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

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

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
291
=head2 C<fetch_first>
292

            
293
    my $row = $result->fetch_first;
294

            
295
Fetch only a first row into array and finish statment handle.
296

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
303
=head2 C<fetch_hash_all>
304

            
305
    my $rows = $result->fetch_hash_all;
306

            
307
Fetch all rows into array of hash.
308

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

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

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
324
    my $rows = $result->fetch_multi(5);
325
    
326
Fetch multiple rows into array of array.
327
Row count must be specified.
removed DESTROY method(not b...
yuki-kimoto authored on 2010-07-18
328

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