Newer Older
319 lines | 6.107kb
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 {
update document
yuki-kimoto authored on 2010-05-27
13

            
14
    $_[0]->{filters} ||= {};
15
    $_[0]->{filter}  ||= {};
packaging one directory
yuki-kimoto authored on 2009-11-16
16
    
17
    # Fetch
update document
yuki-kimoto authored on 2010-05-27
18
    my @row = $_[0]->{sth}->fetchrow_array;
packaging one directory
yuki-kimoto authored on 2009-11-16
19
    
20
    # Cannot fetch
update document
yuki-kimoto authored on 2010-05-27
21
    return unless @row;
many many changes
yuki-kimoto authored on 2010-04-30
22

            
packaging one directory
yuki-kimoto authored on 2009-11-16
23
    # Filter
update document
yuki-kimoto authored on 2010-05-27
24
    for (my $i = 0; $i < @{$_[0]->{sth}->{NAME_lc}}; $i++) {
25
        my $fname  = $_[0]->{filter}->{$_[0]->{sth}->{NAME_lc}->[$i]} 
26
                  || $_[0]->{default_filter};
27
        
28
        croak "Filter \"$fname\" is not registered."
29
          if $fname && ! exists $_[0]->{filters}->{$fname};
some changed
yuki-kimoto authored on 2010-05-02
30
        
update document
yuki-kimoto authored on 2010-05-27
31
        next unless $fname;
32
        
33
        $row[$i] = ref $fname
34
                   ? $fname->($row[$i]) 
35
                   : $_[0]->{filters}->{$fname}->($row[$i]);
packaging one directory
yuki-kimoto authored on 2009-11-16
36
    }
many many changes
yuki-kimoto authored on 2010-04-30
37

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

            
41
sub fetch_first {
42
    my $self = shift;
43
    
44
    # Fetch
45
    my $row = $self->fetch;
46
    
47
    # Not exist
48
    return unless $row;
49
    
50
    # Finish statement handle
51
    $self->sth->finish;
52
    
53
    return $row;
54
}
55

            
56
sub fetch_multi {
57
    my ($self, $count) = @_;
58
    
59
    # Not specified Row count
60
    croak("Row count must be specified")
61
      unless $count;
62
    
63
    # Fetch multi rows
64
    my $rows = [];
65
    for (my $i = 0; $i < $count; $i++) {
66
        my $row = $self->fetch;
67
        
68
        last unless $row;
69
        
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 {
many many changes
yuki-kimoto authored on 2010-04-30
89

            
update document
yuki-kimoto authored on 2010-05-27
90
    $_[0]->{filters} ||= {};
91
    $_[0]->{filter}  ||= {};
packaging one directory
yuki-kimoto authored on 2009-11-16
92
    
93
    # Fetch
update document
yuki-kimoto authored on 2010-05-27
94
    my $row = $_[0]->{sth}->fetchrow_arrayref;
packaging one directory
yuki-kimoto authored on 2009-11-16
95
    
96
    # Cannot fetch
97
    return unless $row;
98
    
99
    # Filter
100
    my $row_hash = {};
update document
yuki-kimoto authored on 2010-05-27
101
    for (my $i = 0; $i < @{$_[0]->{sth}->{NAME_lc}}; $i++) {
102
        
103
        my $fname  = $_[0]->{filter}->{$_[0]->{sth}->{NAME_lc}->[$i]}
104
                  || $_[0]->{default_filter};
add query filter error check
yuki-kimoto authored on 2010-05-14
105
        
update document
yuki-kimoto authored on 2010-05-27
106
        croak "Filter \"$fname\" is not registered."
107
          if $fname && ! exists $_[0]->{filters}->{$fname};
some changed
yuki-kimoto authored on 2010-05-02
108
        
update document
yuki-kimoto authored on 2010-05-27
109
        $row_hash->{$_[0]->{sth}->{NAME_lc}->[$i]}
110
          = !$fname    ? $row->[$i] :
111
            ref $fname ? $fname->($row->[$i]) :
112
            $_[0]->{filters}->{$fname}->($row->[$i]);
packaging one directory
yuki-kimoto authored on 2009-11-16
113
    }
114
    
removed reconnect method
yuki-kimoto authored on 2010-05-28
115
    return $row_hash;
packaging one directory
yuki-kimoto authored on 2009-11-16
116
}
117

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

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

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

            
update document
yuki-kimoto authored on 2010-01-30
165
1;
166

            
packaging one directory
yuki-kimoto authored on 2009-11-16
167
=head1 NAME
168

            
update document
yuki-kimoto authored on 2009-11-17
169
DBIx::Custom::Result - DBIx::Custom Resultset
packaging one directory
yuki-kimoto authored on 2009-11-16
170

            
update document
yuki-kimoto authored on 2010-01-30
171
=head1 SYNOPSIS
packaging one directory
yuki-kimoto authored on 2009-11-16
172
    
removed reconnect method
yuki-kimoto authored on 2010-05-28
173
    # Result
174
    my $result = $dbi->select(table => 'books');
175
    
176
    # Fetch a row into array
177
    while (my $row = $result->fetch) {
178
        my $value1 = $row->[0];
179
        my $valuu2 = $row->[1];
180
        
181
        # do something
version 0.0901
yuki-kimoto authored on 2009-12-17
182
    }
183
    
removed reconnect method
yuki-kimoto authored on 2010-05-28
184
    # Fetch only first row into array
185
    my $row = $result->fetch_first;
186
    
187
    # Fetch multiple rows into array of array
188
    while (my $rows = $result->fetch_multi(5)) {
189
        # do something
190
    }
191
    
192
    # Fetch all rows into array of array
193
    my $rows = $result->fetch_all;
194
    
195
    # Fetch hash into hash
196
    while (my $row = $result->fetch_hash) {
197
        my $value1 = $row->{title};
198
        my $value2 = $row->{author};
199
        
200
        # do something
packaging one directory
yuki-kimoto authored on 2009-11-16
201
    }
removed reconnect method
yuki-kimoto authored on 2010-05-28
202
    
203
    # Fetch only first row into hash
204
    my $row = $result->fetch_hash_first;
205
    
206
    # Fetch multiple rows into array of hash
207
    while (my $rows = $result->fetch_hash_multi) {
208
        # do something
209
    }
210
    
211
    # Fetch all rows into array of hash
212
    my $rows = $result->fetch_hash_all;
packaging one directory
yuki-kimoto authored on 2009-11-16
213

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

            
216
=head2 sth
217

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
218
Statement handle.
update document
yuki-kimoto authored on 2009-11-19
219

            
version 0.0901
yuki-kimoto authored on 2009-12-17
220
    $result = $result->sth($sth);
221
    $sth    = $reuslt->sth
update document
yuki-kimoto authored on 2009-11-19
222
    
many many changes
yuki-kimoto authored on 2010-04-30
223
=head2 default_filter
224

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
225
Default filter.
many many changes
yuki-kimoto authored on 2010-04-30
226

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
227
    $result         = $result->default_filter('decode_utf8');
many many changes
yuki-kimoto authored on 2010-04-30
228
    $default_filter = $result->default_filter;
229

            
230
=head2 filter
packaging one directory
yuki-kimoto authored on 2009-11-16
231

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
232
Filter
update document
yuki-kimoto authored on 2009-11-19
233

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
234
    $result = $result->filter({title => 'decode_utf8'});
235
    $filter = $result->filter;
packaging one directory
yuki-kimoto authored on 2009-11-16
236

            
update document
yuki-kimoto authored on 2010-01-30
237
=head1 METHODS
238

            
239
This class is L<Object::Simple> subclass.
240
You can use all methods of L<Object::Simple>
packaging one directory
yuki-kimoto authored on 2009-11-16
241

            
242
=head2 fetch
243

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
244
Fetch a row into array
update document
yuki-kimoto authored on 2009-11-19
245

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
246
    $row = $result->fetch;
version 0.0901
yuki-kimoto authored on 2009-12-17
247

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
248
Example:
packaging one directory
yuki-kimoto authored on 2009-11-16
249

            
250
    while (my $row = $result->fetch) {
251
        # do something
removed reconnect method
yuki-kimoto authored on 2010-05-28
252
        my $value1 = $row->[0];
253
        my $value2 = $row->[1];
packaging one directory
yuki-kimoto authored on 2009-11-16
254
    }
255

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
256
=head2 fetch_first
update document
yuki-kimoto authored on 2009-11-19
257

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
258
Fetch only first row into array and finish statment handle.
version 0.0901
yuki-kimoto authored on 2009-12-17
259

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
260
    $row = $result->fetch_first;
packaging one directory
yuki-kimoto authored on 2009-11-16
261

            
renamed fetch_rows to fetch_...
yuki-kimoto authored on 2010-05-01
262
=head2 fetch_multi
packaging one directory
yuki-kimoto authored on 2009-11-16
263

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
264
Fetch multiple rows into array of array.
update document
yuki-kimoto authored on 2009-11-19
265

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
266
    $rows = $result->fetch_multi($count);
packaging one directory
yuki-kimoto authored on 2009-11-16
267
    
removed reconnect method
yuki-kimoto authored on 2010-05-28
268
Example:
version 0.0901
yuki-kimoto authored on 2009-12-17
269

            
renamed fetch_rows to fetch_...
yuki-kimoto authored on 2010-05-01
270
    while(my $rows = $result->fetch_multi(10)) {
update document
yuki-kimoto authored on 2009-11-19
271
        # do someting
272
    }
packaging one directory
yuki-kimoto authored on 2009-11-16
273

            
274
=head2 fetch_all
275

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
276
Fetch all rows into array of array.
update document
yuki-kimoto authored on 2009-11-19
277

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
278
    $rows = $result->fetch_all;
version 0.0901
yuki-kimoto authored on 2009-12-17
279

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
280
=head2 fetch_hash
packaging one directory
yuki-kimoto authored on 2009-11-16
281

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
282
Fetch a row into hash
packaging one directory
yuki-kimoto authored on 2009-11-16
283

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
284
    $row = $result->fetch_hash;
packaging one directory
yuki-kimoto authored on 2009-11-16
285

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
286
Example:
update document
yuki-kimoto authored on 2009-11-19
287

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
288
    while (my $row = $result->fetch_hash) {
289
        my $val1 = $row->{title};
290
        my $val2 = $row->{author};
291
        
292
        # do something
293
    }
version 0.0901
yuki-kimoto authored on 2009-12-17
294

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
295
=head2 fetch_hash_first
296
    
297
Fetch only first row into hash and finish statment handle.
packaging one directory
yuki-kimoto authored on 2009-11-16
298

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
299
    $row = $result->fetch_hash_first;
packaging one directory
yuki-kimoto authored on 2009-11-16
300

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
301
=head2 fetch_hash_multi
packaging one directory
yuki-kimoto authored on 2009-11-16
302

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
303
Fetch multiple rows into array of hash
update document
yuki-kimoto authored on 2009-11-19
304

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
305
    $rows = $result->fetch_hash_multi($count);
update document
yuki-kimoto authored on 2009-11-19
306
    
removed reconnect method
yuki-kimoto authored on 2010-05-28
307
Example:
packaging one directory
yuki-kimoto authored on 2009-11-16
308

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
309
    while(my $rows = $result->fetch_hash_multi(10)) {
310
        # do someting
311
    }
update document
yuki-kimoto authored on 2009-11-19
312

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
313
=head2 fetch_hash_all
packaging one directory
yuki-kimoto authored on 2009-11-16
314

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
315
Fetch all rows into array of hash.
packaging one directory
yuki-kimoto authored on 2009-11-16
316

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
317
    $rows = $result->fetch_hash_all;
packaging one directory
yuki-kimoto authored on 2009-11-16
318

            
319
=cut