Newer Older
342 lines | 7.369kb
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 check_filter attribute
yuki-kimoto authored on 2010-08-08
10
__PACKAGE__->attr([qw/sth filters default_filter filter filter_check/]);
cleanup
yuki-kimoto authored on 2010-01-21
11

            
packaging one directory
yuki-kimoto authored on 2009-11-16
12
sub fetch {
changed argument of tag proc...
yuki-kimoto authored on 2010-08-03
13
    my $self = shift;
14
    
cleanup
yuki-kimoto authored on 2010-08-05
15
    # Filters
added check_filter attribute
yuki-kimoto authored on 2010-08-08
16
    my $filters = $self->{filters} || {};
17
    my $filter  = $self->{filter}  || {};
packaging one directory
yuki-kimoto authored on 2009-11-16
18
    
19
    # Fetch
changed argument of tag proc...
yuki-kimoto authored on 2010-08-03
20
    my @row = $self->{sth}->fetchrow_array;
packaging one directory
yuki-kimoto authored on 2009-11-16
21
    
cleanup
yuki-kimoto authored on 2010-08-05
22
    # No row
update document
yuki-kimoto authored on 2010-05-27
23
    return unless @row;
added check_filter attribute
yuki-kimoto authored on 2010-08-08
24
    
25
    # Check filter
26
    $self->_check_filter($filters, $filter, 
27
                         $self->default_filter, $self->sth)
28
      if $self->{filter_check};
29
    
cleanup
yuki-kimoto authored on 2010-08-05
30
    # Filtering
31
    my $columns = $self->{sth}->{NAME_lc};
32
    for (my $i = 0; $i < @$columns; $i++) {
update document
yuki-kimoto authored on 2010-05-27
33
        
changed argument of tag proc...
yuki-kimoto authored on 2010-08-03
34
        # Filter name
cleanup
yuki-kimoto authored on 2010-08-05
35
        my $column = $columns->[$i];
added check_filter attribute
yuki-kimoto authored on 2010-08-08
36
        my $fname  = exists $filter->{$column}
37
                   ? $filter->{$column}
changed argument of tag proc...
yuki-kimoto authored on 2010-08-03
38
                   : $self->{default_filter};
some changed
yuki-kimoto authored on 2010-05-02
39
        
cleanup
yuki-kimoto authored on 2010-08-05
40
        # Filtering
added check_filter attribute
yuki-kimoto authored on 2010-08-08
41
        $row[$i] = $filters->{$fname}->($row[$i])
changed argument of tag proc...
yuki-kimoto authored on 2010-08-03
42
          if $fname;
packaging one directory
yuki-kimoto authored on 2009-11-16
43
    }
many many changes
yuki-kimoto authored on 2010-04-30
44

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

            
48
sub fetch_first {
49
    my $self = shift;
50
    
51
    # Fetch
52
    my $row = $self->fetch;
53
    
cleanup
yuki-kimoto authored on 2010-08-05
54
    # No row
removed reconnect method
yuki-kimoto authored on 2010-05-28
55
    return unless $row;
56
    
57
    # Finish statement handle
58
    $self->sth->finish;
59
    
60
    return $row;
61
}
62

            
63
sub fetch_multi {
64
    my ($self, $count) = @_;
65
    
cleanup
yuki-kimoto authored on 2010-08-05
66
    # Row count not specifed
changed argument of tag proc...
yuki-kimoto authored on 2010-08-03
67
    croak 'Row count must be specified'
removed reconnect method
yuki-kimoto authored on 2010-05-28
68
      unless $count;
69
    
70
    # Fetch multi rows
71
    my $rows = [];
72
    for (my $i = 0; $i < $count; $i++) {
73
        my $row = $self->fetch;
74
        last unless $row;
75
        push @$rows, $row;
76
    }
77
    
78
    return unless @$rows;
79
    return $rows;
80
}
81

            
82
sub fetch_all {
83
    my $self = shift;
84
    
85
    # Fetch all rows
86
    my $rows = [];
87
    while(my $row = $self->fetch) {
88
        push @$rows, $row;
89
    }
90
    return $rows;
packaging one directory
yuki-kimoto authored on 2009-11-16
91
}
92

            
93
sub fetch_hash {
changed argument of tag proc...
yuki-kimoto authored on 2010-08-03
94
    my $self = shift;
95
    
cleanup
yuki-kimoto authored on 2010-08-05
96
    # Filters
added check_filter attribute
yuki-kimoto authored on 2010-08-08
97
    my $filters = $self->{filters} || {};
98
    my $filter  = $self->{filter}  || {};
packaging one directory
yuki-kimoto authored on 2009-11-16
99
    
100
    # Fetch
changed argument of tag proc...
yuki-kimoto authored on 2010-08-03
101
    my $row = $self->{sth}->fetchrow_arrayref;
packaging one directory
yuki-kimoto authored on 2009-11-16
102
    
103
    # Cannot fetch
104
    return unless $row;
added check_filter attribute
yuki-kimoto authored on 2010-08-08
105

            
106
    # Check filter
107
    $self->_check_filter($filters, $filter, 
108
                         $self->default_filter, $self->sth)
109
      if $self->{filter_check};
110

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

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

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

            
165
sub fetch_hash_all {
166
    my $self = shift;
167
    
update document
yuki-kimoto authored on 2010-01-30
168
    # Fetch all rows as hash
packaging one directory
yuki-kimoto authored on 2009-11-16
169
    my $rows = [];
removed reconnect method
yuki-kimoto authored on 2010-05-28
170
    while(my $row = $self->fetch_hash) {
171
        push @$rows, $row;
packaging one directory
yuki-kimoto authored on 2009-11-16
172
    }
changed argument of tag proc...
yuki-kimoto authored on 2010-08-03
173
    
removed reconnect method
yuki-kimoto authored on 2010-05-28
174
    return $rows;
packaging one directory
yuki-kimoto authored on 2009-11-16
175
}
176

            
added check_filter attribute
yuki-kimoto authored on 2010-08-08
177
sub _check_filter {
178
    my ($self, $filters, $filter, $default_filter, $sth) = @_;
179
    
180
    # Filter name not exists
181
    foreach my $fname (values %$filter) {
182
        croak qq{Fetch filter "$fname" is not registered}
183
          unless exists $filters->{$fname};
184
    }
185
    
186
    # Default filter name not exists
187
    croak qq{Default fetch filter "$default_filter" is not registered}
188
      if $default_filter && ! exists $filters->{$default_filter};
189
    
190
    # Column name not exists
191
    my %columns = map {$_ => 1} @{$self->sth->{NAME_lc}};
192
    foreach my $column (keys %$filter) {
193
        croak qq{Column name "$column" in fetch filter must lower case string}
194
          unless $column eq lc $column;
195
        
196
        croak qq{Column name "$column" in fetch filter is not found in result columns}
197
          unless $columns{$column};
198
    }
199
}
200

            
update document
yuki-kimoto authored on 2010-01-30
201
1;
202

            
packaging one directory
yuki-kimoto authored on 2009-11-16
203
=head1 NAME
204

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

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

            
209
Get the result of select statement.
210

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

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

            
238
Fetch row into hash.
239

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

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

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

            
cleanup
yuki-kimoto authored on 2010-08-03
266
    my $sth = $reuslt->sth
version 0.0901
yuki-kimoto authored on 2009-12-17
267
    $result = $result->sth($sth);
many many changes
yuki-kimoto authored on 2010-04-30
268

            
cleanup
yuki-kimoto authored on 2010-08-05
269
Statement handle of L<DBI>.
removed DESTROY method(not b...
yuki-kimoto authored on 2010-07-18
270

            
271
=head2 C<default_filter>
many many changes
yuki-kimoto authored on 2010-04-30
272

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

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

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

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

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

            
update document
yuki-kimoto authored on 2010-01-30
287
=head1 METHODS
288

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

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

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

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

            
removed DBIx::Custom commit ...
yuki-kimoto authored on 2010-07-14
298
=head2 C<fetch_first>
update document
yuki-kimoto authored on 2009-11-19
299

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

            
cleanup
yuki-kimoto authored on 2010-08-05
302
Fetch only a first row into array and finish statment handle.
packaging one directory
yuki-kimoto authored on 2009-11-16
303

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

            
cleanup
yuki-kimoto authored on 2010-08-05
306
    my $rows = $result->fetch_multi(5);
packaging one directory
yuki-kimoto authored on 2009-11-16
307
    
removed DESTROY method(not b...
yuki-kimoto authored on 2010-07-18
308
Fetch multiple rows into array of array.
cleanup
yuki-kimoto authored on 2010-08-05
309
Row count must be specified.
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

            
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

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

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

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

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

            
cleanup
yuki-kimoto authored on 2010-08-05
338
    my $rows = $result->fetch_hash_all;
packaging one directory
yuki-kimoto authored on 2009-11-16
339

            
removed DESTROY method(not b...
yuki-kimoto authored on 2010-07-18
340
Fetch all rows into array of hash.
341

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