Newer Older
394 lines | 8.206kb
packaging one directory
yuki-kimoto authored on 2009-11-16
1
package DBIx::Custom::Result;
cleanup
yuki-kimoto authored on 2009-12-22
2
use base 'Object::Simple::Base';
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

            
cleanup
yuki-kimoto authored on 2009-12-22
8
use Object::Simple::Util;
update document
yuki-kimoto authored on 2009-11-19
9

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

            
catch up with Object::Simple...
yuki-kimoto authored on 2010-01-18
13
__PACKAGE__->attr('no_fetch_filters', trigger => sub {
packaging one directory
yuki-kimoto authored on 2009-11-16
14
    my $self = shift;
15
    my $no_fetch_filters = $self->no_fetch_filters || [];
16
    my %no_fetch_filters_map = map {$_ => 1} @{$no_fetch_filters};
17
    $self->_no_fetch_filters_map(\%no_fetch_filters_map);
catch up with Object::Simple...
yuki-kimoto authored on 2010-01-18
18
});
update document
yuki-kimoto authored on 2009-11-19
19

            
cleanup
yuki-kimoto authored on 2009-12-22
20
sub new {
21
    my $self = shift->SUPER::new(@_);
22
    
23
    Object::Simple::Util->init_attrs($self, 'no_fetch_filters');
24
    
25
    return $self;
26
}
packaging one directory
yuki-kimoto authored on 2009-11-16
27

            
28
# Fetch (array)
29
sub fetch {
30
    my ($self, $type) = @_;
31
    my $sth = $self->sth;
32
    my $fetch_filter = $self->fetch_filter;
33
    
34
    # Fetch
35
    my $row = $sth->fetchrow_arrayref;
36
    
37
    # Cannot fetch
38
    return unless $row;
39
    
40
    # Filter
41
    if ($fetch_filter) {
42
        my $keys  = $sth->{NAME_lc};
43
        my $types = $sth->{TYPE};
44
        for (my $i = 0; $i < @$keys; $i++) {
45
            next if $self->_no_fetch_filters_map->{$keys->[$i]};
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
46
            $row->[$i]= $fetch_filter->($row->[$i], $keys->[$i], $self->_dbi,
47
                                        {type => $types->[$i], sth => $sth, index => $i});
packaging one directory
yuki-kimoto authored on 2009-11-16
48
        }
49
    }
50
    return wantarray ? @$row : $row;
51
}
52

            
53
# Fetch (hash)
54
sub fetch_hash {
55
    my $self = shift;
56
    my $sth = $self->sth;
57
    my $fetch_filter = $self->fetch_filter;
58
    
59
    # Fetch
60
    my $row = $sth->fetchrow_arrayref;
61
    
62
    # Cannot fetch
63
    return unless $row;
64
    
65
    # Keys
66
    my $keys  = $sth->{NAME_lc};
67
    
68
    # Filter
69
    my $row_hash = {};
70
    if ($fetch_filter) {
71
        my $types = $sth->{TYPE};
72
        for (my $i = 0; $i < @$keys; $i++) {
73
            if ($self->_no_fetch_filters_map->{$keys->[$i]}) {
74
                $row_hash->{$keys->[$i]} = $row->[$i];
75
            }
76
            else {
77
                $row_hash->{$keys->[$i]}
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
78
                  = $fetch_filter->($row->[$i], $keys->[$i], $self->_dbi,
79
                                    {type => $types->[$i], sth => $sth, index => $i});
packaging one directory
yuki-kimoto authored on 2009-11-16
80
            }
81
        }
82
    }
83
    
84
    # No filter
85
    else {
86
        for (my $i = 0; $i < @$keys; $i++) {
87
            $row_hash->{$keys->[$i]} = $row->[$i];
88
        }
89
    }
90
    return wantarray ? %$row_hash : $row_hash;
91
}
92

            
93
# Fetch only first (array)
94
sub fetch_first {
95
    my $self = shift;
96
    
97
    # Fetch
98
    my $row = $self->fetch;
99
    
100
    # Not exist
101
    return unless $row;
102
    
103
    # Finish statement handle
104
    $self->finish;
105
    
106
    return wantarray ? @$row : $row;
107
}
108

            
109
# Fetch only first (hash)
110
sub fetch_hash_first {
111
    my $self = shift;
112
    
113
    # Fetch hash
114
    my $row = $self->fetch_hash;
115
    
116
    # Not exist
117
    return unless $row;
118
    
119
    # Finish statement handle
120
    $self->finish;
121
    
122
    return wantarray ? %$row : $row;
123
}
124

            
125
# Fetch multi rows (array)
126
sub fetch_rows {
127
    my ($self, $count) = @_;
128
    
129
    # Not specified Row count
130
    croak("Row count must be specified")
131
      unless $count;
132
    
133
    # Fetch multi rows
134
    my $rows = [];
135
    for (my $i = 0; $i < $count; $i++) {
136
        my @row = $self->fetch;
137
        
138
        last unless @row;
139
        
140
        push @$rows, \@row;
141
    }
142
    
143
    return unless @$rows;
144
    return wantarray ? @$rows : $rows;
145
}
146

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

            
169

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

            
181
# Fetch all (hash)
182
sub fetch_hash_all {
183
    my $self = shift;
184
    
185
    my $rows = [];
186
    while(my %row = $self->fetch_hash) {
187
        push @$rows, {%row};
188
    }
189
    return wantarray ? @$rows : $rows;
190
}
191

            
192
# Finish
193
sub finish { shift->sth->finish }
194

            
195
# Error
196
sub error { 
197
    my $self = shift;
198
    my $sth  = $self->sth;
199
    return wantarray ? ($sth->errstr, $sth->err, $sth->state) : $sth->errstr;
200
}
201

            
202
=head1 NAME
203

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

            
update document
yuki-kimoto authored on 2009-11-19
206
=head1 Synopsis
packaging one directory
yuki-kimoto authored on 2009-11-16
207

            
version 0.0901
yuki-kimoto authored on 2009-12-17
208
    my $result = $dbi->query($query);
packaging one directory
yuki-kimoto authored on 2009-11-16
209
    
version 0.0901
yuki-kimoto authored on 2009-12-17
210
    # Fetch
211
    while (my @row = $result->fetch) {
212
        # Do something
213
    }
214
    
215
    # Fetch hash
216
    while (my %row = $result->fetch_hash) {
217
        # Do something
packaging one directory
yuki-kimoto authored on 2009-11-16
218
    }
219

            
update document
yuki-kimoto authored on 2009-11-19
220
=head1 Accessors
packaging one directory
yuki-kimoto authored on 2009-11-16
221

            
222
=head2 sth
223

            
update document
yuki-kimoto authored on 2009-11-19
224
Set and Get statement handle
225

            
version 0.0901
yuki-kimoto authored on 2009-12-17
226
    $result = $result->sth($sth);
227
    $sth    = $reuslt->sth
update document
yuki-kimoto authored on 2009-11-19
228
    
packaging one directory
yuki-kimoto authored on 2009-11-16
229
=head2 fetch_filter
230

            
update document
yuki-kimoto authored on 2009-11-19
231
Set and Get fetch filter
232

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

            
236
=head2 no_fetch_filters
237

            
update document
yuki-kimoto authored on 2009-11-19
238
Set and Get no filter keys when fetching
239

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

            
update document
yuki-kimoto authored on 2009-11-19
243
=head1 Methods
packaging one directory
yuki-kimoto authored on 2009-11-16
244

            
cleanup
yuki-kimoto authored on 2009-12-22
245
=head2 new
246

            
247
    my $result = DBIx::Custom::Result->new;
248

            
packaging one directory
yuki-kimoto authored on 2009-11-16
249
=head2 fetch
250

            
update document
yuki-kimoto authored on 2009-11-19
251
Fetch a row
252

            
version 0.0901
yuki-kimoto authored on 2009-12-17
253
    $row = $result->fetch; # array reference
254
    @row = $result->fecth; # array
255

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

            
258
    while (my $row = $result->fetch) {
259
        # do something
260
        my $val1 = $row->[0];
261
        my $val2 = $row->[1];
262
    }
263

            
264
=head2 fetch_hash
265

            
update document
yuki-kimoto authored on 2009-11-19
266
Fetch row as hash
267

            
version 0.0901
yuki-kimoto authored on 2009-12-17
268
    $row = $result->fetch_hash; # hash reference
269
    %row = $result->fetch_hash; # hash
270

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

            
273
    while (my $row = $result->fetch_hash) {
274
        # do something
275
        my $val1 = $row->{key1};
276
        my $val2 = $row->{key2};
277
    }
278

            
279
=head2 fetch_first
280

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

            
version 0.0901
yuki-kimoto authored on 2009-12-17
283
    $row = $result->fetch_first; # array reference
284
    @row = $result->fetch_first; # array
packaging one directory
yuki-kimoto authored on 2009-11-16
285
    
version 0.0901
yuki-kimoto authored on 2009-12-17
286
The following is fetch_first sample
287

            
update document
yuki-kimoto authored on 2009-11-19
288
    $row = $result->fetch_first;
packaging one directory
yuki-kimoto authored on 2009-11-16
289
    
update document
yuki-kimoto authored on 2009-11-19
290
This method fetch only first row and finish statement handle
packaging one directory
yuki-kimoto authored on 2009-11-16
291

            
292
=head2 fetch_hash_first
293
    
update document
yuki-kimoto authored on 2009-11-19
294
Fetch only first row as hash
295

            
version 0.0901
yuki-kimoto authored on 2009-12-17
296
    $row = $result->fetch_hash_first; # hash reference
297
    %row = $result->fetch_hash_first; # hash
packaging one directory
yuki-kimoto authored on 2009-11-16
298
    
version 0.0901
yuki-kimoto authored on 2009-12-17
299
The following is fetch_hash_first sample
300

            
update document
yuki-kimoto authored on 2009-11-19
301
    $row = $result->fetch_hash_first;
packaging one directory
yuki-kimoto authored on 2009-11-16
302
    
update document
yuki-kimoto authored on 2009-11-19
303
This method fetch only first row and finish statement handle
packaging one directory
yuki-kimoto authored on 2009-11-16
304

            
305
=head2 fetch_rows
306

            
update document
yuki-kimoto authored on 2009-11-19
307
Fetch rows
308

            
version 0.0901
yuki-kimoto authored on 2009-12-17
309
    $rows = $result->fetch_rows($row_count); # array ref of array ref
310
    @rows = $result->fetch_rows($row_count); # array of array ref
packaging one directory
yuki-kimoto authored on 2009-11-16
311
    
version 0.0901
yuki-kimoto authored on 2009-12-17
312
The following is fetch_rows sample
313

            
update document
yuki-kimoto authored on 2009-11-19
314
    while(my $rows = $result->fetch_rows(10)) {
315
        # do someting
316
    }
packaging one directory
yuki-kimoto authored on 2009-11-16
317

            
318
=head2 fetch_hash_rows
319

            
update document
yuki-kimoto authored on 2009-11-19
320
Fetch rows as hash
321

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

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

            
331
=head2 fetch_all
332

            
update document
yuki-kimoto authored on 2009-11-19
333
Fetch all rows
334

            
version 0.0901
yuki-kimoto authored on 2009-12-17
335
    $rows = $result->fetch_all; # array ref of array ref
336
    @rows = $result->fecth_all; # array of array ref
337

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

            
340
    my $rows = $result->fetch_all;
341

            
342
=head2 fetch_hash_all
343

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

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

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

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

            
353
=head2 error
354

            
update document
yuki-kimoto authored on 2009-11-19
355
Get error infomation
356

            
version 0.0901
yuki-kimoto authored on 2009-12-17
357
    $error_messege = $result->error;
358
    ($error_message, $error_number, $error_state) = $result->error;
update document
yuki-kimoto authored on 2009-11-19
359
    
packaging one directory
yuki-kimoto authored on 2009-11-16
360

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

            
363
    $error_message : $result->sth->errstr
364
    $error_number  : $result->sth->err
365
    $error_state   : $result->sth->state
366

            
367
=head2 finish
368

            
update document
yuki-kimoto authored on 2009-11-19
369
Finish statement handle
370

            
packaging one directory
yuki-kimoto authored on 2009-11-16
371
    $result->finish
372

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

            
375
    $result->sth->finish;
376

            
update document
yuki-kimoto authored on 2009-11-19
377
=head1 See also
378

            
379
L<DBIx::Custom>
380

            
381
=head1 Author
packaging one directory
yuki-kimoto authored on 2009-11-16
382

            
383
Yuki Kimoto, C<< <kimoto.yuki at gmail.com> >>
384

            
385
Github L<http://github.com/yuki-kimoto>
386

            
update document
yuki-kimoto authored on 2009-11-19
387
=head1 Copyright & licence
packaging one directory
yuki-kimoto authored on 2009-11-16
388

            
389
Copyright 2009 Yuki Kimoto, all rights reserved.
390

            
391
This program is free software; you can redistribute it and/or modify it
392
under the same terms as Perl itself.
393

            
394
=cut