Newer Older
382 lines | 8.757kb
packaging one directory
yuki-kimoto authored on 2009-11-16
1
package DBIx::Custom::Result;
2
use Object::Simple;
update document
yuki-kimoto authored on 2009-11-17
3

            
packaging one directory
yuki-kimoto authored on 2009-11-16
4
use strict;
5
use warnings;
6
use Carp 'croak';
7

            
8
# Attributes
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
9
sub _dbi             : Attr {}
packaging one directory
yuki-kimoto authored on 2009-11-16
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]};
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
38
            $row->[$i]= $fetch_filter->($row->[$i], $keys->[$i], $self->_dbi,
39
                                        {type => $types->[$i], sth => $sth, index => $i});
packaging one directory
yuki-kimoto authored on 2009-11-16
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]}
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
70
                  = $fetch_filter->($row->[$i], $keys->[$i], $self->_dbi,
71
                                    {type => $types->[$i], sth => $sth, index => $i});
packaging one directory
yuki-kimoto authored on 2009-11-16
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)
102
sub fetch_hash_first {
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)
140
sub fetch_hash_rows {
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)
174
sub fetch_hash_all {
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

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

            
200
=head1 SYNOPSIS
201

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

            
210
=head1 OBJECT ACCESSORS
211

            
212
=head2 sth
213

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

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

            
221
If you need statement handle, you can get statement handle by using this method.
222

            
223
=head2 fetch_filter
224

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

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

            
232
=head2 no_fetch_filters
233

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

            
238
=head1 METHODS
239

            
240
=head2 fetch
241

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

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

            
255
fetch method is fetch resultset and get row as array or array reference.
256

            
257
=head2 fetch_hash
258

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

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

            
272
fetch_hash method is fetch resultset and get row as hash or hash reference.
273

            
274
=head2 fetch_first
275

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

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

            
294
=head2 fetch_rows
295

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

            
305
=head2 fetch_hash_rows
306

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

            
316
=head2 fetch_all
317

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

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

            
329
fetch_all method is fetch resultset and get all rows as array or array reference.
330

            
331
=head2 fetch_hash_all
332

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

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

            
344
=head2 error
345

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

            
350
You can get get information. This is crenspond to the following.
351

            
352
    $error_message : $result->sth->errstr
353
    $error_number  : $result->sth->err
354
    $error_state   : $result->sth->state
355

            
356
=head2 finish
357

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

            
365
You can finish statement handle.This is equel to
366

            
367
    $result->sth->finish;
368

            
369
=head1 AUTHOR
370

            
371
Yuki Kimoto, C<< <kimoto.yuki at gmail.com> >>
372

            
373
Github L<http://github.com/yuki-kimoto>
374

            
375
=head1 COPYRIGHT & LICENSE
376

            
377
Copyright 2009 Yuki Kimoto, all rights reserved.
378

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

            
382
=cut