Newer Older
388 lines | 8.001kb
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';
packaging one directory
yuki-kimoto authored on 2009-11-16
7
use Carp 'croak';
8

            
catch up with Object::Simple...
yuki-kimoto authored on 2010-01-18
9
__PACKAGE__->attr([qw/_dbi sth fetch_filter/]);
cleanup
yuki-kimoto authored on 2010-01-21
10
__PACKAGE__->attr(_no_fetch_filters => sub { {} });
update document
yuki-kimoto authored on 2009-11-19
11

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
230
=head2 sth
231

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

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

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

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

            
244
=head2 no_fetch_filters
245

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

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

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

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

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

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

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

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

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

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

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

            
275
=head2 fetch_hash
276

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

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

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

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

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

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

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

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

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

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

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

            
316
=head2 fetch_rows
317

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

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

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

            
329
=head2 fetch_hash_rows
330

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

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

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

            
342
=head2 fetch_all
343

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

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

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

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

            
353
=head2 fetch_hash_all
354

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

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

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

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

            
364
=head2 error
365

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

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

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

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

            
378
=head2 finish
379

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

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

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

            
386
    $result->sth->finish;
387

            
388
=cut