Newer Older
396 lines | 8.219kb
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

            
cleanup
yuki-kimoto authored on 2009-12-22
10
my $p = __PACKAGE__;
11

            
12
$p->attr([qw/_dbi sth fetch_filter/])
13
  ->attr(_no_fetch_filters_map => sub { {} });
14

            
15
$p->attr(no_fetch_filters => (type => 'array', trigger => sub {
packaging one directory
yuki-kimoto authored on 2009-11-16
16
    my $self = shift;
17
    my $no_fetch_filters = $self->no_fetch_filters || [];
18
    my %no_fetch_filters_map = map {$_ => 1} @{$no_fetch_filters};
19
    $self->_no_fetch_filters_map(\%no_fetch_filters_map);
cleanup
yuki-kimoto authored on 2009-12-22
20
}));
update document
yuki-kimoto authored on 2009-11-19
21

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

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

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

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

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

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

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

            
171

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

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

            
194
# Finish
195
sub finish { shift->sth->finish }
196

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

            
204
=head1 NAME
205

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

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

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

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

            
224
=head2 sth
225

            
update document
yuki-kimoto authored on 2009-11-19
226
Set and Get statement handle
227

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

            
update document
yuki-kimoto authored on 2009-11-19
233
Set and Get fetch filter
234

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

            
238
=head2 no_fetch_filters
239

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

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

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

            
cleanup
yuki-kimoto authored on 2009-12-22
247
=head2 new
248

            
249
    my $result = DBIx::Custom::Result->new;
250

            
packaging one directory
yuki-kimoto authored on 2009-11-16
251
=head2 fetch
252

            
update document
yuki-kimoto authored on 2009-11-19
253
Fetch a row
254

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

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

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

            
266
=head2 fetch_hash
267

            
update document
yuki-kimoto authored on 2009-11-19
268
Fetch row as hash
269

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

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

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

            
281
=head2 fetch_first
282

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

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

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

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

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

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

            
307
=head2 fetch_rows
308

            
update document
yuki-kimoto authored on 2009-11-19
309
Fetch rows
310

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

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

            
320
=head2 fetch_hash_rows
321

            
update document
yuki-kimoto authored on 2009-11-19
322
Fetch rows as hash
323

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

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

            
333
=head2 fetch_all
334

            
update document
yuki-kimoto authored on 2009-11-19
335
Fetch all rows
336

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

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

            
342
    my $rows = $result->fetch_all;
343

            
344
=head2 fetch_hash_all
345

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

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

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

            
353
    my $rows = $result->fetch_hash_all;
354

            
355
=head2 error
356

            
update document
yuki-kimoto authored on 2009-11-19
357
Get error infomation
358

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

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

            
365
    $error_message : $result->sth->errstr
366
    $error_number  : $result->sth->err
367
    $error_state   : $result->sth->state
368

            
369
=head2 finish
370

            
update document
yuki-kimoto authored on 2009-11-19
371
Finish statement handle
372

            
packaging one directory
yuki-kimoto authored on 2009-11-16
373
    $result->finish
374

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

            
377
    $result->sth->finish;
378

            
update document
yuki-kimoto authored on 2009-11-19
379
=head1 See also
380

            
381
L<DBIx::Custom>
382

            
383
=head1 Author
packaging one directory
yuki-kimoto authored on 2009-11-16
384

            
385
Yuki Kimoto, C<< <kimoto.yuki at gmail.com> >>
386

            
387
Github L<http://github.com/yuki-kimoto>
388

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

            
391
Copyright 2009 Yuki Kimoto, all rights reserved.
392

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

            
396
=cut