Newer Older
397 lines | 8.361kb
packaging one directory
yuki-kimoto authored on 2009-11-16
1
package DBIx::Custom::Result;
update document
yuki-kimoto authored on 2009-11-17
2

            
packaging one directory
yuki-kimoto authored on 2009-11-16
3
use strict;
4
use warnings;
update document
yuki-kimoto authored on 2010-01-30
5

            
6
use base 'Object::Simple';
cleanup
yuki-kimoto authored on 2010-02-11
7

            
packaging one directory
yuki-kimoto authored on 2009-11-16
8
use Carp 'croak';
9

            
cleanup
Yuki Kimoto authored on 2011-01-23
10
__PACKAGE__->attr([qw/filters sth/]);
cleanup
Yuki Kimoto authored on 2010-12-21
11

            
12
sub filter {
13
    my $self = shift;
cleanup
Yuki Kimoto authored on 2010-12-22
14
    
15
    if (@_) {
16
        my $filter = ref $_[0] eq 'HASH' ? $_[0] : {@_};
17
        
18
        foreach my $column (keys %$filter) {
19
            my $fname = $filter->{$column};
20
            unless (ref $fname eq 'CODE') {
many changed
Yuki Kimoto authored on 2011-01-23
21
              croak qq{Filter "$fname" is not registered"}
cleanup
Yuki Kimoto authored on 2010-12-22
22
                unless exists $self->filters->{$fname};
23
              
24
              $filter->{$column} = $self->filters->{$fname};
25
            }
cleanup
Yuki Kimoto authored on 2010-12-21
26
        }
cleanup
Yuki Kimoto authored on 2010-12-22
27
        
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-17
28
        $self->{filter} = {%{$self->filter}, %$filter};
cleanup
Yuki Kimoto authored on 2010-12-22
29
        
30
        return $self;
cleanup
Yuki Kimoto authored on 2010-12-21
31
    }
32
    
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-17
33
    return $self->{filter} ||= {};
34
}
35

            
36
sub end_filter {
37
    my $self = shift;
38
    
39
    if (@_) {
40
        my $end_filter = ref $_[0] eq 'HASH' ? $_[0] : {@_};
41
        
42
        foreach my $column (keys %$end_filter) {
43
            my $fname = $end_filter->{$column};
44
            unless (ref $fname eq 'CODE') {
many changed
Yuki Kimoto authored on 2011-01-23
45
              croak qq{Filter "$fname" is not registered"}
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-17
46
                unless exists $self->filters->{$fname};
47
              
48
              $end_filter->{$column} = $self->filters->{$fname};
49
            }
50
        }
51
        
52
        $self->{end_filter} = {%{$self->end_filter}, %$end_filter};
53
        
54
        return $self;
55
    }
56
    
57
    return $self->{end_filter} ||= {};
cleanup
Yuki Kimoto authored on 2010-12-21
58
}
cleanup
yuki-kimoto authored on 2010-01-21
59

            
packaging one directory
yuki-kimoto authored on 2009-11-16
60
sub fetch {
changed argument of tag proc...
yuki-kimoto authored on 2010-08-03
61
    my $self = shift;
62
    
cleanup
Yuki Kimoto authored on 2011-01-12
63
    # Filter
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-17
64
    my $filter = $self->filter;
65
    
66
    # End filter
67
    my $end_filter = $self->end_filter;
packaging one directory
yuki-kimoto authored on 2009-11-16
68
    
69
    # Fetch
changed argument of tag proc...
yuki-kimoto authored on 2010-08-03
70
    my @row = $self->{sth}->fetchrow_array;
packaging one directory
yuki-kimoto authored on 2009-11-16
71
    
cleanup
yuki-kimoto authored on 2010-08-05
72
    # No row
update document
yuki-kimoto authored on 2010-05-27
73
    return unless @row;
added check_filter attribute
yuki-kimoto authored on 2010-08-08
74
    
cleanup
yuki-kimoto authored on 2010-08-05
75
    # Filtering
added experimental iterate_a...
Yuki Kimoto authored on 2010-12-22
76
    my $columns = $self->{sth}->{NAME};
cleanup
yuki-kimoto authored on 2010-08-05
77
    for (my $i = 0; $i < @$columns; $i++) {
update document
yuki-kimoto authored on 2010-05-27
78
        
changed argument of tag proc...
yuki-kimoto authored on 2010-08-03
79
        # Filter name
cleanup
yuki-kimoto authored on 2010-08-05
80
        my $column = $columns->[$i];
cleanup
Yuki Kimoto authored on 2010-12-21
81
        my $f  = exists $filter->{$column}
82
               ? $filter->{$column}
cleanup
Yuki Kimoto authored on 2010-12-22
83
               : $self->default_filter;
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-17
84
        my $ef = $end_filter->{$column};
some changed
yuki-kimoto authored on 2010-05-02
85
        
cleanup
yuki-kimoto authored on 2010-08-05
86
        # Filtering
cleanup
Yuki Kimoto authored on 2010-12-21
87
        $row[$i] = $f->($row[$i]) if $f;
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-17
88
        $row[$i] = $ef->($row[$i]) if $ef;
packaging one directory
yuki-kimoto authored on 2009-11-16
89
    }
many many changes
yuki-kimoto authored on 2010-04-30
90

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
91
    return \@row;
92
}
93

            
cleanup
yuki-kimoto authored on 2010-10-17
94
sub fetch_all {
95
    my $self = shift;
96
    
97
    # Fetch all rows
98
    my $rows = [];
99
    while(my $row = $self->fetch) {
100
        push @$rows, $row;
101
    }
102
    return $rows;
103
}
104

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
105
sub fetch_first {
106
    my $self = shift;
107
    
108
    # Fetch
109
    my $row = $self->fetch;
110
    
cleanup
yuki-kimoto authored on 2010-08-05
111
    # No row
removed reconnect method
yuki-kimoto authored on 2010-05-28
112
    return unless $row;
113
    
114
    # Finish statement handle
115
    $self->sth->finish;
116
    
117
    return $row;
118
}
119

            
packaging one directory
yuki-kimoto authored on 2009-11-16
120
sub fetch_hash {
changed argument of tag proc...
yuki-kimoto authored on 2010-08-03
121
    my $self = shift;
122
    
cleanup
Yuki Kimoto authored on 2011-01-12
123
    # Filter
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-17
124
    my $filter  = $self->filter;
125
    
126
    # End filter
127
    my $end_filter = $self->end_filter;
packaging one directory
yuki-kimoto authored on 2009-11-16
128
    
129
    # Fetch
changed argument of tag proc...
yuki-kimoto authored on 2010-08-03
130
    my $row = $self->{sth}->fetchrow_arrayref;
packaging one directory
yuki-kimoto authored on 2009-11-16
131
    
132
    # Cannot fetch
133
    return unless $row;
added check_filter attribute
yuki-kimoto authored on 2010-08-08
134

            
packaging one directory
yuki-kimoto authored on 2009-11-16
135
    # Filter
136
    my $row_hash = {};
added experimental iterate_a...
Yuki Kimoto authored on 2010-12-22
137
    my $columns = $self->{sth}->{NAME};
cleanup
yuki-kimoto authored on 2010-08-05
138
    for (my $i = 0; $i < @$columns; $i++) {
update document
yuki-kimoto authored on 2010-05-27
139
        
changed argument of tag proc...
yuki-kimoto authored on 2010-08-03
140
        # Filter name
cleanup
yuki-kimoto authored on 2010-08-05
141
        my $column = $columns->[$i];
cleanup
Yuki Kimoto authored on 2010-12-21
142
        my $f  = exists $filter->{$column}
143
               ? $filter->{$column}
cleanup
Yuki Kimoto authored on 2010-12-22
144
               : $self->default_filter;
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-17
145
        my $ef = $end_filter->{$column};
add query filter error check
yuki-kimoto authored on 2010-05-14
146
        
cleanup
yuki-kimoto authored on 2010-08-05
147
        # Filtering
cleanup
Yuki Kimoto authored on 2010-12-21
148
        $row_hash->{$column} = $f ? $f->($row->[$i]) : $row->[$i];
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-17
149
        $row_hash->{$column} = $ef->($row_hash->{$column}) if $ef;
packaging one directory
yuki-kimoto authored on 2009-11-16
150
    }
151
    
removed reconnect method
yuki-kimoto authored on 2010-05-28
152
    return $row_hash;
packaging one directory
yuki-kimoto authored on 2009-11-16
153
}
154

            
cleanup
yuki-kimoto authored on 2010-10-17
155
sub fetch_hash_all {
156
    my $self = shift;
157
    
158
    # Fetch all rows as hash
159
    my $rows = [];
160
    while(my $row = $self->fetch_hash) {
161
        push @$rows, $row;
162
    }
163
    
164
    return $rows;
165
}
166

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
167
sub fetch_hash_first {
packaging one directory
yuki-kimoto authored on 2009-11-16
168
    my $self = shift;
169
    
170
    # Fetch hash
171
    my $row = $self->fetch_hash;
172
    
cleanup
yuki-kimoto authored on 2010-08-05
173
    # No row
packaging one directory
yuki-kimoto authored on 2009-11-16
174
    return unless $row;
175
    
176
    # Finish statement handle
some changed
yuki-kimoto authored on 2010-05-02
177
    $self->sth->finish;
packaging one directory
yuki-kimoto authored on 2009-11-16
178
    
removed reconnect method
yuki-kimoto authored on 2010-05-28
179
    return $row;
packaging one directory
yuki-kimoto authored on 2009-11-16
180
}
181

            
renamed fetch_rows to fetch_...
yuki-kimoto authored on 2010-05-01
182
sub fetch_hash_multi {
packaging one directory
yuki-kimoto authored on 2009-11-16
183
    my ($self, $count) = @_;
184
    
cleanup
yuki-kimoto authored on 2010-08-05
185
    # Row count not specified
changed argument of tag proc...
yuki-kimoto authored on 2010-08-03
186
    croak 'Row count must be specified'
packaging one directory
yuki-kimoto authored on 2009-11-16
187
      unless $count;
188
    
189
    # Fetch multi rows
190
    my $rows = [];
191
    for (my $i = 0; $i < $count; $i++) {
removed reconnect method
yuki-kimoto authored on 2010-05-28
192
        my $row = $self->fetch_hash;
193
        last unless $row;
194
        push @$rows, $row;
packaging one directory
yuki-kimoto authored on 2009-11-16
195
    }
196
    
197
    return unless @$rows;
removed reconnect method
yuki-kimoto authored on 2010-05-28
198
    return $rows;
packaging one directory
yuki-kimoto authored on 2009-11-16
199
}
200

            
cleanup
yuki-kimoto authored on 2010-10-17
201
sub fetch_multi {
202
    my ($self, $count) = @_;
packaging one directory
yuki-kimoto authored on 2009-11-16
203
    
cleanup
yuki-kimoto authored on 2010-10-17
204
    # Row count not specifed
205
    croak 'Row count must be specified'
206
      unless $count;
207
    
208
    # Fetch multi rows
packaging one directory
yuki-kimoto authored on 2009-11-16
209
    my $rows = [];
cleanup
yuki-kimoto authored on 2010-10-17
210
    for (my $i = 0; $i < $count; $i++) {
211
        my $row = $self->fetch;
212
        last unless $row;
removed reconnect method
yuki-kimoto authored on 2010-05-28
213
        push @$rows, $row;
packaging one directory
yuki-kimoto authored on 2009-11-16
214
    }
changed argument of tag proc...
yuki-kimoto authored on 2010-08-03
215
    
cleanup
yuki-kimoto authored on 2010-10-17
216
    return unless @$rows;
removed reconnect method
yuki-kimoto authored on 2010-05-28
217
    return $rows;
packaging one directory
yuki-kimoto authored on 2009-11-16
218
}
219

            
cleanup
Yuki Kimoto authored on 2011-01-12
220
# Deprecated
221
sub default_filter {
222
    my $self = shift;
223
    
224
    if (@_) {
225
        my $fname = $_[0];
226
        if (@_ && !$fname) {
227
            $self->{default_filter} = undef;
228
        }
229
        else {
many changed
Yuki Kimoto authored on 2011-01-23
230
            croak qq{Filter "$fname" is not registered}
cleanup
Yuki Kimoto authored on 2011-01-12
231
              unless exists $self->filters->{$fname};
232
        
233
            $self->{default_filter} = $self->filters->{$fname};
234
        }
235
        
236
        return $self;
237
    }
238
    
239
    return $self->{default_filter};
240
}
241

            
cleanup
Yuki Kimoto authored on 2011-01-23
242
# DEPRECATED!
243
__PACKAGE__->attr('filter_check'); 
244

            
update document
yuki-kimoto authored on 2010-01-30
245
1;
246

            
packaging one directory
yuki-kimoto authored on 2009-11-16
247
=head1 NAME
248

            
cleanup
yuki-kimoto authored on 2010-08-05
249
DBIx::Custom::Result - Result of select statement
packaging one directory
yuki-kimoto authored on 2009-11-16
250

            
update document
yuki-kimoto authored on 2010-01-30
251
=head1 SYNOPSIS
cleanup
yuki-kimoto authored on 2010-08-05
252

            
253
Get the result of select statement.
254

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
255
    # Result
256
    my $result = $dbi->select(table => 'books');
cleanup
yuki-kimoto authored on 2010-08-05
257

            
258
Fetch row into array.
removed reconnect method
yuki-kimoto authored on 2010-05-28
259
    
260
    # Fetch a row into array
261
    while (my $row = $result->fetch) {
cleanup
yuki-kimoto authored on 2010-08-05
262
        my $author = $row->[0];
263
        my $title  = $row->[1];
removed reconnect method
yuki-kimoto authored on 2010-05-28
264
        
version 0.0901
yuki-kimoto authored on 2009-12-17
265
    }
266
    
cleanup
yuki-kimoto authored on 2010-08-05
267
    # Fetch only a first row into array
removed reconnect method
yuki-kimoto authored on 2010-05-28
268
    my $row = $result->fetch_first;
269
    
270
    # Fetch multiple rows into array of array
271
    while (my $rows = $result->fetch_multi(5)) {
cleanup
yuki-kimoto authored on 2010-08-05
272
        my $first_author  = $rows->[0][0];
273
        my $first_title   = $rows->[0][1];
274
        my $second_author = $rows->[1][0];
275
        my $second_value  = $rows->[1][1];
276
    
removed reconnect method
yuki-kimoto authored on 2010-05-28
277
    }
278
    
279
    # Fetch all rows into array of array
280
    my $rows = $result->fetch_all;
cleanup
yuki-kimoto authored on 2010-08-05
281

            
282
Fetch row into hash.
283

            
284
    # Fetch a row into hash
removed reconnect method
yuki-kimoto authored on 2010-05-28
285
    while (my $row = $result->fetch_hash) {
cleanup
yuki-kimoto authored on 2010-08-05
286
        my $title  = $row->{title};
287
        my $author = $row->{author};
removed reconnect method
yuki-kimoto authored on 2010-05-28
288
        
packaging one directory
yuki-kimoto authored on 2009-11-16
289
    }
removed reconnect method
yuki-kimoto authored on 2010-05-28
290
    
cleanup
yuki-kimoto authored on 2010-08-05
291
    # Fetch only a first row into hash
removed reconnect method
yuki-kimoto authored on 2010-05-28
292
    my $row = $result->fetch_hash_first;
293
    
294
    # Fetch multiple rows into array of hash
cleanup
yuki-kimoto authored on 2010-08-05
295
    while (my $rows = $result->fetch_hash_multi(5)) {
296
        my $first_title   = $rows->[0]{title};
297
        my $first_author  = $rows->[0]{author};
298
        my $second_title  = $rows->[1]{title};
299
        my $second_author = $rows->[1]{author};
removed reconnect method
yuki-kimoto authored on 2010-05-28
300
    }
301
    
302
    # Fetch all rows into array of hash
303
    my $rows = $result->fetch_hash_all;
packaging one directory
yuki-kimoto authored on 2009-11-16
304

            
update document
yuki-kimoto authored on 2010-01-30
305
=head1 ATTRIBUTES
packaging one directory
yuki-kimoto authored on 2009-11-16
306

            
cleanup
yuki-kimoto authored on 2010-08-05
307
Filters when a row is fetched.
308
This overwrites C<default_filter>.
removed DESTROY method(not b...
yuki-kimoto authored on 2010-07-18
309

            
cleanup
yuki-kimoto authored on 2010-10-17
310
=head2 C<filters>
311

            
312
    my $filters = $result->filters;
313
    $result     = $result->filters(\%filters);
314

            
315
Resistered filters.
316

            
317
=head2 C<sth>
318

            
319
    my $sth = $reuslt->sth
320
    $result = $result->sth($sth);
321

            
322
Statement handle of L<DBI>.
323

            
update document
yuki-kimoto authored on 2010-01-30
324
=head1 METHODS
325

            
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
326
L<DBIx::Custom::Result> inherits all methods from L<Object::Simple>
cleanup
yuki-kimoto authored on 2010-08-05
327
and implements the following new ones.
packaging one directory
yuki-kimoto authored on 2009-11-16
328

            
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-17
329
=head2 C<(experimental) end_filter>
330

            
331
    $result    = $result->end_filter(title  => 'to_upper_case',
332
                                     author => 'to_upper_case');
333

            
334
End filters.
335
These each filters is executed after the filters applied by C<apply_filter> of
336
L<DBIx::Custom> or C<filter> method.
337

            
removed DBIx::Custom commit ...
yuki-kimoto authored on 2010-07-14
338
=head2 C<fetch>
packaging one directory
yuki-kimoto authored on 2009-11-16
339

            
cleanup
yuki-kimoto authored on 2010-08-05
340
    my $row = $result->fetch;
version 0.0901
yuki-kimoto authored on 2009-12-17
341

            
cleanup
yuki-kimoto authored on 2010-08-05
342
Fetch a row into array.
packaging one directory
yuki-kimoto authored on 2009-11-16
343

            
removed DBIx::Custom commit ...
yuki-kimoto authored on 2010-07-14
344
=head2 C<fetch_all>
packaging one directory
yuki-kimoto authored on 2009-11-16
345

            
cleanup
yuki-kimoto authored on 2010-08-05
346
    my $rows = $result->fetch_all;
version 0.0901
yuki-kimoto authored on 2009-12-17
347

            
removed DESTROY method(not b...
yuki-kimoto authored on 2010-07-18
348
Fetch all rows into array of array.
packaging one directory
yuki-kimoto authored on 2009-11-16
349

            
cleanup
yuki-kimoto authored on 2010-10-17
350
=head2 C<fetch_first>
351

            
352
    my $row = $result->fetch_first;
353

            
354
Fetch only a first row into array and finish statment handle.
355

            
removed DESTROY method(not b...
yuki-kimoto authored on 2010-07-18
356
=head2 C<fetch_hash>
packaging one directory
yuki-kimoto authored on 2009-11-16
357

            
cleanup
yuki-kimoto authored on 2010-08-05
358
    my $row = $result->fetch_hash;
packaging one directory
yuki-kimoto authored on 2009-11-16
359

            
removed DESTROY method(not b...
yuki-kimoto authored on 2010-07-18
360
Fetch a row into hash
update document
yuki-kimoto authored on 2009-11-19
361

            
cleanup
yuki-kimoto authored on 2010-10-17
362
=head2 C<fetch_hash_all>
363

            
364
    my $rows = $result->fetch_hash_all;
365

            
366
Fetch all rows into array of hash.
367

            
removed DBIx::Custom commit ...
yuki-kimoto authored on 2010-07-14
368
=head2 C<fetch_hash_first>
removed reconnect method
yuki-kimoto authored on 2010-05-28
369
    
cleanup
yuki-kimoto authored on 2010-08-05
370
    my $row = $result->fetch_hash_first;
packaging one directory
yuki-kimoto authored on 2009-11-16
371

            
removed DESTROY method(not b...
yuki-kimoto authored on 2010-07-18
372
Fetch only first row into hash and finish statment handle.
packaging one directory
yuki-kimoto authored on 2009-11-16
373

            
removed DESTROY method(not b...
yuki-kimoto authored on 2010-07-18
374
=head2 C<fetch_hash_multi>
update document
yuki-kimoto authored on 2009-11-19
375

            
cleanup
yuki-kimoto authored on 2010-08-05
376
    my $rows = $result->fetch_hash_multi(5);
update document
yuki-kimoto authored on 2009-11-19
377
    
removed DESTROY method(not b...
yuki-kimoto authored on 2010-07-18
378
Fetch multiple rows into array of hash
cleanup
yuki-kimoto authored on 2010-08-05
379
Row count must be specified.
update document
yuki-kimoto authored on 2009-11-19
380

            
cleanup
yuki-kimoto authored on 2010-10-17
381
=head2 C<fetch_multi>
packaging one directory
yuki-kimoto authored on 2009-11-16
382

            
cleanup
yuki-kimoto authored on 2010-10-17
383
    my $rows = $result->fetch_multi(5);
384
    
385
Fetch multiple rows into array of array.
386
Row count must be specified.
removed DESTROY method(not b...
yuki-kimoto authored on 2010-07-18
387

            
cleanup
Yuki Kimoto authored on 2010-12-21
388
=head2 C<filter>
389

            
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-17
390
    $result    = $result->filter(title  => 'to_upper_case',
391
                                 author => 'to_upper_case');
392

            
393
Filters.
394
These each filters override the filters applied by C<apply_filter> of
395
L<DBIx::Custom>.
cleanup
Yuki Kimoto authored on 2010-12-21
396

            
packaging one directory
yuki-kimoto authored on 2009-11-16
397
=cut