Newer Older
368 lines | 7.496kb
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++) {
some changed
yuki-kimoto authored on 2010-05-02
70
        my $fname  = $filter->{$columns->[$i]} || $self->{default_filter} || '';
71
        
72
        if ($fname) {
73
            my $filter;
74
            
75
            if (ref $fname) {
76
                $filter = $fname;
77
            }
78
            else {
79
                croak "Filter \"$fname\" is not registered."
80
                  unless exists $filters->{$fname};
81
                  
82
                $filter = $filters->{$fname};
83
            }
84
            $row_hash->{$columns->[$i]} = $filter->($row->[$i]);
85
        }
86
        else {
87
            $row_hash->{$columns->[$i]} = $row->[$i];
88
        }
packaging one directory
yuki-kimoto authored on 2009-11-16
89
    }
90
    
91
    return wantarray ? %$row_hash : $row_hash;
92
}
93

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

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

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

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

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

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

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

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

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

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

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

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

            
210
=head2 sth
211

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

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

            
219
Filter excuted when data is fetched
220

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

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

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

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

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

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

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

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

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

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

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

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

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

            
255
=head2 fetch_hash
256

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
322
=head2 fetch_all
323

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

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

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

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

            
333
=head2 fetch_hash_all
334

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

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

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

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

            
344
=head2 error
345

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

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

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

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

            
358
=head2 finish
359

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

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

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

            
366
    $result->sth->finish;
367

            
368
=cut