Newer Older
408 lines | 8.562kb
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

            
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-25
10
__PACKAGE__->attr(
11
    [qw/filters sth/],
12
    stash => sub { {} }
13
);
cleanup
Yuki Kimoto authored on 2010-12-21
14

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

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

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

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
94
    return \@row;
95
}
96

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

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

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

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

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

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

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

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

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

            
cleanup
Yuki Kimoto authored on 2011-01-23
245
# DEPRECATED!
246
__PACKAGE__->attr('filter_check'); 
247

            
update document
yuki-kimoto authored on 2010-01-30
248
1;
249

            
packaging one directory
yuki-kimoto authored on 2009-11-16
250
=head1 NAME
251

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

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

            
256
Get the result of select statement.
257

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

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

            
285
Fetch row into hash.
286

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
313
=head2 C<filters>
314

            
315
    my $filters = $result->filters;
316
    $result     = $result->filters(\%filters);
317

            
318
Resistered filters.
319

            
320
=head2 C<sth>
321

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

            
325
Statement handle of L<DBI>.
326

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

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

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

            
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-25
334
    $result    = $result->end_filter(title  => 'to_something',
335
                                     author => 'to_something');
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-17
336

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
369
Fetch all rows into array of hash.
370

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

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

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

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

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

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

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

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

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

            
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-25
400
=head2 C<(experimental) stash>
401

            
402
    my $stash = $result->stash;
403
    my $foo = $result->stash->{foo};
404
    $result->stash->{foo} = $foo;
405

            
406
Stash is hash reference to save your data.
407

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