Newer Older
354 lines | 7.165kb
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 {
13
    my ($self, $type) = @_;
many many changes
yuki-kimoto authored on 2010-04-30
14
    
15
    my $sth            = $self->sth;
16
    my $filters        = $self->filters || {};
many change
yuki-kimoto authored on 2010-04-30
17
    my $default_filter = $self->default_filter || '';
many many changes
yuki-kimoto authored on 2010-04-30
18
    my $filter         = $self->filter || {};
packaging one directory
yuki-kimoto authored on 2009-11-16
19
    
20
    # Fetch
21
    my $row = $sth->fetchrow_arrayref;
22
    
23
    # Cannot fetch
24
    return unless $row;
many many changes
yuki-kimoto authored on 2010-04-30
25

            
26
    # Key
27
    my $columns  = $sth->{NAME_lc};
packaging one directory
yuki-kimoto authored on 2009-11-16
28
    
29
    # Filter
many many changes
yuki-kimoto authored on 2010-04-30
30
    for (my $i = 0; $i < @$columns; $i++) {
many change
yuki-kimoto authored on 2010-04-30
31
        my $fname  = $filter->{$columns->[$i]} || $filters->{$default_filter} || '';
many many changes
yuki-kimoto authored on 2010-04-30
32
        my $filter = $filters->{$fname};
33
        $row->[$i] = $filter->($row->[$i]) if $filter;
packaging one directory
yuki-kimoto authored on 2009-11-16
34
    }
many many changes
yuki-kimoto authored on 2010-04-30
35

            
packaging one directory
yuki-kimoto authored on 2009-11-16
36
    return wantarray ? @$row : $row;
37
}
38

            
39
sub fetch_hash {
40
    my $self = shift;
many many changes
yuki-kimoto authored on 2010-04-30
41

            
42
    my $sth            = $self->sth;
43
    my $filters        = $self->filters || {};
many change
yuki-kimoto authored on 2010-04-30
44
    my $default_filter = $self->default_filter || '';
many many changes
yuki-kimoto authored on 2010-04-30
45
    my $filter         = $self->filter || {};
packaging one directory
yuki-kimoto authored on 2009-11-16
46
    
47
    # Fetch
48
    my $row = $sth->fetchrow_arrayref;
49
    
50
    # Cannot fetch
51
    return unless $row;
52
    
53
    # Keys
many many changes
yuki-kimoto authored on 2010-04-30
54
    my $columns  = $sth->{NAME_lc};
packaging one directory
yuki-kimoto authored on 2009-11-16
55
    
56
    # Filter
57
    my $row_hash = {};
many many changes
yuki-kimoto authored on 2010-04-30
58
    for (my $i = 0; $i < @$columns; $i++) {
fixed default_fetch_filter
yuki-kimoto authored on 2010-05-01
59
        my $fname  = $filter->{$columns->[$i]} || $default_filter || '';
many many changes
yuki-kimoto authored on 2010-04-30
60
        my $filter = $filters->{$fname};
61
        $row_hash->{$columns->[$i]} = $filter
many change
yuki-kimoto authored on 2010-04-30
62
                                    ? $filter->($row->[$i])
63
                                    : $row->[$i];
packaging one directory
yuki-kimoto authored on 2009-11-16
64
    }
65
    
66
    return wantarray ? %$row_hash : $row_hash;
67
}
68

            
rename fetch_first to fetch_...
yuki-kimoto authored on 2010-01-29
69
sub fetch_single {
packaging one directory
yuki-kimoto authored on 2009-11-16
70
    my $self = shift;
71
    
72
    # Fetch
73
    my $row = $self->fetch;
74
    
75
    # Not exist
76
    return unless $row;
77
    
78
    # Finish statement handle
79
    $self->finish;
80
    
81
    return wantarray ? @$row : $row;
82
}
83

            
rename fetch_first to fetch_...
yuki-kimoto authored on 2010-01-29
84
sub fetch_hash_single {
packaging one directory
yuki-kimoto authored on 2009-11-16
85
    my $self = shift;
86
    
87
    # Fetch hash
88
    my $row = $self->fetch_hash;
89
    
90
    # Not exist
91
    return unless $row;
92
    
93
    # Finish statement handle
94
    $self->finish;
95
    
96
    return wantarray ? %$row : $row;
97
}
98

            
99
sub fetch_rows {
100
    my ($self, $count) = @_;
101
    
102
    # Not specified Row count
103
    croak("Row count must be specified")
104
      unless $count;
105
    
106
    # Fetch multi rows
107
    my $rows = [];
108
    for (my $i = 0; $i < $count; $i++) {
109
        my @row = $self->fetch;
110
        
111
        last unless @row;
112
        
113
        push @$rows, \@row;
114
    }
115
    
116
    return unless @$rows;
117
    return wantarray ? @$rows : $rows;
118
}
119

            
120
sub fetch_hash_rows {
121
    my ($self, $count) = @_;
122
    
123
    # Not specified Row count
124
    croak("Row count must be specified")
125
      unless $count;
126
    
127
    # Fetch multi rows
128
    my $rows = [];
129
    for (my $i = 0; $i < $count; $i++) {
130
        my %row = $self->fetch_hash;
131
        
132
        last unless %row;
133
        
134
        push @$rows, \%row;
135
    }
136
    
137
    return unless @$rows;
138
    return wantarray ? @$rows : $rows;
139
}
140

            
141
sub fetch_all {
142
    my $self = shift;
143
    
update document
yuki-kimoto authored on 2010-01-30
144
    # Fetch all rows
packaging one directory
yuki-kimoto authored on 2009-11-16
145
    my $rows = [];
146
    while(my @row = $self->fetch) {
147
        push @$rows, [@row];
148
    }
149
    return wantarray ? @$rows : $rows;
150
}
151

            
152
sub fetch_hash_all {
153
    my $self = shift;
154
    
update document
yuki-kimoto authored on 2010-01-30
155
    # Fetch all rows as hash
packaging one directory
yuki-kimoto authored on 2009-11-16
156
    my $rows = [];
157
    while(my %row = $self->fetch_hash) {
158
        push @$rows, {%row};
159
    }
160
    return wantarray ? @$rows : $rows;
161
}
162

            
163
sub finish { shift->sth->finish }
164

            
165
sub error { 
166
    my $self = shift;
update document
yuki-kimoto authored on 2010-01-30
167
    
168
    # Statement handle
packaging one directory
yuki-kimoto authored on 2009-11-16
169
    my $sth  = $self->sth;
update document
yuki-kimoto authored on 2010-01-30
170
    
packaging one directory
yuki-kimoto authored on 2009-11-16
171
    return wantarray ? ($sth->errstr, $sth->err, $sth->state) : $sth->errstr;
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

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

            
update document
yuki-kimoto authored on 2010-01-30
180
=head1 SYNOPSIS
packaging one directory
yuki-kimoto authored on 2009-11-16
181

            
rename query() to execute()
yuki-kimoto authored on 2010-05-01
182
    my $result = $dbi->execute($query);
packaging one directory
yuki-kimoto authored on 2009-11-16
183
    
version 0.0901
yuki-kimoto authored on 2009-12-17
184
    # Fetch
185
    while (my @row = $result->fetch) {
186
        # Do something
187
    }
188
    
189
    # Fetch hash
190
    while (my %row = $result->fetch_hash) {
191
        # Do something
packaging one directory
yuki-kimoto authored on 2009-11-16
192
    }
193

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

            
196
=head2 sth
197

            
update document
yuki-kimoto authored on 2010-01-30
198
Statement handle
update document
yuki-kimoto authored on 2009-11-19
199

            
version 0.0901
yuki-kimoto authored on 2009-12-17
200
    $result = $result->sth($sth);
201
    $sth    = $reuslt->sth
update document
yuki-kimoto authored on 2009-11-19
202
    
many many changes
yuki-kimoto authored on 2010-04-30
203
=head2 default_filter
204

            
205
Filter excuted when data is fetched
206

            
many change
yuki-kimoto authored on 2010-04-30
207
    $result         = $result->default_filter($default_filter);
many many changes
yuki-kimoto authored on 2010-04-30
208
    $default_filter = $result->default_filter;
209

            
210
=head2 filter
packaging one directory
yuki-kimoto authored on 2009-11-16
211

            
update document
yuki-kimoto authored on 2010-01-30
212
Filter excuted when data is fetched
update document
yuki-kimoto authored on 2009-11-19
213

            
many many changes
yuki-kimoto authored on 2010-04-30
214
    $result   = $result->filter($sth);
215
    $filter   = $result->filter;
packaging one directory
yuki-kimoto authored on 2009-11-16
216

            
update document
yuki-kimoto authored on 2010-01-30
217
=head1 METHODS
218

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

            
cleanup
yuki-kimoto authored on 2009-12-22
222
=head2 new
223

            
224
    my $result = DBIx::Custom::Result->new;
225

            
packaging one directory
yuki-kimoto authored on 2009-11-16
226
=head2 fetch
227

            
update document
yuki-kimoto authored on 2009-11-19
228
Fetch a row
229

            
version 0.0901
yuki-kimoto authored on 2009-12-17
230
    $row = $result->fetch; # array reference
231
    @row = $result->fecth; # array
232

            
233
The following is fetch sample
packaging one directory
yuki-kimoto authored on 2009-11-16
234

            
235
    while (my $row = $result->fetch) {
236
        # do something
237
        my $val1 = $row->[0];
238
        my $val2 = $row->[1];
239
    }
240

            
241
=head2 fetch_hash
242

            
update document
yuki-kimoto authored on 2009-11-19
243
Fetch row as hash
244

            
version 0.0901
yuki-kimoto authored on 2009-12-17
245
    $row = $result->fetch_hash; # hash reference
246
    %row = $result->fetch_hash; # hash
247

            
248
The following is fetch_hash sample
packaging one directory
yuki-kimoto authored on 2009-11-16
249

            
250
    while (my $row = $result->fetch_hash) {
251
        # do something
252
        my $val1 = $row->{key1};
253
        my $val2 = $row->{key2};
254
    }
255

            
rename fetch_first to fetch_...
yuki-kimoto authored on 2010-01-29
256
=head2 fetch_single
packaging one directory
yuki-kimoto authored on 2009-11-16
257

            
update document
yuki-kimoto authored on 2009-11-19
258
Fetch only first row(Scalar context)
259

            
rename fetch_first to fetch_...
yuki-kimoto authored on 2010-01-29
260
    $row = $result->fetch_single; # array reference
261
    @row = $result->fetch_single; # array
packaging one directory
yuki-kimoto authored on 2009-11-16
262
    
rename fetch_first to fetch_...
yuki-kimoto authored on 2010-01-29
263
The following is fetch_single sample
version 0.0901
yuki-kimoto authored on 2009-12-17
264

            
rename fetch_first to fetch_...
yuki-kimoto authored on 2010-01-29
265
    $row = $result->fetch_single;
packaging one directory
yuki-kimoto authored on 2009-11-16
266
    
update document
yuki-kimoto authored on 2009-11-19
267
This method fetch only first row and finish statement handle
packaging one directory
yuki-kimoto authored on 2009-11-16
268

            
rename fetch_first to fetch_...
yuki-kimoto authored on 2010-01-29
269
=head2 fetch_hash_single
packaging one directory
yuki-kimoto authored on 2009-11-16
270
    
update document
yuki-kimoto authored on 2009-11-19
271
Fetch only first row as hash
272

            
rename fetch_first to fetch_...
yuki-kimoto authored on 2010-01-29
273
    $row = $result->fetch_hash_single; # hash reference
274
    %row = $result->fetch_hash_single; # hash
packaging one directory
yuki-kimoto authored on 2009-11-16
275
    
rename fetch_first to fetch_...
yuki-kimoto authored on 2010-01-29
276
The following is fetch_hash_single sample
version 0.0901
yuki-kimoto authored on 2009-12-17
277

            
rename fetch_first to fetch_...
yuki-kimoto authored on 2010-01-29
278
    $row = $result->fetch_hash_single;
packaging one directory
yuki-kimoto authored on 2009-11-16
279
    
rename fetch_first to fetch_...
yuki-kimoto authored on 2010-01-29
280
This method fetch only single row and finish statement handle
packaging one directory
yuki-kimoto authored on 2009-11-16
281

            
282
=head2 fetch_rows
283

            
update document
yuki-kimoto authored on 2009-11-19
284
Fetch rows
285

            
version 0.0901
yuki-kimoto authored on 2009-12-17
286
    $rows = $result->fetch_rows($row_count); # array ref of array ref
287
    @rows = $result->fetch_rows($row_count); # array of array ref
packaging one directory
yuki-kimoto authored on 2009-11-16
288
    
version 0.0901
yuki-kimoto authored on 2009-12-17
289
The following is fetch_rows sample
290

            
update document
yuki-kimoto authored on 2009-11-19
291
    while(my $rows = $result->fetch_rows(10)) {
292
        # do someting
293
    }
packaging one directory
yuki-kimoto authored on 2009-11-16
294

            
295
=head2 fetch_hash_rows
296

            
update document
yuki-kimoto authored on 2009-11-19
297
Fetch rows as hash
298

            
version 0.0901
yuki-kimoto authored on 2009-12-17
299
    $rows = $result->fetch_hash_rows($row_count); # array ref of hash ref
300
    @rows = $result->fetch_hash_rows($row_count); # array of hash ref
packaging one directory
yuki-kimoto authored on 2009-11-16
301
    
version 0.0901
yuki-kimoto authored on 2009-12-17
302
The following is fetch_hash_rows sample
303

            
update document
yuki-kimoto authored on 2009-11-19
304
    while(my $rows = $result->fetch_hash_rows(10)) {
305
        # do someting
306
    }
packaging one directory
yuki-kimoto authored on 2009-11-16
307

            
308
=head2 fetch_all
309

            
update document
yuki-kimoto authored on 2009-11-19
310
Fetch all rows
311

            
version 0.0901
yuki-kimoto authored on 2009-12-17
312
    $rows = $result->fetch_all; # array ref of array ref
313
    @rows = $result->fecth_all; # array of array ref
314

            
315
The following is fetch_all sample
packaging one directory
yuki-kimoto authored on 2009-11-16
316

            
317
    my $rows = $result->fetch_all;
318

            
319
=head2 fetch_hash_all
320

            
update document
yuki-kimoto authored on 2009-11-19
321
Fetch all row as array ref of hash ref (Scalar context)
322

            
version 0.0901
yuki-kimoto authored on 2009-12-17
323
    $rows = $result->fetch_hash_all; # array ref of hash ref
324
    @rows = $result->fecth_all_hash; # array of hash ref
325

            
326
The following is fetch_hash_all sample
packaging one directory
yuki-kimoto authored on 2009-11-16
327

            
328
    my $rows = $result->fetch_hash_all;
329

            
330
=head2 error
331

            
update document
yuki-kimoto authored on 2009-11-19
332
Get error infomation
333

            
version 0.0901
yuki-kimoto authored on 2009-12-17
334
    $error_messege = $result->error;
335
    ($error_message, $error_number, $error_state) = $result->error;
update document
yuki-kimoto authored on 2009-11-19
336
    
packaging one directory
yuki-kimoto authored on 2009-11-16
337

            
update document
yuki-kimoto authored on 2009-11-19
338
You can get get information. This is same as the following.
packaging one directory
yuki-kimoto authored on 2009-11-16
339

            
340
    $error_message : $result->sth->errstr
341
    $error_number  : $result->sth->err
342
    $error_state   : $result->sth->state
343

            
344
=head2 finish
345

            
update document
yuki-kimoto authored on 2009-11-19
346
Finish statement handle
347

            
packaging one directory
yuki-kimoto authored on 2009-11-16
348
    $result->finish
349

            
update document
yuki-kimoto authored on 2009-11-19
350
This is equel to
packaging one directory
yuki-kimoto authored on 2009-11-16
351

            
352
    $result->sth->finish;
353

            
354
=cut