Newer Older
369 lines | 7.505kb
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
    
some changed
yuki-kimoto authored on 2010-05-02
15
    my $sth     = $self->{sth};
16
    my $filters = $self->{filters} || {};
17
    my $filter  = $self->{filter} || {};
packaging one directory
yuki-kimoto authored on 2009-11-16
18
    
19
    # Fetch
20
    my $row = $sth->fetchrow_arrayref;
21
    
22
    # Cannot fetch
23
    return unless $row;
many many changes
yuki-kimoto authored on 2010-04-30
24

            
25
    # Key
26
    my $columns  = $sth->{NAME_lc};
packaging one directory
yuki-kimoto authored on 2009-11-16
27
    
28
    # Filter
many many changes
yuki-kimoto authored on 2010-04-30
29
    for (my $i = 0; $i < @$columns; $i++) {
some changed
yuki-kimoto authored on 2010-05-02
30
        my $fname  = $filter->{$columns->[$i]} || $self->{default_filter} || '';
31
        
32
        if ($fname) {
33
            my $filter;
34
            
35
            if (ref $fname) {
36
                $filter = $fname;
37
            }
38
            else {
39
                croak "Filter \"$fname\" is not registered."
40
                  unless exists $filters->{$fname};
41
                  
42
                $filter = $filters->{$fname};
43
            }
44
            $row->[$i] = $filter->($row->[$i]);
45
        }
packaging one directory
yuki-kimoto authored on 2009-11-16
46
    }
many many changes
yuki-kimoto authored on 2010-04-30
47

            
packaging one directory
yuki-kimoto authored on 2009-11-16
48
    return wantarray ? @$row : $row;
49
}
50

            
51
sub fetch_hash {
52
    my $self = shift;
many many changes
yuki-kimoto authored on 2010-04-30
53

            
some changed
yuki-kimoto authored on 2010-05-02
54
    my $sth            = $self->{sth};
55
    my $filters        = $self->{filters} || {};
56
    my $filter         = $self->{filter} || {};
packaging one directory
yuki-kimoto authored on 2009-11-16
57
    
58
    # Fetch
59
    my $row = $sth->fetchrow_arrayref;
60
    
61
    # Cannot fetch
62
    return unless $row;
63
    
64
    # Keys
many many changes
yuki-kimoto authored on 2010-04-30
65
    my $columns  = $sth->{NAME_lc};
packaging one directory
yuki-kimoto authored on 2009-11-16
66
    
67
    # Filter
68
    my $row_hash = {};
many many changes
yuki-kimoto authored on 2010-04-30
69
    for (my $i = 0; $i < @$columns; $i++) {
add query filter error check
yuki-kimoto authored on 2010-05-14
70
        
some changed
yuki-kimoto authored on 2010-05-02
71
        my $fname  = $filter->{$columns->[$i]} || $self->{default_filter} || '';
72
        
73
        if ($fname) {
74
            my $filter;
75
            
76
            if (ref $fname) {
77
                $filter = $fname;
78
            }
79
            else {
80
                croak "Filter \"$fname\" is not registered."
81
                  unless exists $filters->{$fname};
82
                  
83
                $filter = $filters->{$fname};
84
            }
85
            $row_hash->{$columns->[$i]} = $filter->($row->[$i]);
86
        }
87
        else {
88
            $row_hash->{$columns->[$i]} = $row->[$i];
89
        }
packaging one directory
yuki-kimoto authored on 2009-11-16
90
    }
91
    
92
    return wantarray ? %$row_hash : $row_hash;
93
}
94

            
rename fetch_first to fetch_...
yuki-kimoto authored on 2010-01-29
95
sub fetch_single {
packaging one directory
yuki-kimoto authored on 2009-11-16
96
    my $self = shift;
97
    
98
    # Fetch
99
    my $row = $self->fetch;
100
    
101
    # Not exist
102
    return unless $row;
103
    
104
    # Finish statement handle
some changed
yuki-kimoto authored on 2010-05-02
105
    $self->sth->finish;
packaging one directory
yuki-kimoto authored on 2009-11-16
106
    
107
    return wantarray ? @$row : $row;
108
}
109

            
rename fetch_first to fetch_...
yuki-kimoto authored on 2010-01-29
110
sub fetch_hash_single {
packaging one directory
yuki-kimoto authored on 2009-11-16
111
    my $self = shift;
112
    
113
    # Fetch hash
114
    my $row = $self->fetch_hash;
115
    
116
    # Not exist
117
    return unless $row;
118
    
119
    # Finish statement handle
some changed
yuki-kimoto authored on 2010-05-02
120
    $self->sth->finish;
packaging one directory
yuki-kimoto authored on 2009-11-16
121
    
122
    return wantarray ? %$row : $row;
123
}
124

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

            
renamed fetch_rows to fetch_...
yuki-kimoto authored on 2010-05-01
146
sub fetch_hash_multi {
packaging one directory
yuki-kimoto authored on 2009-11-16
147
    my ($self, $count) = @_;
148
    
149
    # Not specified Row count
150
    croak("Row count must be specified")
151
      unless $count;
152
    
153
    # Fetch multi rows
154
    my $rows = [];
155
    for (my $i = 0; $i < $count; $i++) {
156
        my %row = $self->fetch_hash;
157
        
158
        last unless %row;
159
        
160
        push @$rows, \%row;
161
    }
162
    
163
    return unless @$rows;
164
    return wantarray ? @$rows : $rows;
165
}
166

            
167
sub fetch_all {
168
    my $self = shift;
169
    
update document
yuki-kimoto authored on 2010-01-30
170
    # Fetch all rows
packaging one directory
yuki-kimoto authored on 2009-11-16
171
    my $rows = [];
172
    while(my @row = $self->fetch) {
173
        push @$rows, [@row];
174
    }
175
    return wantarray ? @$rows : $rows;
176
}
177

            
178
sub fetch_hash_all {
179
    my $self = shift;
180
    
update document
yuki-kimoto authored on 2010-01-30
181
    # Fetch all rows as hash
packaging one directory
yuki-kimoto authored on 2009-11-16
182
    my $rows = [];
183
    while(my %row = $self->fetch_hash) {
184
        push @$rows, {%row};
185
    }
186
    return wantarray ? @$rows : $rows;
187
}
188

            
update document
yuki-kimoto authored on 2010-01-30
189
1;
190

            
packaging one directory
yuki-kimoto authored on 2009-11-16
191
=head1 NAME
192

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

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

            
rename query() to execute()
yuki-kimoto authored on 2010-05-01
197
    my $result = $dbi->execute($query);
packaging one directory
yuki-kimoto authored on 2009-11-16
198
    
version 0.0901
yuki-kimoto authored on 2009-12-17
199
    # Fetch
200
    while (my @row = $result->fetch) {
201
        # Do something
202
    }
203
    
204
    # Fetch hash
205
    while (my %row = $result->fetch_hash) {
206
        # Do something
packaging one directory
yuki-kimoto authored on 2009-11-16
207
    }
208

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

            
211
=head2 sth
212

            
update document
yuki-kimoto authored on 2010-01-30
213
Statement handle
update document
yuki-kimoto authored on 2009-11-19
214

            
version 0.0901
yuki-kimoto authored on 2009-12-17
215
    $result = $result->sth($sth);
216
    $sth    = $reuslt->sth
update document
yuki-kimoto authored on 2009-11-19
217
    
many many changes
yuki-kimoto authored on 2010-04-30
218
=head2 default_filter
219

            
220
Filter excuted when data is fetched
221

            
many change
yuki-kimoto authored on 2010-04-30
222
    $result         = $result->default_filter($default_filter);
many many changes
yuki-kimoto authored on 2010-04-30
223
    $default_filter = $result->default_filter;
224

            
225
=head2 filter
packaging one directory
yuki-kimoto authored on 2009-11-16
226

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

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

            
update document
yuki-kimoto authored on 2010-01-30
232
=head1 METHODS
233

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

            
cleanup
yuki-kimoto authored on 2009-12-22
237
=head2 new
238

            
239
    my $result = DBIx::Custom::Result->new;
240

            
packaging one directory
yuki-kimoto authored on 2009-11-16
241
=head2 fetch
242

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
245
    $row = $result->fetch; # array reference
246
    @row = $result->fecth; # array
247

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

            
250
    while (my $row = $result->fetch) {
251
        # do something
252
        my $val1 = $row->[0];
253
        my $val2 = $row->[1];
254
    }
255

            
256
=head2 fetch_hash
257

            
update document
yuki-kimoto authored on 2009-11-19
258
Fetch row as hash
259

            
version 0.0901
yuki-kimoto authored on 2009-12-17
260
    $row = $result->fetch_hash; # hash reference
261
    %row = $result->fetch_hash; # hash
262

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

            
265
    while (my $row = $result->fetch_hash) {
266
        # do something
267
        my $val1 = $row->{key1};
268
        my $val2 = $row->{key2};
269
    }
270

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

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

            
rename fetch_first to fetch_...
yuki-kimoto authored on 2010-01-29
275
    $row = $result->fetch_single; # array reference
276
    @row = $result->fetch_single; # array
packaging one directory
yuki-kimoto authored on 2009-11-16
277
    
rename fetch_first to fetch_...
yuki-kimoto authored on 2010-01-29
278
The following is fetch_single sample
version 0.0901
yuki-kimoto authored on 2009-12-17
279

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

            
rename fetch_first to fetch_...
yuki-kimoto authored on 2010-01-29
284
=head2 fetch_hash_single
packaging one directory
yuki-kimoto authored on 2009-11-16
285
    
update document
yuki-kimoto authored on 2009-11-19
286
Fetch only first row as hash
287

            
rename fetch_first to fetch_...
yuki-kimoto authored on 2010-01-29
288
    $row = $result->fetch_hash_single; # hash reference
289
    %row = $result->fetch_hash_single; # hash
packaging one directory
yuki-kimoto authored on 2009-11-16
290
    
rename fetch_first to fetch_...
yuki-kimoto authored on 2010-01-29
291
The following is fetch_hash_single sample
version 0.0901
yuki-kimoto authored on 2009-12-17
292

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

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

            
update document
yuki-kimoto authored on 2009-11-19
299
Fetch rows
300

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

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

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

            
update document
yuki-kimoto authored on 2009-11-19
312
Fetch rows as hash
313

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

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

            
323
=head2 fetch_all
324

            
update document
yuki-kimoto authored on 2009-11-19
325
Fetch all rows
326

            
version 0.0901
yuki-kimoto authored on 2009-12-17
327
    $rows = $result->fetch_all; # array ref of array ref
328
    @rows = $result->fecth_all; # array of array ref
329

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

            
332
    my $rows = $result->fetch_all;
333

            
334
=head2 fetch_hash_all
335

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

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

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

            
343
    my $rows = $result->fetch_hash_all;
344

            
345
=head2 error
346

            
update document
yuki-kimoto authored on 2009-11-19
347
Get error infomation
348

            
version 0.0901
yuki-kimoto authored on 2009-12-17
349
    $error_messege = $result->error;
350
    ($error_message, $error_number, $error_state) = $result->error;
update document
yuki-kimoto authored on 2009-11-19
351
    
packaging one directory
yuki-kimoto authored on 2009-11-16
352

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

            
355
    $error_message : $result->sth->errstr
356
    $error_number  : $result->sth->err
357
    $error_state   : $result->sth->state
358

            
359
=head2 finish
360

            
update document
yuki-kimoto authored on 2009-11-19
361
Finish statement handle
362

            
packaging one directory
yuki-kimoto authored on 2009-11-16
363
    $result->finish
364

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

            
367
    $result->sth->finish;
368

            
369
=cut