Newer Older
347 lines | 6.947kb
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

            
catch up with Object::Simple...
yuki-kimoto authored on 2010-01-18
10
__PACKAGE__->attr([qw/_dbi sth fetch_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) = @_;
14
    my $sth = $self->sth;
15
    my $fetch_filter = $self->fetch_filter;
16
    
17
    # Fetch
18
    my $row = $sth->fetchrow_arrayref;
19
    
20
    # Cannot fetch
21
    return unless $row;
22
    
23
    # Filter
24
    if ($fetch_filter) {
25
        my $keys  = $sth->{NAME_lc};
26
        my $types = $sth->{TYPE};
27
        for (my $i = 0; $i < @$keys; $i++) {
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
28
            $row->[$i]= $fetch_filter->($row->[$i], $keys->[$i], $self->_dbi,
29
                                        {type => $types->[$i], sth => $sth, index => $i});
packaging one directory
yuki-kimoto authored on 2009-11-16
30
        }
31
    }
32
    return wantarray ? @$row : $row;
33
}
34

            
35
sub fetch_hash {
36
    my $self = shift;
37
    my $sth = $self->sth;
38
    my $fetch_filter = $self->fetch_filter;
39
    
40
    # Fetch
41
    my $row = $sth->fetchrow_arrayref;
42
    
43
    # Cannot fetch
44
    return unless $row;
45
    
46
    # Keys
47
    my $keys  = $sth->{NAME_lc};
48
    
49
    # Filter
50
    my $row_hash = {};
51
    if ($fetch_filter) {
52
        my $types = $sth->{TYPE};
53
        for (my $i = 0; $i < @$keys; $i++) {
many change
yuki-kimoto authored on 2010-02-11
54
            $row_hash->{$keys->[$i]}
55
              = $fetch_filter->($row->[$i], $keys->[$i], $self->_dbi,
56
                                {type => $types->[$i], sth => $sth, index => $i});
packaging one directory
yuki-kimoto authored on 2009-11-16
57
        }
58
    }
59
    
60
    # No filter
61
    else {
62
        for (my $i = 0; $i < @$keys; $i++) {
63
            $row_hash->{$keys->[$i]} = $row->[$i];
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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
182
    my $result = $dbi->query($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
    
packaging one directory
yuki-kimoto authored on 2009-11-16
203
=head2 fetch_filter
204

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
207
    $result         = $result->fetch_filter($sth);
208
    $fetch_filter   = $result->fech_filter;
packaging one directory
yuki-kimoto authored on 2009-11-16
209

            
update document
yuki-kimoto authored on 2010-01-30
210
=head1 METHODS
211

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

            
cleanup
yuki-kimoto authored on 2009-12-22
215
=head2 new
216

            
217
    my $result = DBIx::Custom::Result->new;
218

            
packaging one directory
yuki-kimoto authored on 2009-11-16
219
=head2 fetch
220

            
update document
yuki-kimoto authored on 2009-11-19
221
Fetch a row
222

            
version 0.0901
yuki-kimoto authored on 2009-12-17
223
    $row = $result->fetch; # array reference
224
    @row = $result->fecth; # array
225

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

            
228
    while (my $row = $result->fetch) {
229
        # do something
230
        my $val1 = $row->[0];
231
        my $val2 = $row->[1];
232
    }
233

            
234
=head2 fetch_hash
235

            
update document
yuki-kimoto authored on 2009-11-19
236
Fetch row as hash
237

            
version 0.0901
yuki-kimoto authored on 2009-12-17
238
    $row = $result->fetch_hash; # hash reference
239
    %row = $result->fetch_hash; # hash
240

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

            
243
    while (my $row = $result->fetch_hash) {
244
        # do something
245
        my $val1 = $row->{key1};
246
        my $val2 = $row->{key2};
247
    }
248

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

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

            
rename fetch_first to fetch_...
yuki-kimoto authored on 2010-01-29
253
    $row = $result->fetch_single; # array reference
254
    @row = $result->fetch_single; # array
packaging one directory
yuki-kimoto authored on 2009-11-16
255
    
rename fetch_first to fetch_...
yuki-kimoto authored on 2010-01-29
256
The following is fetch_single sample
version 0.0901
yuki-kimoto authored on 2009-12-17
257

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

            
rename fetch_first to fetch_...
yuki-kimoto authored on 2010-01-29
262
=head2 fetch_hash_single
packaging one directory
yuki-kimoto authored on 2009-11-16
263
    
update document
yuki-kimoto authored on 2009-11-19
264
Fetch only first row as hash
265

            
rename fetch_first to fetch_...
yuki-kimoto authored on 2010-01-29
266
    $row = $result->fetch_hash_single; # hash reference
267
    %row = $result->fetch_hash_single; # hash
packaging one directory
yuki-kimoto authored on 2009-11-16
268
    
rename fetch_first to fetch_...
yuki-kimoto authored on 2010-01-29
269
The following is fetch_hash_single sample
version 0.0901
yuki-kimoto authored on 2009-12-17
270

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

            
275
=head2 fetch_rows
276

            
update document
yuki-kimoto authored on 2009-11-19
277
Fetch rows
278

            
version 0.0901
yuki-kimoto authored on 2009-12-17
279
    $rows = $result->fetch_rows($row_count); # array ref of array ref
280
    @rows = $result->fetch_rows($row_count); # array of array ref
packaging one directory
yuki-kimoto authored on 2009-11-16
281
    
version 0.0901
yuki-kimoto authored on 2009-12-17
282
The following is fetch_rows sample
283

            
update document
yuki-kimoto authored on 2009-11-19
284
    while(my $rows = $result->fetch_rows(10)) {
285
        # do someting
286
    }
packaging one directory
yuki-kimoto authored on 2009-11-16
287

            
288
=head2 fetch_hash_rows
289

            
update document
yuki-kimoto authored on 2009-11-19
290
Fetch rows as hash
291

            
version 0.0901
yuki-kimoto authored on 2009-12-17
292
    $rows = $result->fetch_hash_rows($row_count); # array ref of hash ref
293
    @rows = $result->fetch_hash_rows($row_count); # array of hash ref
packaging one directory
yuki-kimoto authored on 2009-11-16
294
    
version 0.0901
yuki-kimoto authored on 2009-12-17
295
The following is fetch_hash_rows sample
296

            
update document
yuki-kimoto authored on 2009-11-19
297
    while(my $rows = $result->fetch_hash_rows(10)) {
298
        # do someting
299
    }
packaging one directory
yuki-kimoto authored on 2009-11-16
300

            
301
=head2 fetch_all
302

            
update document
yuki-kimoto authored on 2009-11-19
303
Fetch all rows
304

            
version 0.0901
yuki-kimoto authored on 2009-12-17
305
    $rows = $result->fetch_all; # array ref of array ref
306
    @rows = $result->fecth_all; # array of array ref
307

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

            
310
    my $rows = $result->fetch_all;
311

            
312
=head2 fetch_hash_all
313

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

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

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

            
321
    my $rows = $result->fetch_hash_all;
322

            
323
=head2 error
324

            
update document
yuki-kimoto authored on 2009-11-19
325
Get error infomation
326

            
version 0.0901
yuki-kimoto authored on 2009-12-17
327
    $error_messege = $result->error;
328
    ($error_message, $error_number, $error_state) = $result->error;
update document
yuki-kimoto authored on 2009-11-19
329
    
packaging one directory
yuki-kimoto authored on 2009-11-16
330

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

            
333
    $error_message : $result->sth->errstr
334
    $error_number  : $result->sth->err
335
    $error_state   : $result->sth->state
336

            
337
=head2 finish
338

            
update document
yuki-kimoto authored on 2009-11-19
339
Finish statement handle
340

            
packaging one directory
yuki-kimoto authored on 2009-11-16
341
    $result->finish
342

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

            
345
    $result->sth->finish;
346

            
347
=cut