Newer Older
408 lines | 8.623kb
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 2010-12-21
10
__PACKAGE__->attr([qw/filter_check filters sth/]);
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') {
21
              croak qq{"$fname" is not registered"}
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') {
45
              croak qq{"$fname" is not registered"}
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 {
230
            croak qq{"$fname" is not registered}
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

            
update document
yuki-kimoto authored on 2010-01-30
242
1;
243

            
packaging one directory
yuki-kimoto authored on 2009-11-16
244
=head1 NAME
245

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

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

            
250
Get the result of select statement.
251

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

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

            
279
Fetch row into hash.
280

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
307
=head2 C<filters>
308

            
309
    my $filters = $result->filters;
310
    $result     = $result->filters(\%filters);
311

            
312
Resistered filters.
313

            
314
=head2 C<filter_check>
315

            
316
    my $filter_check = $result->filter_check;
317
    $result          = $result->filter_check;
318

            
319
Enable filter validation.
320

            
321
=head2 C<sth>
322

            
323
    my $sth = $reuslt->sth
324
    $result = $result->sth($sth);
325

            
326
Statement handle of L<DBI>.
327

            
update document
yuki-kimoto authored on 2010-01-30
328
=head1 METHODS
329

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

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

            
335
    $result    = $result->end_filter(title  => 'to_upper_case',
336
                                     author => 'to_upper_case');
337

            
338
End filters.
339
These each filters is executed after the filters applied by C<apply_filter> of
340
L<DBIx::Custom> or C<filter> method.
341

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

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

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

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
354
=head2 C<fetch_first>
355

            
356
    my $row = $result->fetch_first;
357

            
358
Fetch only a first row into array and finish statment handle.
359

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
366
=head2 C<fetch_hash_all>
367

            
368
    my $rows = $result->fetch_hash_all;
369

            
370
Fetch all rows into array of hash.
371

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

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

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

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

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

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

            
cleanup
Yuki Kimoto authored on 2010-12-21
392
=head2 C<filter>
393

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

            
397
Filters.
398
These each filters override the filters applied by C<apply_filter> of
399
L<DBIx::Custom>.
cleanup
Yuki Kimoto authored on 2010-12-21
400

            
cleanup
Yuki Kimoto authored on 2011-01-12
401
=head2 C<(deprecated) default_filter>
402

            
403
    my $default_filter = $result->default_filter;
404
    $result = $result->default_filter($filter);
405

            
406
Default filter when a row is fetched.
407

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