Newer Older
386 lines | 8.709kb
packing
yuki-kimoto authored on 2009-11-12
1
package DBIx::Custom::Result;
2
use Object::Simple;
rename fetch_all_hash to fet...
yuki-kimoto authored on 2009-11-15
3
use strict;
4
use warnings;
packing
yuki-kimoto authored on 2009-11-12
5
use Carp 'croak';
6

            
rename fetch_all_hash to fet...
yuki-kimoto authored on 2009-11-15
7
our $VERSION = '0.0301';
8

            
packing
yuki-kimoto authored on 2009-11-12
9
# Attributes
10
sub sth              : Attr {}
11
sub fetch_filter     : Attr {}
12
sub no_fetch_filters      : Attr { type => 'array', trigger => sub {
13
    my $self = shift;
14
    my $no_fetch_filters = $self->no_fetch_filters || [];
15
    my %no_fetch_filters_map = map {$_ => 1} @{$no_fetch_filters};
16
    $self->_no_fetch_filters_map(\%no_fetch_filters_map);
17
}}
18
sub _no_fetch_filters_map : Attr {default => sub { {} }}
19

            
20
# Fetch (array)
21
sub fetch {
22
    my ($self, $type) = @_;
23
    my $sth = $self->sth;
24
    my $fetch_filter = $self->fetch_filter;
25
    
26
    # Fetch
27
    my $row = $sth->fetchrow_arrayref;
28
    
29
    # Cannot fetch
30
    return unless $row;
31
    
32
    # Filter
33
    if ($fetch_filter) {
34
        my $keys  = $sth->{NAME_lc};
35
        my $types = $sth->{TYPE};
36
        for (my $i = 0; $i < @$keys; $i++) {
37
            next if $self->_no_fetch_filters_map->{$keys->[$i]};
filter argument exchange key...
yuki-kimoto authored on 2009-11-12
38
            $row->[$i]= $fetch_filter->($row->[$i], $keys->[$i], $types->[$i],
packing
yuki-kimoto authored on 2009-11-12
39
                                        $sth, $i);
40
        }
41
    }
42
    return wantarray ? @$row : $row;
43
}
44

            
45
# Fetch (hash)
46
sub fetch_hash {
47
    my $self = shift;
48
    my $sth = $self->sth;
49
    my $fetch_filter = $self->fetch_filter;
50
    
51
    # Fetch
52
    my $row = $sth->fetchrow_arrayref;
53
    
54
    # Cannot fetch
55
    return unless $row;
56
    
57
    # Keys
58
    my $keys  = $sth->{NAME_lc};
59
    
60
    # Filter
61
    my $row_hash = {};
62
    if ($fetch_filter) {
63
        my $types = $sth->{TYPE};
64
        for (my $i = 0; $i < @$keys; $i++) {
65
            if ($self->_no_fetch_filters_map->{$keys->[$i]}) {
66
                $row_hash->{$keys->[$i]} = $row->[$i];
67
            }
68
            else {
69
                $row_hash->{$keys->[$i]}
filter argument exchange key...
yuki-kimoto authored on 2009-11-12
70
                  = $fetch_filter->($row->[$i], $keys->[$i],
packing
yuki-kimoto authored on 2009-11-12
71
                                    $types->[$i], $sth, $i);
72
            }
73
        }
74
    }
75
    
76
    # No filter
77
    else {
78
        for (my $i = 0; $i < @$keys; $i++) {
79
            $row_hash->{$keys->[$i]} = $row->[$i];
80
        }
81
    }
82
    return wantarray ? %$row_hash : $row_hash;
83
}
84

            
85
# Fetch only first (array)
86
sub fetch_first {
87
    my $self = shift;
88
    
89
    # Fetch
90
    my $row = $self->fetch;
91
    
92
    # Not exist
93
    return unless $row;
94
    
95
    # Finish statement handle
96
    $self->finish;
97
    
98
    return wantarray ? @$row : $row;
99
}
100

            
101
# Fetch only first (hash)
rename fetch_all_hash to fet...
yuki-kimoto authored on 2009-11-15
102
sub fetch_hash_first {
packing
yuki-kimoto authored on 2009-11-12
103
    my $self = shift;
104
    
105
    # Fetch hash
106
    my $row = $self->fetch_hash;
107
    
108
    # Not exist
109
    return unless $row;
110
    
111
    # Finish statement handle
112
    $self->finish;
113
    
114
    return wantarray ? %$row : $row;
115
}
116

            
117
# Fetch multi rows (array)
118
sub fetch_rows {
119
    my ($self, $count) = @_;
120
    
121
    # Not specified Row count
122
    croak("Row count must be specified")
123
      unless $count;
124
    
125
    # Fetch multi rows
126
    my $rows = [];
127
    for (my $i = 0; $i < $count; $i++) {
128
        my @row = $self->fetch;
129
        
130
        last unless @row;
131
        
132
        push @$rows, \@row;
133
    }
134
    
135
    return unless @$rows;
136
    return wantarray ? @$rows : $rows;
137
}
138

            
139
# Fetch multi rows (hash)
rename fetch_all_hash to fet...
yuki-kimoto authored on 2009-11-15
140
sub fetch_hash_rows {
packing
yuki-kimoto authored on 2009-11-12
141
    my ($self, $count) = @_;
142
    
143
    # Not specified Row count
144
    croak("Row count must be specified")
145
      unless $count;
146
    
147
    # Fetch multi rows
148
    my $rows = [];
149
    for (my $i = 0; $i < $count; $i++) {
150
        my %row = $self->fetch_hash;
151
        
152
        last unless %row;
153
        
154
        push @$rows, \%row;
155
    }
156
    
157
    return unless @$rows;
158
    return wantarray ? @$rows : $rows;
159
}
160

            
161

            
162
# Fetch all (array)
163
sub fetch_all {
164
    my $self = shift;
165
    
166
    my $rows = [];
167
    while(my @row = $self->fetch) {
168
        push @$rows, [@row];
169
    }
170
    return wantarray ? @$rows : $rows;
171
}
172

            
173
# Fetch all (hash)
rename fetch_all_hash to fet...
yuki-kimoto authored on 2009-11-15
174
sub fetch_hash_all {
packing
yuki-kimoto authored on 2009-11-12
175
    my $self = shift;
176
    
177
    my $rows = [];
178
    while(my %row = $self->fetch_hash) {
179
        push @$rows, {%row};
180
    }
181
    return wantarray ? @$rows : $rows;
182
}
183

            
184
# Finish
185
sub finish { shift->sth->finish }
186

            
187
# Error
188
sub error { 
189
    my $self = shift;
190
    my $sth  = $self->sth;
191
    return wantarray ? ($sth->errstr, $sth->err, $sth->state) : $sth->errstr;
192
}
193

            
194
Object::Simple->build_class;
195

            
196
=head1 NAME
197

            
198
DBIx::Custom::Result - Resultset for DBIx::Custom
199

            
200
=head1 VERSION
201

            
rename fetch_all_hash to fet...
yuki-kimoto authored on 2009-11-15
202
Version 0.0301
packing
yuki-kimoto authored on 2009-11-12
203

            
204
=head1 SYNOPSIS
205

            
206
    # $result is DBIx::Custom::Result object
207
    my $dbi = DBIx::Custom->new;
208
    my $result = $dbi->query($sql_template, $param);
209
    
210
    while (my ($val1, $val2) = $result->fetch) {
211
        # do something
212
    }
213

            
214
=head1 OBJECT ACCESSORS
215

            
216
=head2 sth
217

            
218
    # Set and Get statement handle
219
    $self = $result->sth($sth);
220
    $sth  = $reuslt->sth
221

            
222
Statement handle is automatically set by DBIx::Custom.
223
so you do not set statement handle.
224

            
225
If you need statement handle, you can get statement handle by using this method.
226

            
227
=head2 fetch_filter
228

            
229
    # Set and Get fetch filter
230
    $self         = $result->fetch_filter($sth);
231
    $fetch_filter = $result->fech_filter;
232

            
233
Statement handle is automatically set by DBIx::Custom.
234
If you want to set your fetch filter, you set it.
235

            
236
=head2 no_fetch_filters
237

            
238
    # Set and Get no filter keys when fetching
239
    $self             = $result->no_fetch_filters($no_fetch_filters);
240
    $no_fetch_filters = $result->no_fetch_filters;
241

            
242
=head1 METHODS
243

            
244
=head2 fetch
245

            
246
    # Fetch row as array reference (Scalar context)
247
    $row = $result->fetch;
248
    
249
    # Fetch row as array (List context)
250
    @row = $result->fecth
251

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

            
259
fetch method is fetch resultset and get row as array or array reference.
260

            
261
=head2 fetch_hash
262

            
263
    # Fetch row as hash reference (Scalar context)
264
    $row = $result->fetch_hash;
265
    
266
    # Fetch row as hash (List context)
267
    %row = $result->fecth_hash
268

            
269
    # Sample
270
    while (my $row = $result->fetch_hash) {
271
        # do something
272
        my $val1 = $row->{key1};
273
        my $val2 = $row->{key2};
274
    }
275

            
276
fetch_hash method is fetch resultset and get row as hash or hash reference.
277

            
278
=head2 fetch_first
279

            
280
    # Fetch only first (Scalar context)
281
    $row = $result->fetch_first;
282
    
283
    # Fetch only first (List context)
284
    @row = $result->fetch_first;
285
    
286
This method fetch only first and finish statement handle
287

            
rename fetch_all_hash to fet...
yuki-kimoto authored on 2009-11-15
288
=head2 fetch_hash_first
packing
yuki-kimoto authored on 2009-11-12
289
    
290
    # Fetch only first as hash (Scalar context)
rename fetch_all_hash to fet...
yuki-kimoto authored on 2009-11-15
291
    $row = $result->fetch_hash_first;
packing
yuki-kimoto authored on 2009-11-12
292
    
293
    # Fetch only first as hash (Scalar context)
rename fetch_all_hash to fet...
yuki-kimoto authored on 2009-11-15
294
    @row = $result->fetch_hash_first;
packing
yuki-kimoto authored on 2009-11-12
295
    
296
This method fetch only first and finish statement handle
297

            
298
=head2 fetch_rows
299

            
300
    # Fetch multi rows (Scalar context)
301
    $rows = $result->fetch_rows($row_count);
302
    
303
    # Fetch multi rows (List context)
304
    @rows = $result->fetch_rows($row_count);
305
    
306
    # Sapmle 
307
    $rows = $result->fetch_rows(10);
308

            
rename fetch_all_hash to fet...
yuki-kimoto authored on 2009-11-15
309
=head2 fetch_hash_rows
packing
yuki-kimoto authored on 2009-11-12
310

            
311
    # Fetch multi rows as hash (Scalar context)
rename fetch_all_hash to fet...
yuki-kimoto authored on 2009-11-15
312
    $rows = $result->fetch_hash_rows($row_count);
packing
yuki-kimoto authored on 2009-11-12
313
    
314
    # Fetch multi rows as hash (List context)
rename fetch_all_hash to fet...
yuki-kimoto authored on 2009-11-15
315
    @rows = $result->fetch_hash_rows($row_count);
packing
yuki-kimoto authored on 2009-11-12
316
    
317
    # Sapmle 
rename fetch_all_hash to fet...
yuki-kimoto authored on 2009-11-15
318
    $rows = $result->fetch_hash_rows(10);
packing
yuki-kimoto authored on 2009-11-12
319

            
320
=head2 fetch_all
321

            
322
    # Fetch all row as array ref of array ref (Scalar context)
323
    $rows = $result->fetch_all;
324
    
325
    # Fetch all row as array of array ref (List context)
326
    @rows = $result->fecth_all;
327

            
328
    # Sample
329
    my $rows = $result->fetch_all;
330
    my $val0_0 = $rows->[0][0];
331
    my $val1_1 = $rows->[1][1];
332

            
333
fetch_all method is fetch resultset and get all rows as array or array reference.
334

            
rename fetch_all_hash to fet...
yuki-kimoto authored on 2009-11-15
335
=head2 fetch_hash_all
packing
yuki-kimoto authored on 2009-11-12
336

            
337
    # Fetch all row as array ref of hash ref (Scalar context)
rename fetch_all_hash to fet...
yuki-kimoto authored on 2009-11-15
338
    $rows = $result->fetch_hash_all;
packing
yuki-kimoto authored on 2009-11-12
339
    
340
    # Fetch all row as array of hash ref (List context)
341
    @rows = $result->fecth_all_hash;
342

            
343
    # Sample
rename fetch_all_hash to fet...
yuki-kimoto authored on 2009-11-15
344
    my $rows = $result->fetch_hash_all;
packing
yuki-kimoto authored on 2009-11-12
345
    my $val0_key1 = $rows->[0]{key1};
346
    my $val1_key2 = $rows->[1]{key2};
347

            
348
=head2 error
349

            
350
    # Get error infomation
351
    $error_messege = $result->error;
352
    ($error_message, $error_number, $error_state) = $result->error;
353

            
354
You can get get information. This is crenspond to the following.
355

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

            
360
=head2 finish
361

            
362
    # Finish statement handle
363
    $result->finish
364
    
365
    # Sample
366
    my $row = $reuslt->fetch; # fetch only one row
367
    $result->finish
368

            
369
You can finish statement handle.This is equel to
370

            
371
    $result->sth->finish;
372

            
373
=head1 AUTHOR
374

            
375
Yuki Kimoto, C<< <kimoto.yuki at gmail.com> >>
376

            
377
Github L<http://github.com/yuki-kimoto>
378

            
379
=head1 COPYRIGHT & LICENSE
380

            
381
Copyright 2009 Yuki Kimoto, all rights reserved.
382

            
383
This program is free software; you can redistribute it and/or modify it
384
under the same terms as Perl itself.
385

            
386
=cut