Newer Older
345 lines | 7.027kb
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

            
update document
yuki-kimoto authored on 2010-05-27
38
    return wantarray ? @row : \@row;
packaging one directory
yuki-kimoto authored on 2009-11-16
39
}
40

            
41
sub fetch_hash {
many many changes
yuki-kimoto authored on 2010-04-30
42

            
update document
yuki-kimoto authored on 2010-05-27
43
    $_[0]->{filters} ||= {};
44
    $_[0]->{filter}  ||= {};
packaging one directory
yuki-kimoto authored on 2009-11-16
45
    
46
    # Fetch
update document
yuki-kimoto authored on 2010-05-27
47
    my $row = $_[0]->{sth}->fetchrow_arrayref;
packaging one directory
yuki-kimoto authored on 2009-11-16
48
    
49
    # Cannot fetch
50
    return unless $row;
51
    
52
    # Filter
53
    my $row_hash = {};
update document
yuki-kimoto authored on 2010-05-27
54
    for (my $i = 0; $i < @{$_[0]->{sth}->{NAME_lc}}; $i++) {
55
        
56
        my $fname  = $_[0]->{filter}->{$_[0]->{sth}->{NAME_lc}->[$i]}
57
                  || $_[0]->{default_filter};
add query filter error check
yuki-kimoto authored on 2010-05-14
58
        
update document
yuki-kimoto authored on 2010-05-27
59
        croak "Filter \"$fname\" is not registered."
60
          if $fname && ! exists $_[0]->{filters}->{$fname};
some changed
yuki-kimoto authored on 2010-05-02
61
        
update document
yuki-kimoto authored on 2010-05-27
62
        $row_hash->{$_[0]->{sth}->{NAME_lc}->[$i]}
63
          = !$fname    ? $row->[$i] :
64
            ref $fname ? $fname->($row->[$i]) :
65
            $_[0]->{filters}->{$fname}->($row->[$i]);
packaging one directory
yuki-kimoto authored on 2009-11-16
66
    }
67
    
68
    return wantarray ? %$row_hash : $row_hash;
69
}
70

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

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

            
renamed fetch_rows to fetch_...
yuki-kimoto authored on 2010-05-01
101
sub fetch_multi {
packaging one directory
yuki-kimoto authored on 2009-11-16
102
    my ($self, $count) = @_;
103
    
104
    # Not specified Row count
105
    croak("Row count must be specified")
106
      unless $count;
107
    
108
    # Fetch multi rows
109
    my $rows = [];
110
    for (my $i = 0; $i < $count; $i++) {
111
        my @row = $self->fetch;
112
        
113
        last unless @row;
114
        
115
        push @$rows, \@row;
116
    }
117
    
118
    return unless @$rows;
119
    return wantarray ? @$rows : $rows;
120
}
121

            
renamed fetch_rows to fetch_...
yuki-kimoto authored on 2010-05-01
122
sub fetch_hash_multi {
packaging one directory
yuki-kimoto authored on 2009-11-16
123
    my ($self, $count) = @_;
124
    
125
    # Not specified Row count
126
    croak("Row count must be specified")
127
      unless $count;
128
    
129
    # Fetch multi rows
130
    my $rows = [];
131
    for (my $i = 0; $i < $count; $i++) {
132
        my %row = $self->fetch_hash;
133
        
134
        last unless %row;
135
        
136
        push @$rows, \%row;
137
    }
138
    
139
    return unless @$rows;
140
    return wantarray ? @$rows : $rows;
141
}
142

            
143
sub fetch_all {
144
    my $self = shift;
145
    
update document
yuki-kimoto authored on 2010-01-30
146
    # Fetch all rows
packaging one directory
yuki-kimoto authored on 2009-11-16
147
    my $rows = [];
148
    while(my @row = $self->fetch) {
149
        push @$rows, [@row];
150
    }
151
    return wantarray ? @$rows : $rows;
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 = [];
159
    while(my %row = $self->fetch_hash) {
160
        push @$rows, {%row};
161
    }
162
    return wantarray ? @$rows : $rows;
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

            
rename query() to execute()
yuki-kimoto authored on 2010-05-01
173
    my $result = $dbi->execute($query);
packaging one directory
yuki-kimoto authored on 2009-11-16
174
    
version 0.0901
yuki-kimoto authored on 2009-12-17
175
    # Fetch
176
    while (my @row = $result->fetch) {
177
        # Do something
178
    }
179
    
180
    # Fetch hash
181
    while (my %row = $result->fetch_hash) {
182
        # Do something
packaging one directory
yuki-kimoto authored on 2009-11-16
183
    }
184

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

            
187
=head2 sth
188

            
update document
yuki-kimoto authored on 2010-01-30
189
Statement handle
update document
yuki-kimoto authored on 2009-11-19
190

            
version 0.0901
yuki-kimoto authored on 2009-12-17
191
    $result = $result->sth($sth);
192
    $sth    = $reuslt->sth
update document
yuki-kimoto authored on 2009-11-19
193
    
many many changes
yuki-kimoto authored on 2010-04-30
194
=head2 default_filter
195

            
196
Filter excuted when data is fetched
197

            
many change
yuki-kimoto authored on 2010-04-30
198
    $result         = $result->default_filter($default_filter);
many many changes
yuki-kimoto authored on 2010-04-30
199
    $default_filter = $result->default_filter;
200

            
201
=head2 filter
packaging one directory
yuki-kimoto authored on 2009-11-16
202

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

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

            
update document
yuki-kimoto authored on 2010-01-30
208
=head1 METHODS
209

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

            
cleanup
yuki-kimoto authored on 2009-12-22
213
=head2 new
214

            
215
    my $result = DBIx::Custom::Result->new;
216

            
packaging one directory
yuki-kimoto authored on 2009-11-16
217
=head2 fetch
218

            
update document
yuki-kimoto authored on 2009-11-19
219
Fetch a row
220

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

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

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

            
232
=head2 fetch_hash
233

            
update document
yuki-kimoto authored on 2009-11-19
234
Fetch row as hash
235

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

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

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

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

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

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

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

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

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

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

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

            
update document
yuki-kimoto authored on 2009-11-19
275
Fetch rows
276

            
renamed fetch_rows to fetch_...
yuki-kimoto authored on 2010-05-01
277
    $rows = $result->fetch_multi($row_count); # array ref of array ref
278
    @rows = $result->fetch_multi($row_count); # array of array ref
packaging one directory
yuki-kimoto authored on 2009-11-16
279
    
renamed fetch_rows to fetch_...
yuki-kimoto authored on 2010-05-01
280
The following is fetch_multi sample
version 0.0901
yuki-kimoto authored on 2009-12-17
281

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

            
renamed fetch_rows to fetch_...
yuki-kimoto authored on 2010-05-01
286
=head2 fetch_hash_multi
packaging one directory
yuki-kimoto authored on 2009-11-16
287

            
update document
yuki-kimoto authored on 2009-11-19
288
Fetch rows as hash
289

            
renamed fetch_rows to fetch_...
yuki-kimoto authored on 2010-05-01
290
    $rows = $result->fetch_hash_multi($row_count); # array ref of hash ref
291
    @rows = $result->fetch_hash_multi($row_count); # array of hash ref
packaging one directory
yuki-kimoto authored on 2009-11-16
292
    
renamed fetch_rows to fetch_...
yuki-kimoto authored on 2010-05-01
293
The following is fetch_hash_multi sample
version 0.0901
yuki-kimoto authored on 2009-12-17
294

            
renamed fetch_rows to fetch_...
yuki-kimoto authored on 2010-05-01
295
    while(my $rows = $result->fetch_hash_multi(10)) {
update document
yuki-kimoto authored on 2009-11-19
296
        # do someting
297
    }
packaging one directory
yuki-kimoto authored on 2009-11-16
298

            
299
=head2 fetch_all
300

            
update document
yuki-kimoto authored on 2009-11-19
301
Fetch all rows
302

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

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

            
308
    my $rows = $result->fetch_all;
309

            
310
=head2 fetch_hash_all
311

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

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

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

            
319
    my $rows = $result->fetch_hash_all;
320

            
321
=head2 error
322

            
update document
yuki-kimoto authored on 2009-11-19
323
Get error infomation
324

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

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

            
331
    $error_message : $result->sth->errstr
332
    $error_number  : $result->sth->err
333
    $error_state   : $result->sth->state
334

            
335
=head2 finish
336

            
update document
yuki-kimoto authored on 2009-11-19
337
Finish statement handle
338

            
packaging one directory
yuki-kimoto authored on 2009-11-16
339
    $result->finish
340

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

            
343
    $result->sth->finish;
344

            
345
=cut