Newer Older
308 lines | 6.195kb
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

            
many many changes
yuki-kimoto authored on 2010-04-30
10
__PACKAGE__->attr([qw/sth filters default_filter filter/]);
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
changed argument of tag proc...
yuki-kimoto authored on 2010-08-03
16
    $self->{filters} ||= {};
17
    $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;
many many changes
yuki-kimoto authored on 2010-04-30
24

            
cleanup
yuki-kimoto authored on 2010-08-05
25
    # Filtering
26
    my $columns = $self->{sth}->{NAME_lc};
27
    for (my $i = 0; $i < @$columns; $i++) {
update document
yuki-kimoto authored on 2010-05-27
28
        
changed argument of tag proc...
yuki-kimoto authored on 2010-08-03
29
        # Filter name
cleanup
yuki-kimoto authored on 2010-08-05
30
        my $column = $columns->[$i];
changed argument of tag proc...
yuki-kimoto authored on 2010-08-03
31
        my $fname  = exists $self->{filter}->{$column}
32
                   ? $self->{filter}->{$column}
33
                   : $self->{default_filter};
some changed
yuki-kimoto authored on 2010-05-02
34
        
cleanup
yuki-kimoto authored on 2010-08-05
35
        # Filtering
changed argument of tag proc...
yuki-kimoto authored on 2010-08-03
36
        $row[$i] = $self->{filters}->{$fname}->($row[$i])
37
          if $fname;
packaging one directory
yuki-kimoto authored on 2009-11-16
38
    }
many many changes
yuki-kimoto authored on 2010-04-30
39

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
40
    return \@row;
41
}
42

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

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

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

            
88
sub fetch_hash {
changed argument of tag proc...
yuki-kimoto authored on 2010-08-03
89
    my $self = shift;
90
    
cleanup
yuki-kimoto authored on 2010-08-05
91
    # Filters
changed argument of tag proc...
yuki-kimoto authored on 2010-08-03
92
    $self->{filters} ||= {};
93
    $self->{filter}  ||= {};
packaging one directory
yuki-kimoto authored on 2009-11-16
94
    
95
    # Fetch
changed argument of tag proc...
yuki-kimoto authored on 2010-08-03
96
    my $row = $self->{sth}->fetchrow_arrayref;
packaging one directory
yuki-kimoto authored on 2009-11-16
97
    
98
    # Cannot fetch
99
    return unless $row;
100
    
101
    # Filter
102
    my $row_hash = {};
cleanup
yuki-kimoto authored on 2010-08-05
103
    my $columns = $self->{sth}->{NAME_lc};
104
    for (my $i = 0; $i < @$columns; $i++) {
update document
yuki-kimoto authored on 2010-05-27
105
        
changed argument of tag proc...
yuki-kimoto authored on 2010-08-03
106
        # Filter name
cleanup
yuki-kimoto authored on 2010-08-05
107
        my $column = $columns->[$i];
changed argument of tag proc...
yuki-kimoto authored on 2010-08-03
108
        my $fname  = exists $self->{filter}->{$column}
109
                   ? $self->{filter}->{$column}
110
                   : $self->{default_filter};
add query filter error check
yuki-kimoto authored on 2010-05-14
111
        
cleanup
yuki-kimoto authored on 2010-08-05
112
        # Filtering
changed argument of tag proc...
yuki-kimoto authored on 2010-08-03
113
        $row_hash->{$column}
114
          = $fname ? $self->{filters}->{$fname}->($row->[$i]) 
115
                   : $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

            
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

            
155
sub fetch_hash_all {
156
    my $self = shift;
157
    
update document
yuki-kimoto authored on 2010-01-30
158
    # Fetch all rows as hash
packaging one directory
yuki-kimoto authored on 2009-11-16
159
    my $rows = [];
removed reconnect method
yuki-kimoto authored on 2010-05-28
160
    while(my $row = $self->fetch_hash) {
161
        push @$rows, $row;
packaging one directory
yuki-kimoto authored on 2009-11-16
162
    }
changed argument of tag proc...
yuki-kimoto authored on 2010-08-03
163
    
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

            
update document
yuki-kimoto authored on 2010-01-30
167
1;
168

            
packaging one directory
yuki-kimoto authored on 2009-11-16
169
=head1 NAME
170

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

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

            
175
Get the result of select statement.
176

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

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

            
204
Fetch row into hash.
205

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

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

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

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

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

            
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

            
update document
yuki-kimoto authored on 2010-01-30
253
=head1 METHODS
254

            
cleanup
yuki-kimoto authored on 2010-08-05
255
L<DBIx::Custom::Resutl> inherits all methods from L<Object::Simple>
256
and implements the following new ones.
packaging one directory
yuki-kimoto authored on 2009-11-16
257

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

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

            
cleanup
yuki-kimoto authored on 2010-08-05
262
Fetch a row into array.
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<fetch_first>
update document
yuki-kimoto authored on 2009-11-19
265

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

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

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

            
cleanup
yuki-kimoto authored on 2010-08-05
272
    my $rows = $result->fetch_multi(5);
packaging one directory
yuki-kimoto authored on 2009-11-16
273
    
removed DESTROY method(not b...
yuki-kimoto authored on 2010-07-18
274
Fetch multiple rows into array of array.
cleanup
yuki-kimoto authored on 2010-08-05
275
Row count must be specified.
packaging one directory
yuki-kimoto authored on 2009-11-16
276

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

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

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

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

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

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

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

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

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

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

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

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

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

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