Newer Older
385 lines | 8.684kb
packing
yuki-kimoto authored on 2009-11-12
1
package DBIx::Custom::Result;
2
use Object::Simple;
3

            
Various change
yuki-kimoto authored on 2009-11-12
4
our $VERSION = '0.0202';
packing
yuki-kimoto authored on 2009-11-12
5

            
6
use Carp 'croak';
7

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

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

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

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

            
100
# Fetch only first (hash)
101
sub fetch_first_hash {
102
    my $self = shift;
103
    
104
    # Fetch hash
105
    my $row = $self->fetch_hash;
106
    
107
    # Not exist
108
    return unless $row;
109
    
110
    # Finish statement handle
111
    $self->finish;
112
    
113
    return wantarray ? %$row : $row;
114
}
115

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

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

            
160

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

            
172
# Fetch all (hash)
173
sub fetch_all_hash {
174
    my $self = shift;
175
    
176
    my $rows = [];
177
    while(my %row = $self->fetch_hash) {
178
        push @$rows, {%row};
179
    }
180
    return wantarray ? @$rows : $rows;
181
}
182

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

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

            
193
Object::Simple->build_class;
194

            
195
=head1 NAME
196

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

            
199
=head1 VERSION
200

            
Various change
yuki-kimoto authored on 2009-11-12
201
Version 0.0202
packing
yuki-kimoto authored on 2009-11-12
202

            
203
=head1 SYNOPSIS
204

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

            
213
=head1 OBJECT ACCESSORS
214

            
215
=head2 sth
216

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

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

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

            
226
=head2 fetch_filter
227

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

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

            
235
=head2 no_fetch_filters
236

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

            
241
=head1 METHODS
242

            
243
=head2 fetch
244

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

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

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

            
260
=head2 fetch_hash
261

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

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

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

            
277
=head2 fetch_first
278

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

            
287
=head2 fetch_first_hash
288
    
289
    # Fetch only first as hash (Scalar context)
290
    $row = $result->fetch_first_hash;
291
    
292
    # Fetch only first as hash (Scalar context)
293
    @row = $result->fetch_first_hash;
294
    
295
This method fetch only first and finish statement handle
296

            
297
=head2 fetch_rows
298

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

            
308
=head2 fetch_rows_hash
309

            
310
    # Fetch multi rows as hash (Scalar context)
311
    $rows = $result->fetch_rows_hash($row_count);
312
    
313
    # Fetch multi rows as hash (List context)
314
    @rows = $result->fetch_rows_hash($row_count);
315
    
316
    # Sapmle 
317
    $rows = $result->fetch_rows_hash(10);
318

            
319
=head2 fetch_all
320

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

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

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

            
334
=head2 fetch_all_hash
335

            
336
    # Fetch all row as array ref of hash ref (Scalar context)
337
    $rows = $result->fetch_all_hash;
338
    
339
    # Fetch all row as array of hash ref (List context)
340
    @rows = $result->fecth_all_hash;
341

            
342
    # Sample
343
    my $rows = $result->fetch_all_hash;
344
    my $val0_key1 = $rows->[0]{key1};
345
    my $val1_key2 = $rows->[1]{key2};
346

            
347
=head2 error
348

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

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

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

            
359
=head2 finish
360

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

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

            
370
    $result->sth->finish;
371

            
372
=head1 AUTHOR
373

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

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

            
378
=head1 COPYRIGHT & LICENSE
379

            
380
Copyright 2009 Yuki Kimoto, all rights reserved.
381

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

            
385
=cut