Newer Older
416 lines | 8.75kb
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};
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
23

            
24
            if  (exists $filter->{$column}
25
              && defined $fname
26
              && ref $fname ne 'CODE') 
27
            {
many changed
Yuki Kimoto authored on 2011-01-23
28
              croak qq{Filter "$fname" is not registered"}
cleanup
Yuki Kimoto authored on 2010-12-22
29
                unless exists $self->filters->{$fname};
30
              
31
              $filter->{$column} = $self->filters->{$fname};
32
            }
cleanup
Yuki Kimoto authored on 2010-12-21
33
        }
cleanup
Yuki Kimoto authored on 2010-12-22
34
        
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-17
35
        $self->{filter} = {%{$self->filter}, %$filter};
cleanup
Yuki Kimoto authored on 2010-12-22
36
        
37
        return $self;
cleanup
Yuki Kimoto authored on 2010-12-21
38
    }
39
    
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-17
40
    return $self->{filter} ||= {};
41
}
42

            
43
sub end_filter {
44
    my $self = shift;
45
    
46
    if (@_) {
47
        my $end_filter = ref $_[0] eq 'HASH' ? $_[0] : {@_};
48
        
49
        foreach my $column (keys %$end_filter) {
50
            my $fname = $end_filter->{$column};
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
51
            
52
            if  (exists $end_filter->{$column}
53
              && defined $fname
54
              && ref $fname ne 'CODE') 
55
            {
many changed
Yuki Kimoto authored on 2011-01-23
56
              croak qq{Filter "$fname" is not registered"}
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-17
57
                unless exists $self->filters->{$fname};
58
              
59
              $end_filter->{$column} = $self->filters->{$fname};
60
            }
61
        }
62
        
63
        $self->{end_filter} = {%{$self->end_filter}, %$end_filter};
64
        
65
        return $self;
66
    }
67
    
68
    return $self->{end_filter} ||= {};
cleanup
Yuki Kimoto authored on 2010-12-21
69
}
cleanup
yuki-kimoto authored on 2010-01-21
70

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

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
102
    return \@row;
103
}
104

            
cleanup
yuki-kimoto authored on 2010-10-17
105
sub fetch_all {
106
    my $self = shift;
107
    
108
    # Fetch all rows
109
    my $rows = [];
110
    while(my $row = $self->fetch) {
111
        push @$rows, $row;
112
    }
113
    return $rows;
114
}
115

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
116
sub fetch_first {
117
    my $self = shift;
118
    
119
    # Fetch
120
    my $row = $self->fetch;
121
    
cleanup
yuki-kimoto authored on 2010-08-05
122
    # No row
removed reconnect method
yuki-kimoto authored on 2010-05-28
123
    return unless $row;
124
    
125
    # Finish statement handle
126
    $self->sth->finish;
127
    
128
    return $row;
129
}
130

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
166
sub fetch_hash_all {
167
    my $self = shift;
168
    
169
    # Fetch all rows as hash
170
    my $rows = [];
171
    while(my $row = $self->fetch_hash) {
172
        push @$rows, $row;
173
    }
174
    
175
    return $rows;
176
}
177

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
178
sub fetch_hash_first {
packaging one directory
yuki-kimoto authored on 2009-11-16
179
    my $self = shift;
180
    
181
    # Fetch hash
182
    my $row = $self->fetch_hash;
183
    
cleanup
yuki-kimoto authored on 2010-08-05
184
    # No row
packaging one directory
yuki-kimoto authored on 2009-11-16
185
    return unless $row;
186
    
187
    # Finish statement handle
some changed
yuki-kimoto authored on 2010-05-02
188
    $self->sth->finish;
packaging one directory
yuki-kimoto authored on 2009-11-16
189
    
removed reconnect method
yuki-kimoto authored on 2010-05-28
190
    return $row;
packaging one directory
yuki-kimoto authored on 2009-11-16
191
}
192

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

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

            
cleanup
Yuki Kimoto authored on 2011-01-12
231
# Deprecated
232
sub default_filter {
233
    my $self = shift;
234
    
235
    if (@_) {
236
        my $fname = $_[0];
237
        if (@_ && !$fname) {
238
            $self->{default_filter} = undef;
239
        }
240
        else {
many changed
Yuki Kimoto authored on 2011-01-23
241
            croak qq{Filter "$fname" is not registered}
cleanup
Yuki Kimoto authored on 2011-01-12
242
              unless exists $self->filters->{$fname};
243
        
244
            $self->{default_filter} = $self->filters->{$fname};
245
        }
246
        
247
        return $self;
248
    }
249
    
250
    return $self->{default_filter};
251
}
252

            
cleanup
Yuki Kimoto authored on 2011-01-23
253
# DEPRECATED!
254
__PACKAGE__->attr('filter_check'); 
255

            
update document
yuki-kimoto authored on 2010-01-30
256
1;
257

            
packaging one directory
yuki-kimoto authored on 2009-11-16
258
=head1 NAME
259

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

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

            
264
Get the result of select statement.
265

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

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

            
293
Fetch row into hash.
294

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
321
=head2 C<filters>
322

            
323
    my $filters = $result->filters;
324
    $result     = $result->filters(\%filters);
325

            
326
Resistered filters.
327

            
328
=head2 C<sth>
329

            
330
    my $sth = $reuslt->sth
331
    $result = $result->sth($sth);
332

            
333
Statement handle of L<DBI>.
334

            
update document
yuki-kimoto authored on 2010-01-30
335
=head1 METHODS
336

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

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

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

            
345
End filters.
346
These each filters is executed after the filters applied by C<apply_filter> of
347
L<DBIx::Custom> or C<filter> method.
348

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

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

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

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
361
=head2 C<fetch_first>
362

            
363
    my $row = $result->fetch_first;
364

            
365
Fetch only a first row into array and finish statment handle.
366

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
373
=head2 C<fetch_hash_all>
374

            
375
    my $rows = $result->fetch_hash_all;
376

            
377
Fetch all rows into array of hash.
378

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

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

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
394
    my $rows = $result->fetch_multi(5);
395
    
396
Fetch multiple rows into array of array.
397
Row count must be specified.
removed DESTROY method(not b...
yuki-kimoto authored on 2010-07-18
398

            
cleanup
Yuki Kimoto authored on 2010-12-21
399
=head2 C<filter>
400

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

            
404
Filters.
405
These each filters override the filters applied by C<apply_filter> of
406
L<DBIx::Custom>.
cleanup
Yuki Kimoto authored on 2010-12-21
407

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

            
410
    my $stash = $result->stash;
411
    my $foo = $result->stash->{foo};
412
    $result->stash->{foo} = $foo;
413

            
414
Stash is hash reference to save your data.
415

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