Newer Older
384 lines | 8.683kb
packaging one directory
yuki-kimoto authored on 2009-11-16
1
package DBIx::Custom::Result;
2
use Object::Simple;
3
use strict;
4
use warnings;
5
use Carp 'croak';
6

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

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

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

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

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

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

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

            
159

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

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

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

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

            
192
Object::Simple->build_class;
193

            
194
=head1 NAME
195

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

            
198
=head1 VERSION
199

            
200
Version 0.0301
201

            
202
=head1 SYNOPSIS
203

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

            
212
=head1 OBJECT ACCESSORS
213

            
214
=head2 sth
215

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

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

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

            
225
=head2 fetch_filter
226

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

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

            
234
=head2 no_fetch_filters
235

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

            
240
=head1 METHODS
241

            
242
=head2 fetch
243

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

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

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

            
259
=head2 fetch_hash
260

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

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

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

            
276
=head2 fetch_first
277

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

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

            
296
=head2 fetch_rows
297

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

            
307
=head2 fetch_hash_rows
308

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

            
318
=head2 fetch_all
319

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

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

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

            
333
=head2 fetch_hash_all
334

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

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

            
346
=head2 error
347

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

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

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

            
358
=head2 finish
359

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

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

            
369
    $result->sth->finish;
370

            
371
=head1 AUTHOR
372

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

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

            
377
=head1 COPYRIGHT & LICENSE
378

            
379
Copyright 2009 Yuki Kimoto, all rights reserved.
380

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

            
384
=cut