Newer Older
392 lines | 8.087kb
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

            
catch up with Object::Simple...
yuki-kimoto authored on 2010-01-18
8
__PACKAGE__->attr([qw/_dbi sth fetch_filter/]);
cleanup
yuki-kimoto authored on 2010-01-21
9
__PACKAGE__->attr(_no_fetch_filters => sub { {} });
update document
yuki-kimoto authored on 2009-11-19
10

            
cleanup
yuki-kimoto authored on 2009-12-22
11
sub new {
12
    my $self = shift->SUPER::new(@_);
13
    
cleanup
yuki-kimoto authored on 2010-01-21
14
    $self->no_fetch_filters($self->{no_fetch_filters})
15
      if exists $self->{no_fetch_filters};
cleanup
yuki-kimoto authored on 2009-12-22
16
    
17
    return $self;
18
}
packaging one directory
yuki-kimoto authored on 2009-11-16
19

            
cleanup
yuki-kimoto authored on 2010-01-21
20
sub no_fetch_filters {
21
    my $self = shift;
22
    
23
    if (@_) {
24
        
25
        $self->{no_fetch_filters} = $_[0];
26
        
27
        my %no_fetch_filters = map {$_ => 1} @{$self->{no_fetch_filters}};
28
        
29
        $self->_no_fetch_filters(\%no_fetch_filters);
30
        
31
        return $self;
32
    }
33
    
34
    return $self->{no_fetch_filters};
35
}
36

            
packaging one directory
yuki-kimoto authored on 2009-11-16
37
sub fetch {
38
    my ($self, $type) = @_;
39
    my $sth = $self->sth;
40
    my $fetch_filter = $self->fetch_filter;
41
    
42
    # Fetch
43
    my $row = $sth->fetchrow_arrayref;
44
    
45
    # Cannot fetch
46
    return unless $row;
47
    
48
    # Filter
49
    if ($fetch_filter) {
50
        my $keys  = $sth->{NAME_lc};
51
        my $types = $sth->{TYPE};
52
        for (my $i = 0; $i < @$keys; $i++) {
cleanup
yuki-kimoto authored on 2010-01-21
53
            next if $self->_no_fetch_filters->{$keys->[$i]};
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
54
            $row->[$i]= $fetch_filter->($row->[$i], $keys->[$i], $self->_dbi,
55
                                        {type => $types->[$i], sth => $sth, index => $i});
packaging one directory
yuki-kimoto authored on 2009-11-16
56
        }
57
    }
58
    return wantarray ? @$row : $row;
59
}
60

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

            
100
sub fetch_first {
101
    my $self = shift;
102
    
103
    # Fetch
104
    my $row = $self->fetch;
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
sub fetch_hash_first {
116
    my $self = shift;
117
    
118
    # Fetch hash
119
    my $row = $self->fetch_hash;
120
    
121
    # Not exist
122
    return unless $row;
123
    
124
    # Finish statement handle
125
    $self->finish;
126
    
127
    return wantarray ? %$row : $row;
128
}
129

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

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

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

            
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
sub finish { shift->sth->finish }
193

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

            
200
=head1 NAME
201

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

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

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

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

            
220
=head2 sth
221

            
update document
yuki-kimoto authored on 2009-11-19
222
Set and Get statement handle
223

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

            
update document
yuki-kimoto authored on 2009-11-19
229
Set and Get fetch filter
230

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

            
234
=head2 no_fetch_filters
235

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

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

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

            
cleanup
yuki-kimoto authored on 2009-12-22
243
=head2 new
244

            
245
    my $result = DBIx::Custom::Result->new;
246

            
packaging one directory
yuki-kimoto authored on 2009-11-16
247
=head2 fetch
248

            
update document
yuki-kimoto authored on 2009-11-19
249
Fetch a row
250

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

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

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

            
262
=head2 fetch_hash
263

            
update document
yuki-kimoto authored on 2009-11-19
264
Fetch row as hash
265

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

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

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

            
277
=head2 fetch_first
278

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

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

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

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

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

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

            
303
=head2 fetch_rows
304

            
update document
yuki-kimoto authored on 2009-11-19
305
Fetch rows
306

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

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

            
316
=head2 fetch_hash_rows
317

            
update document
yuki-kimoto authored on 2009-11-19
318
Fetch rows as hash
319

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

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

            
329
=head2 fetch_all
330

            
update document
yuki-kimoto authored on 2009-11-19
331
Fetch all rows
332

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

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

            
338
    my $rows = $result->fetch_all;
339

            
340
=head2 fetch_hash_all
341

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

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

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

            
349
    my $rows = $result->fetch_hash_all;
350

            
351
=head2 error
352

            
update document
yuki-kimoto authored on 2009-11-19
353
Get error infomation
354

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

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

            
361
    $error_message : $result->sth->errstr
362
    $error_number  : $result->sth->err
363
    $error_state   : $result->sth->state
364

            
365
=head2 finish
366

            
update document
yuki-kimoto authored on 2009-11-19
367
Finish statement handle
368

            
packaging one directory
yuki-kimoto authored on 2009-11-16
369
    $result->finish
370

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

            
373
    $result->sth->finish;
374

            
update document
yuki-kimoto authored on 2009-11-19
375
=head1 See also
376

            
377
L<DBIx::Custom>
378

            
379
=head1 Author
packaging one directory
yuki-kimoto authored on 2009-11-16
380

            
381
Yuki Kimoto, C<< <kimoto.yuki at gmail.com> >>
382

            
383
Github L<http://github.com/yuki-kimoto>
384

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

            
387
Copyright 2009 Yuki Kimoto, all rights reserved.
388

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

            
392
=cut