Newer Older
389 lines | 8.002kb
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
__PACKAGE__->attr(_no_fetch_filters => sub { {} });
update document
yuki-kimoto authored on 2009-11-19
12

            
cleanup
yuki-kimoto authored on 2009-12-22
13
sub new {
14
    my $self = shift->SUPER::new(@_);
15
    
update document
yuki-kimoto authored on 2010-01-30
16
    # Initialize attributes
cleanup
yuki-kimoto authored on 2010-01-21
17
    $self->no_fetch_filters($self->{no_fetch_filters})
18
      if exists $self->{no_fetch_filters};
cleanup
yuki-kimoto authored on 2009-12-22
19
    
20
    return $self;
21
}
packaging one directory
yuki-kimoto authored on 2009-11-16
22

            
cleanup
yuki-kimoto authored on 2010-01-21
23
sub no_fetch_filters {
24
    my $self = shift;
25
    
26
    if (@_) {
27
        
update document
yuki-kimoto authored on 2010-01-30
28
        # Set
cleanup
yuki-kimoto authored on 2010-01-21
29
        $self->{no_fetch_filters} = $_[0];
30
        
update document
yuki-kimoto authored on 2010-01-30
31
        # Cached
cleanup
yuki-kimoto authored on 2010-01-21
32
        my %no_fetch_filters = map {$_ => 1} @{$self->{no_fetch_filters}};
33
        $self->_no_fetch_filters(\%no_fetch_filters);
34
        
35
        return $self;
36
    }
37
    
38
    return $self->{no_fetch_filters};
39
}
40

            
packaging one directory
yuki-kimoto authored on 2009-11-16
41
sub fetch {
42
    my ($self, $type) = @_;
43
    my $sth = $self->sth;
44
    my $fetch_filter = $self->fetch_filter;
45
    
46
    # Fetch
47
    my $row = $sth->fetchrow_arrayref;
48
    
49
    # Cannot fetch
50
    return unless $row;
51
    
52
    # Filter
53
    if ($fetch_filter) {
54
        my $keys  = $sth->{NAME_lc};
55
        my $types = $sth->{TYPE};
56
        for (my $i = 0; $i < @$keys; $i++) {
cleanup
yuki-kimoto authored on 2010-01-21
57
            next if $self->_no_fetch_filters->{$keys->[$i]};
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
58
            $row->[$i]= $fetch_filter->($row->[$i], $keys->[$i], $self->_dbi,
59
                                        {type => $types->[$i], sth => $sth, index => $i});
packaging one directory
yuki-kimoto authored on 2009-11-16
60
        }
61
    }
62
    return wantarray ? @$row : $row;
63
}
64

            
65
sub fetch_hash {
66
    my $self = shift;
67
    my $sth = $self->sth;
68
    my $fetch_filter = $self->fetch_filter;
69
    
70
    # Fetch
71
    my $row = $sth->fetchrow_arrayref;
72
    
73
    # Cannot fetch
74
    return unless $row;
75
    
76
    # Keys
77
    my $keys  = $sth->{NAME_lc};
78
    
79
    # Filter
80
    my $row_hash = {};
81
    if ($fetch_filter) {
82
        my $types = $sth->{TYPE};
83
        for (my $i = 0; $i < @$keys; $i++) {
cleanup
yuki-kimoto authored on 2010-01-21
84
            if ($self->_no_fetch_filters->{$keys->[$i]}) {
packaging one directory
yuki-kimoto authored on 2009-11-16
85
                $row_hash->{$keys->[$i]} = $row->[$i];
86
            }
87
            else {
88
                $row_hash->{$keys->[$i]}
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
89
                  = $fetch_filter->($row->[$i], $keys->[$i], $self->_dbi,
90
                                    {type => $types->[$i], sth => $sth, index => $i});
packaging one directory
yuki-kimoto authored on 2009-11-16
91
            }
92
        }
93
    }
94
    
95
    # No filter
96
    else {
97
        for (my $i = 0; $i < @$keys; $i++) {
98
            $row_hash->{$keys->[$i]} = $row->[$i];
99
        }
100
    }
101
    return wantarray ? %$row_hash : $row_hash;
102
}
103

            
rename fetch_first to fetch_...
yuki-kimoto authored on 2010-01-29
104
sub fetch_single {
packaging one directory
yuki-kimoto authored on 2009-11-16
105
    my $self = shift;
106
    
107
    # Fetch
108
    my $row = $self->fetch;
109
    
110
    # Not exist
111
    return unless $row;
112
    
113
    # Finish statement handle
114
    $self->finish;
115
    
116
    return wantarray ? @$row : $row;
117
}
118

            
rename fetch_first to fetch_...
yuki-kimoto authored on 2010-01-29
119
sub fetch_hash_single {
packaging one directory
yuki-kimoto authored on 2009-11-16
120
    my $self = shift;
121
    
122
    # Fetch hash
123
    my $row = $self->fetch_hash;
124
    
125
    # Not exist
126
    return unless $row;
127
    
128
    # Finish statement handle
129
    $self->finish;
130
    
131
    return wantarray ? %$row : $row;
132
}
133

            
134
sub fetch_rows {
135
    my ($self, $count) = @_;
136
    
137
    # Not specified Row count
138
    croak("Row count must be specified")
139
      unless $count;
140
    
141
    # Fetch multi rows
142
    my $rows = [];
143
    for (my $i = 0; $i < $count; $i++) {
144
        my @row = $self->fetch;
145
        
146
        last unless @row;
147
        
148
        push @$rows, \@row;
149
    }
150
    
151
    return unless @$rows;
152
    return wantarray ? @$rows : $rows;
153
}
154

            
155
sub fetch_hash_rows {
156
    my ($self, $count) = @_;
157
    
158
    # Not specified Row count
159
    croak("Row count must be specified")
160
      unless $count;
161
    
162
    # Fetch multi rows
163
    my $rows = [];
164
    for (my $i = 0; $i < $count; $i++) {
165
        my %row = $self->fetch_hash;
166
        
167
        last unless %row;
168
        
169
        push @$rows, \%row;
170
    }
171
    
172
    return unless @$rows;
173
    return wantarray ? @$rows : $rows;
174
}
175

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

            
187
sub fetch_hash_all {
188
    my $self = shift;
189
    
update document
yuki-kimoto authored on 2010-01-30
190
    # Fetch all rows as hash
packaging one directory
yuki-kimoto authored on 2009-11-16
191
    my $rows = [];
192
    while(my %row = $self->fetch_hash) {
193
        push @$rows, {%row};
194
    }
195
    return wantarray ? @$rows : $rows;
196
}
197

            
198
sub finish { shift->sth->finish }
199

            
200
sub error { 
201
    my $self = shift;
update document
yuki-kimoto authored on 2010-01-30
202
    
203
    # Statement handle
packaging one directory
yuki-kimoto authored on 2009-11-16
204
    my $sth  = $self->sth;
update document
yuki-kimoto authored on 2010-01-30
205
    
packaging one directory
yuki-kimoto authored on 2009-11-16
206
    return wantarray ? ($sth->errstr, $sth->err, $sth->state) : $sth->errstr;
207
}
208

            
update document
yuki-kimoto authored on 2010-01-30
209
1;
210

            
packaging one directory
yuki-kimoto authored on 2009-11-16
211
=head1 NAME
212

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

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
217
    my $result = $dbi->query($query);
packaging one directory
yuki-kimoto authored on 2009-11-16
218
    
version 0.0901
yuki-kimoto authored on 2009-12-17
219
    # Fetch
220
    while (my @row = $result->fetch) {
221
        # Do something
222
    }
223
    
224
    # Fetch hash
225
    while (my %row = $result->fetch_hash) {
226
        # Do something
packaging one directory
yuki-kimoto authored on 2009-11-16
227
    }
228

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

            
231
=head2 sth
232

            
update document
yuki-kimoto authored on 2010-01-30
233
Statement handle
update document
yuki-kimoto authored on 2009-11-19
234

            
version 0.0901
yuki-kimoto authored on 2009-12-17
235
    $result = $result->sth($sth);
236
    $sth    = $reuslt->sth
update document
yuki-kimoto authored on 2009-11-19
237
    
packaging one directory
yuki-kimoto authored on 2009-11-16
238
=head2 fetch_filter
239

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

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

            
245
=head2 no_fetch_filters
246

            
update document
yuki-kimoto authored on 2010-01-30
247
Key list which dose not have to fetch filtering
update document
yuki-kimoto authored on 2009-11-19
248

            
version 0.0901
yuki-kimoto authored on 2009-12-17
249
    $result           = $result->no_fetch_filters($no_fetch_filters);
packaging one directory
yuki-kimoto authored on 2009-11-16
250
    $no_fetch_filters = $result->no_fetch_filters;
251

            
update document
yuki-kimoto authored on 2010-01-30
252
=head1 METHODS
253

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

            
cleanup
yuki-kimoto authored on 2009-12-22
257
=head2 new
258

            
259
    my $result = DBIx::Custom::Result->new;
260

            
packaging one directory
yuki-kimoto authored on 2009-11-16
261
=head2 fetch
262

            
update document
yuki-kimoto authored on 2009-11-19
263
Fetch a row
264

            
version 0.0901
yuki-kimoto authored on 2009-12-17
265
    $row = $result->fetch; # array reference
266
    @row = $result->fecth; # array
267

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

            
270
    while (my $row = $result->fetch) {
271
        # do something
272
        my $val1 = $row->[0];
273
        my $val2 = $row->[1];
274
    }
275

            
276
=head2 fetch_hash
277

            
update document
yuki-kimoto authored on 2009-11-19
278
Fetch row as hash
279

            
version 0.0901
yuki-kimoto authored on 2009-12-17
280
    $row = $result->fetch_hash; # hash reference
281
    %row = $result->fetch_hash; # hash
282

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

            
285
    while (my $row = $result->fetch_hash) {
286
        # do something
287
        my $val1 = $row->{key1};
288
        my $val2 = $row->{key2};
289
    }
290

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

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

            
rename fetch_first to fetch_...
yuki-kimoto authored on 2010-01-29
295
    $row = $result->fetch_single; # array reference
296
    @row = $result->fetch_single; # array
packaging one directory
yuki-kimoto authored on 2009-11-16
297
    
rename fetch_first to fetch_...
yuki-kimoto authored on 2010-01-29
298
The following is fetch_single sample
version 0.0901
yuki-kimoto authored on 2009-12-17
299

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

            
rename fetch_first to fetch_...
yuki-kimoto authored on 2010-01-29
304
=head2 fetch_hash_single
packaging one directory
yuki-kimoto authored on 2009-11-16
305
    
update document
yuki-kimoto authored on 2009-11-19
306
Fetch only first row as hash
307

            
rename fetch_first to fetch_...
yuki-kimoto authored on 2010-01-29
308
    $row = $result->fetch_hash_single; # hash reference
309
    %row = $result->fetch_hash_single; # hash
packaging one directory
yuki-kimoto authored on 2009-11-16
310
    
rename fetch_first to fetch_...
yuki-kimoto authored on 2010-01-29
311
The following is fetch_hash_single sample
version 0.0901
yuki-kimoto authored on 2009-12-17
312

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

            
317
=head2 fetch_rows
318

            
update document
yuki-kimoto authored on 2009-11-19
319
Fetch rows
320

            
version 0.0901
yuki-kimoto authored on 2009-12-17
321
    $rows = $result->fetch_rows($row_count); # array ref of array ref
322
    @rows = $result->fetch_rows($row_count); # array of array ref
packaging one directory
yuki-kimoto authored on 2009-11-16
323
    
version 0.0901
yuki-kimoto authored on 2009-12-17
324
The following is fetch_rows sample
325

            
update document
yuki-kimoto authored on 2009-11-19
326
    while(my $rows = $result->fetch_rows(10)) {
327
        # do someting
328
    }
packaging one directory
yuki-kimoto authored on 2009-11-16
329

            
330
=head2 fetch_hash_rows
331

            
update document
yuki-kimoto authored on 2009-11-19
332
Fetch rows as hash
333

            
version 0.0901
yuki-kimoto authored on 2009-12-17
334
    $rows = $result->fetch_hash_rows($row_count); # array ref of hash ref
335
    @rows = $result->fetch_hash_rows($row_count); # array of hash ref
packaging one directory
yuki-kimoto authored on 2009-11-16
336
    
version 0.0901
yuki-kimoto authored on 2009-12-17
337
The following is fetch_hash_rows sample
338

            
update document
yuki-kimoto authored on 2009-11-19
339
    while(my $rows = $result->fetch_hash_rows(10)) {
340
        # do someting
341
    }
packaging one directory
yuki-kimoto authored on 2009-11-16
342

            
343
=head2 fetch_all
344

            
update document
yuki-kimoto authored on 2009-11-19
345
Fetch all rows
346

            
version 0.0901
yuki-kimoto authored on 2009-12-17
347
    $rows = $result->fetch_all; # array ref of array ref
348
    @rows = $result->fecth_all; # array of array ref
349

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

            
352
    my $rows = $result->fetch_all;
353

            
354
=head2 fetch_hash_all
355

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

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

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

            
363
    my $rows = $result->fetch_hash_all;
364

            
365
=head2 error
366

            
update document
yuki-kimoto authored on 2009-11-19
367
Get error infomation
368

            
version 0.0901
yuki-kimoto authored on 2009-12-17
369
    $error_messege = $result->error;
370
    ($error_message, $error_number, $error_state) = $result->error;
update document
yuki-kimoto authored on 2009-11-19
371
    
packaging one directory
yuki-kimoto authored on 2009-11-16
372

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

            
375
    $error_message : $result->sth->errstr
376
    $error_number  : $result->sth->err
377
    $error_state   : $result->sth->state
378

            
379
=head2 finish
380

            
update document
yuki-kimoto authored on 2009-11-19
381
Finish statement handle
382

            
packaging one directory
yuki-kimoto authored on 2009-11-16
383
    $result->finish
384

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

            
387
    $result->sth->finish;
388

            
389
=cut