... | ... |
@@ -1,3 +1,5 @@ |
1 |
+0.1636 |
|
2 |
+ added tests and cleanup |
|
1 | 3 |
0.1635 |
2 | 4 |
renamed iterate_all_columns to each_column |
3 | 5 |
0.1634 |
... | ... |
@@ -1,6 +1,6 @@ |
1 | 1 |
package DBIx::Custom; |
2 | 2 |
|
3 |
-our $VERSION = '0.1635'; |
|
3 |
+our $VERSION = '0.1636'; |
|
4 | 4 |
|
5 | 5 |
use 5.008001; |
6 | 6 |
use strict; |
... | ... |
@@ -20,17 +20,36 @@ __PACKAGE__->attr( |
20 | 20 |
[qw/data_source dbh password user/], |
21 | 21 |
dbi_options => sub { {} }, |
22 | 22 |
cache => 1, |
23 |
+ filter_check => 1, |
|
24 |
+ query_builder => sub {DBIx::Custom::QueryBuilder->new}, |
|
25 |
+ result_class => 'DBIx::Custom::Result', |
|
26 |
+ table_class => 'DBIx::Custom::Table' |
|
27 |
+); |
|
28 |
+ |
|
29 |
+__PACKAGE__->attr( |
|
30 |
+ cache_method => sub { |
|
31 |
+ sub { |
|
32 |
+ my $self = shift; |
|
33 |
+ |
|
34 |
+ $self->{_cached} ||= {}; |
|
35 |
+ |
|
36 |
+ if (@_ > 1) { |
|
37 |
+ $self->{_cached}{$_[0]} = $_[1] |
|
38 |
+ } |
|
39 |
+ else { |
|
40 |
+ return $self->{_cached}{$_[0]} |
|
41 |
+ } |
|
42 |
+ } |
|
43 |
+ } |
|
44 |
+); |
|
45 |
+ |
|
46 |
+__PACKAGE__->attr( |
|
23 | 47 |
filters => sub { |
24 | 48 |
{ |
25 | 49 |
encode_utf8 => sub { encode_utf8($_[0]) }, |
26 | 50 |
decode_utf8 => sub { decode_utf8($_[0]) } |
27 | 51 |
} |
28 |
- }, |
|
29 |
- |
|
30 |
- filter_check => 1, |
|
31 |
- query_builder => sub {DBIx::Custom::QueryBuilder->new}, |
|
32 |
- result_class => 'DBIx::Custom::Result', |
|
33 |
- table_class => 'DBIx::Custom::Table' |
|
52 |
+ } |
|
34 | 53 |
); |
35 | 54 |
|
36 | 55 |
# DBI methods |
... | ... |
@@ -64,71 +83,67 @@ sub AUTOLOAD { |
64 | 83 |
} |
65 | 84 |
|
66 | 85 |
sub apply_filter { |
67 |
- my $self = shift; |
|
68 |
- |
|
86 |
+ my ($self, $table, @cinfos) = @_; |
|
87 |
+ |
|
88 |
+ # Initialize filters |
|
69 | 89 |
$self->{filter} ||= {}; |
90 |
+ $self->{filter}{out} ||= {}; |
|
91 |
+ $self->{filter}{in} ||= {}; |
|
70 | 92 |
|
71 |
- # Table and column informations |
|
72 |
- my ($table, @cs) = @_; |
|
73 |
- |
|
74 |
- if (@cs) { |
|
93 |
+ # Create filters |
|
94 |
+ my $usage = "Usage: \$dbi->apply_filter(" . |
|
95 |
+ "TABLE, COLUMN1, {in => INFILTER1, out => OUTFILTER1}, " . |
|
96 |
+ "COLUMN2, {in => INFILTER2, out => OUTFILTER2}, ...)"; |
|
97 |
+ |
|
98 |
+ for (my $i = 0; $i < @cinfos; $i += 2) { |
|
75 | 99 |
|
76 |
- # Initialize filters |
|
77 |
- $self->{filter}{out} ||= {}; |
|
78 |
- $self->{filter}{in} ||= {}; |
|
100 |
+ # Column |
|
101 |
+ my $column = $cinfos[$i]; |
|
79 | 102 |
|
80 |
- # Create filters |
|
81 |
- for (my $i = 0; $i < @cs; $i += 2) { |
|
82 |
- |
|
83 |
- # Column |
|
84 |
- my $column = $cs[$i]; |
|
85 |
- |
|
86 |
- # Filter |
|
87 |
- my $filter = $cs[$i + 1] || {}; |
|
88 |
- my $in_filter = delete $filter->{in}; |
|
89 |
- my $out_filter = delete $filter->{out}; |
|
90 |
- croak "Usage \$dbi->apply_filter(" . |
|
91 |
- "TABLE, COLUMN, {in => INFILTER, out => OUTFILTER}, ...)" |
|
92 |
- if ref $filter ne 'HASH' || keys %$filter; |
|
93 |
- |
|
94 |
- # Out filter |
|
95 |
- if (ref $out_filter eq 'CODE') { |
|
96 |
- $self->{filter}{out}{$table}{$column} |
|
97 |
- = $out_filter; |
|
98 |
- $self->{filter}{out}{$table}{"$table.$column"} |
|
99 |
- = $out_filter; |
|
100 |
- } |
|
101 |
- elsif (defined $out_filter) { |
|
102 |
- croak qq{"$out_filter" is not registered} |
|
103 |
- unless exists $self->filters->{$out_filter}; |
|
104 |
- |
|
105 |
- $self->{filter}{out}{$table}{$column} |
|
106 |
- = $self->filters->{$out_filter}; |
|
107 |
- $self->{filter}{out}{$table}{"$table.$column"} |
|
108 |
- = $self->filters->{$out_filter}; |
|
109 |
- } |
|
103 |
+ # Filter |
|
104 |
+ my $filter = $cinfos[$i + 1] || {}; |
|
105 |
+ croak $usage unless ref $filter eq 'HASH'; |
|
106 |
+ foreach my $ftype (keys %$filter) { |
|
107 |
+ croak $usage unless $ftype eq 'in' || $ftype eq 'out'; |
|
108 |
+ } |
|
109 |
+ my $in_filter = $filter->{in}; |
|
110 |
+ my $out_filter = $filter->{out}; |
|
111 |
+ |
|
112 |
+ # Out filter |
|
113 |
+ if (ref $out_filter eq 'CODE') { |
|
114 |
+ $self->{filter}{out}{$table}{$column} |
|
115 |
+ = $out_filter; |
|
116 |
+ $self->{filter}{out}{$table}{"$table.$column"} |
|
117 |
+ = $out_filter; |
|
118 |
+ } |
|
119 |
+ elsif (defined $out_filter) { |
|
120 |
+ croak qq{Filter "$out_filter" is not registered} |
|
121 |
+ unless exists $self->filters->{$out_filter}; |
|
110 | 122 |
|
111 |
- # In filter |
|
112 |
- if (ref $in_filter eq 'CODE') { |
|
113 |
- $self->{filter}{in}{$table}{$column} |
|
114 |
- = $in_filter; |
|
115 |
- $self->{filter}{in}{$table}{"$table.$column"} |
|
116 |
- = $in_filter; |
|
117 |
- } |
|
118 |
- elsif (defined $in_filter) { |
|
119 |
- croak qq{"$in_filter" is not registered} |
|
120 |
- unless exists $self->filters->{$in_filter}; |
|
121 |
- $self->{filter}{in}{$table}{$column} |
|
122 |
- = $self->filters->{$in_filter}; |
|
123 |
- $self->{filter}{in}{$table}{"$table.$column"} |
|
124 |
- = $self->filters->{$in_filter}; |
|
125 |
- } |
|
123 |
+ $self->{filter}{out}{$table}{$column} |
|
124 |
+ = $self->filters->{$out_filter}; |
|
125 |
+ $self->{filter}{out}{$table}{"$table.$column"} |
|
126 |
+ = $self->filters->{$out_filter}; |
|
126 | 127 |
} |
127 | 128 |
|
128 |
- return $self; |
|
129 |
+ # In filter |
|
130 |
+ if (ref $in_filter eq 'CODE') { |
|
131 |
+ $self->{filter}{in}{$table}{$column} |
|
132 |
+ = $in_filter; |
|
133 |
+ $self->{filter}{in}{$table}{"$table.$column"} |
|
134 |
+ = $in_filter; |
|
135 |
+ } |
|
136 |
+ elsif (defined $in_filter) { |
|
137 |
+ croak qq{Filter "$in_filter" is not registered} |
|
138 |
+ unless exists $self->filters->{$in_filter}; |
|
139 |
+ $self->{filter}{in}{$table}{$column} |
|
140 |
+ = $self->filters->{$in_filter}; |
|
141 |
+ $self->{filter}{in}{$table}{"$table.$column"} |
|
142 |
+ = $self->filters->{$in_filter}; |
|
143 |
+ } |
|
129 | 144 |
} |
130 | 145 |
|
131 |
- return $self->{filter}; |
|
146 |
+ return $self; |
|
132 | 147 |
} |
133 | 148 |
|
134 | 149 |
sub helper { |
... | ... |
@@ -142,35 +157,12 @@ sub helper { |
142 | 157 |
} |
143 | 158 |
|
144 | 159 |
sub connect { |
145 |
- my $proto = shift; |
|
160 |
+ my $self = ref $_[0] ? shift : shift->SUPER::new(@_);; |
|
146 | 161 |
|
147 |
- my $self; |
|
148 |
- # Create |
|
149 |
- if (my $class = ref $proto) { |
|
150 |
- my $args = ref $_[0] eq 'HASH' ? $_[0] : {@_}; |
|
151 |
- $self = $proto; |
|
152 |
- |
|
153 |
- foreach my $attr (keys %$args) { |
|
154 |
- $self->{$attr} = $args->{$attr}; |
|
155 |
- } |
|
156 |
- |
|
157 |
- # Check attribute names |
|
158 |
- my @attrs = keys %$self; |
|
159 |
- foreach my $attr (@attrs) { |
|
160 |
- croak qq{"$attr" is invalid attribute name} |
|
161 |
- unless $self->can($attr); |
|
162 |
- } |
|
163 |
- } |
|
164 |
- else { |
|
165 |
- $self = $proto->SUPER::new(@_); |
|
166 |
- } |
|
167 |
- |
|
168 |
- # Information |
|
162 |
+ # Attributes |
|
169 | 163 |
my $data_source = $self->data_source; |
170 |
- |
|
171 |
- croak qq{"data_source" must be specified to connect method"} |
|
164 |
+ croak qq{"data_source" must be specified to connect()"} |
|
172 | 165 |
unless $data_source; |
173 |
- |
|
174 | 166 |
my $user = $self->user; |
175 | 167 |
my $password = $self->password; |
176 | 168 |
my $dbi_options = $self->dbi_options || {}; |
... | ... |
@@ -333,7 +325,7 @@ sub execute{ |
333 | 325 |
$f->{$column} = undef; |
334 | 326 |
} |
335 | 327 |
elsif (ref $fname ne 'CODE') { |
336 |
- croak qq{"$fname" is not registered"} |
|
328 |
+ croak qq{Filter "$fname" is not registered"} |
|
337 | 329 |
unless exists $self->filters->{$fname}; |
338 | 330 |
|
339 | 331 |
$f->{$column} = $self->filters->{$fname}; |
... | ... |
@@ -739,22 +731,6 @@ sub _croak { |
739 | 731 |
} |
740 | 732 |
} |
741 | 733 |
|
742 |
-# Deprecated |
|
743 |
-__PACKAGE__->attr(cache_method => sub { |
|
744 |
- sub { |
|
745 |
- my $self = shift; |
|
746 |
- |
|
747 |
- $self->{_cached} ||= {}; |
|
748 |
- |
|
749 |
- if (@_ > 1) { |
|
750 |
- $self->{_cached}{$_[0]} = $_[1] |
|
751 |
- } |
|
752 |
- else { |
|
753 |
- return $self->{_cached}{$_[0]} |
|
754 |
- } |
|
755 |
- } |
|
756 |
-}); |
|
757 |
- |
|
758 | 734 |
sub default_bind_filter { |
759 | 735 |
my $self = shift; |
760 | 736 |
|
... | ... |
@@ -765,7 +741,7 @@ sub default_bind_filter { |
765 | 741 |
$self->{default_out_filter} = undef; |
766 | 742 |
} |
767 | 743 |
else { |
768 |
- croak qq{"$fname" is not registered} |
|
744 |
+ croak qq{Filter "$fname" is not registered} |
|
769 | 745 |
unless exists $self->filters->{$fname}; |
770 | 746 |
|
771 | 747 |
$self->{default_out_filter} = $self->filters->{$fname}; |
... | ... |
@@ -778,14 +754,15 @@ sub default_bind_filter { |
778 | 754 |
|
779 | 755 |
sub default_fetch_filter { |
780 | 756 |
my $self = shift; |
781 |
- my $fname = $_[0]; |
|
782 | 757 |
|
783 | 758 |
if (@_) { |
759 |
+ my $fname = $_[0]; |
|
760 |
+ |
|
784 | 761 |
if (@_ && !$fname) { |
785 | 762 |
$self->{default_in_filter} = undef; |
786 | 763 |
} |
787 | 764 |
else { |
788 |
- croak qq{"$fname" is not registered} |
|
765 |
+ croak qq{Filter "$fname" is not registered} |
|
789 | 766 |
unless exists $self->filters->{$fname}; |
790 | 767 |
|
791 | 768 |
$self->{default_in_filter} = $self->filters->{$fname}; |
... | ... |
@@ -794,7 +771,7 @@ sub default_fetch_filter { |
794 | 771 |
return $self; |
795 | 772 |
} |
796 | 773 |
|
797 |
- return $self->{default_in_filter} |
|
774 |
+ return $self->{default_in_filter}; |
|
798 | 775 |
} |
799 | 776 |
|
800 | 777 |
1; |
... | ... |
@@ -1433,18 +1410,6 @@ B<Example:> |
1433 | 1410 |
|
1434 | 1411 |
Create a new L<DBIx::Custom::Where> object. |
1435 | 1412 |
|
1436 |
-=head2 C<(deprecated) default_bind_filter> |
|
1437 |
- |
|
1438 |
- my $default_bind_filter = $dbi->default_bind_filter; |
|
1439 |
- $dbi = $dbi->default_bind_filter($fname); |
|
1440 |
- |
|
1441 |
-Default filter when parameter binding is executed. |
|
1442 |
- |
|
1443 |
-=head2 C<(deprecated) default_fetch_filter> |
|
1444 |
- |
|
1445 |
- my $default_fetch_filter = $dbi->default_fetch_filter; |
|
1446 |
- $dbi = $dbi->default_fetch_filter($fname); |
|
1447 |
- |
|
1448 | 1413 |
=head2 C<(deprecated) cache_method> |
1449 | 1414 |
|
1450 | 1415 |
$dbi = $dbi->cache_method(\&cache_method); |
... | ... |
@@ -355,50 +355,6 @@ This is overwrite applied filter. |
355 | 355 |
|
356 | 356 |
B<Filter examples> |
357 | 357 |
|
358 |
-MySQL |
|
359 |
- |
|
360 |
- # Time::Piece object to DATETIME format |
|
361 |
- tp_to_datetime => sub { |
|
362 |
- return shift->strftime('%Y-%m-%d %H:%M:%S'); |
|
363 |
- } |
|
364 |
- |
|
365 |
- # Time::Piece object to DATE format |
|
366 |
- tp_to_date => sub { |
|
367 |
- return shift->strftime('%Y-%m-%d'); |
|
368 |
- }, |
|
369 |
- |
|
370 |
- # DATETIME to Time::Piece object |
|
371 |
- datetime_to_tp => sub { |
|
372 |
- return Time::Piece->strptime(shift, '%Y-%m-%d %H:%M:%S'); |
|
373 |
- } |
|
374 |
- |
|
375 |
- # DATE to Time::Piece object |
|
376 |
- date_to_tp => sub { |
|
377 |
- return Time::Piece->strptime(shift, '%Y-%m-%d'); |
|
378 |
- } |
|
379 |
- |
|
380 |
-SQLite |
|
381 |
- |
|
382 |
- # Time::Piece object to DATETIME format |
|
383 |
- tp_to_datetime => sub { |
|
384 |
- return shift->strftime('%Y-%m-%d %H:%M:%S'); |
|
385 |
- } |
|
386 |
- |
|
387 |
- # Time::Piece object to DATE format |
|
388 |
- tp_to_date => sub { |
|
389 |
- return shift->strftime('%Y-%m-%d'); |
|
390 |
- }, |
|
391 |
- |
|
392 |
- # DATETIME to Time::Piece object |
|
393 |
- datetime_to_tp => sub { |
|
394 |
- return Time::Piece->strptime(shift, '%Y-%m-%d %H:%M:%S'); |
|
395 |
- } |
|
396 |
- |
|
397 |
- # DATE to Time::Piece object |
|
398 |
- date_to_tp => sub { |
|
399 |
- return Time::Piece->strptime(shift, '%Y-%m-%d'); |
|
400 |
- } |
|
401 |
- |
|
402 | 358 |
=head2 6.Create table object |
403 | 359 |
|
404 | 360 |
You can create table object which have methods. |
... | ... |
@@ -542,38 +498,4 @@ These method can be called from L<DBIx::Custom> object directory. |
542 | 498 |
|
543 | 499 |
L<DBIx::Custom Wiki|https://github.com/yuki-kimoto/DBIx-Custom/wiki> - Many useful examples |
544 | 500 |
|
545 |
-=head3 Limit clause |
|
546 |
- |
|
547 |
- # {limit COUNT OFFSET} |
|
548 |
- select * from book {limit 1 0}; |
|
549 |
- |
|
550 |
-SQLite |
|
551 |
- |
|
552 |
- $dbi->register_tag_processor( |
|
553 |
- limit => sub { |
|
554 |
- my ($count, $offset) = @_; |
|
555 |
- |
|
556 |
- my $s = ''; |
|
557 |
- $s .= "limit $count"; |
|
558 |
- $s .= " offset $offset" if defined $offset; |
|
559 |
- |
|
560 |
- return [$s, []]; |
|
561 |
- } |
|
562 |
- ); |
|
563 |
- |
|
564 |
-MySQL |
|
565 |
- |
|
566 |
- $dbi->register_tag_processor( |
|
567 |
- limit => sub { |
|
568 |
- my ($count, $offset) = @_; |
|
569 |
- |
|
570 |
- my $s = ''; |
|
571 |
- $offset = 0 unless defined $offset; |
|
572 |
- $s .= "limit $offset"; |
|
573 |
- $s .= ", $count"; |
|
574 |
- |
|
575 |
- return [$s, []]; |
|
576 |
- } |
|
577 |
- ); |
|
578 |
- |
|
579 | 501 |
=cut |
... | ... |
@@ -569,52 +569,6 @@ C<delete()>、C<select()> |
569 | 569 |
filter => {title => 'encode_utf8'} |
570 | 570 |
); |
571 | 571 |
|
572 |
-B<フィルタのサンプル> |
|
573 |
- |
|
574 |
-MySQL |
|
575 |
- |
|
576 |
- # Time::Piece object to DATETIME format |
|
577 |
- tp_to_datetime => sub { |
|
578 |
- return shift->strftime('%Y-%m-%d %H:%M:%S'); |
|
579 |
- } |
|
580 |
- |
|
581 |
- # Time::Piece object to DATE format |
|
582 |
- tp_to_date => sub { |
|
583 |
- return shift->strftime('%Y-%m-%d'); |
|
584 |
- } |
|
585 |
- |
|
586 |
- # DATETIME to Time::Piece object |
|
587 |
- datetime_to_tp => sub { |
|
588 |
- return Time::Piece->strptime(shift, '%Y-%m-%d %H:%M:%S'); |
|
589 |
- } |
|
590 |
- |
|
591 |
- # DATE to Time::Piece object |
|
592 |
- date_to_tp => sub { |
|
593 |
- return Time::Piece->strptime(shift, '%Y-%m-%d'); |
|
594 |
- } |
|
595 |
- |
|
596 |
-SQLite |
|
597 |
- |
|
598 |
- # Time::Piece object to DATETIME format |
|
599 |
- tp_to_datetime => sub { |
|
600 |
- return shift->strftime('%Y-%m-%d %H:%M:%S'); |
|
601 |
- } |
|
602 |
- |
|
603 |
- # Time::Piece object to DATE format |
|
604 |
- tp_to_date => sub { |
|
605 |
- return shift->strftime('%Y-%m-%d'); |
|
606 |
- } |
|
607 |
- |
|
608 |
- # DATETIME to Time::Piece object |
|
609 |
- datetime_to_tp => sub { |
|
610 |
- return Time::Piece->strptime(shift, '%Y-%m-%d %H:%M:%S'); |
|
611 |
- } |
|
612 |
- |
|
613 |
- # DATE to Time::Piece object |
|
614 |
- date_to_tp => sub { |
|
615 |
- return Time::Piece->strptime(shift, '%Y-%m-%d'); |
|
616 |
- } |
|
617 |
- |
|
618 | 572 |
=head3 行のフェッチ時のフィルタリング |
619 | 573 |
|
620 | 574 |
行をフェッチするときのフィルタも設定することができます。 |
... | ... |
@@ -36,8 +36,8 @@ DBIx::Custom::MySQL - DEPRECATED! |
36 | 36 |
|
37 | 37 |
=head1 CAUTION |
38 | 38 |
|
39 |
-B<This module is deprecated now> because This module is not very useful |
|
40 |
-I expected. Please use DBIx::Custom instead.> |
|
39 |
+B<This module is deprecated now> because This module is less useful |
|
40 |
+than I expected. Please use DBIx::Custom instead.> |
|
41 | 41 |
|
42 | 42 |
=head1 SYNOPSYS |
43 | 43 |
|
... | ... |
@@ -18,7 +18,7 @@ sub filter { |
18 | 18 |
foreach my $column (keys %$filter) { |
19 | 19 |
my $fname = $filter->{$column}; |
20 | 20 |
unless (ref $fname eq 'CODE') { |
21 |
- croak qq{"$fname" is not registered"} |
|
21 |
+ croak qq{Filter "$fname" is not registered"} |
|
22 | 22 |
unless exists $self->filters->{$fname}; |
23 | 23 |
|
24 | 24 |
$filter->{$column} = $self->filters->{$fname}; |
... | ... |
@@ -42,7 +42,7 @@ sub end_filter { |
42 | 42 |
foreach my $column (keys %$end_filter) { |
43 | 43 |
my $fname = $end_filter->{$column}; |
44 | 44 |
unless (ref $fname eq 'CODE') { |
45 |
- croak qq{"$fname" is not registered"} |
|
45 |
+ croak qq{Filter "$fname" is not registered"} |
|
46 | 46 |
unless exists $self->filters->{$fname}; |
47 | 47 |
|
48 | 48 |
$end_filter->{$column} = $self->filters->{$fname}; |
... | ... |
@@ -227,7 +227,7 @@ sub default_filter { |
227 | 227 |
$self->{default_filter} = undef; |
228 | 228 |
} |
229 | 229 |
else { |
230 |
- croak qq{"$fname" is not registered} |
|
230 |
+ croak qq{Filter "$fname" is not registered} |
|
231 | 231 |
unless exists $self->filters->{$fname}; |
232 | 232 |
|
233 | 233 |
$self->{default_filter} = $self->filters->{$fname}; |
... | ... |
@@ -398,11 +398,4 @@ Filters. |
398 | 398 |
These each filters override the filters applied by C<apply_filter> of |
399 | 399 |
L<DBIx::Custom>. |
400 | 400 |
|
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 |
- |
|
408 | 401 |
=cut |
... | ... |
@@ -42,8 +42,8 @@ DBIx::Custom::SQLite - DEPRECATED! |
42 | 42 |
|
43 | 43 |
=head1 CAUTION |
44 | 44 |
|
45 |
-B<This module is deprecated now> because This module is not very useful |
|
46 |
-I expected. Please use DBIx::Custom instead.> |
|
45 |
+B<This module is deprecated now> because This module is less useful |
|
46 |
+than I expected. Please use DBIx::Custom instead.> |
|
47 | 47 |
|
48 | 48 |
=head1 SYNOPSYS |
49 | 49 |
|
... | ... |
@@ -42,6 +42,7 @@ sub helper { |
42 | 42 |
sub new { |
43 | 43 |
my $self = shift->SUPER::new(@_); |
44 | 44 |
|
45 |
+ # Methods |
|
45 | 46 |
my @methods = qw/insert update update_all delete delete_all select/; |
46 | 47 |
foreach my $method (@methods) { |
47 | 48 |
$self->helper( |
... | ... |
@@ -51,6 +52,7 @@ sub new { |
51 | 52 |
} |
52 | 53 |
); |
53 | 54 |
} |
55 |
+ |
|
54 | 56 |
return $self; |
55 | 57 |
} |
56 | 58 |
|
... | ... |
@@ -22,47 +22,57 @@ __PACKAGE__->attr( |
22 | 22 |
sub to_string { |
23 | 23 |
my $self = shift; |
24 | 24 |
|
25 |
+ # Clause |
|
25 | 26 |
my $clause = $self->clause; |
26 | 27 |
$clause = ['and', $clause] unless ref $clause eq 'ARRAY'; |
27 | 28 |
$clause->[0] = 'and' unless @$clause; |
28 | 29 |
|
30 |
+ # Parse |
|
29 | 31 |
my $where = []; |
30 | 32 |
my $count = {}; |
31 |
- $self->_forward($clause, $where, $count, 'and'); |
|
32 |
- |
|
33 |
- unshift @$where, 'where' if @$where; |
|
33 |
+ $self->_parse($clause, $where, $count, 'and'); |
|
34 | 34 |
|
35 |
+ # Stringify |
|
36 |
+ unshift @$where, 'where' if @$where; |
|
35 | 37 |
return join(' ', @$where); |
36 | 38 |
} |
37 | 39 |
|
38 | 40 |
our %VALID_OPERATIONS = map { $_ => 1 } qw/and or/; |
39 | 41 |
|
40 |
-sub _forward { |
|
42 |
+sub _parse { |
|
41 | 43 |
my ($self, $clause, $where, $count, $op) = @_; |
42 | 44 |
|
45 |
+ # Array |
|
43 | 46 |
if (ref $clause eq 'ARRAY') { |
47 |
+ |
|
48 |
+ # Start |
|
44 | 49 |
push @$where, '('; |
45 | 50 |
|
51 |
+ # Operation |
|
46 | 52 |
my $op = $clause->[0] || ''; |
47 |
- |
|
48 | 53 |
croak qq{"$op" is invalid operation} |
49 | 54 |
unless $VALID_OPERATIONS{$op}; |
50 |
- |
|
55 |
+ |
|
56 |
+ # Parse internal clause |
|
51 | 57 |
for (my $i = 1; $i < @$clause; $i++) { |
52 |
- my $pushed = $self->_forward($clause->[$i], $where, $count, $op); |
|
58 |
+ my $pushed = $self->_parse($clause->[$i], $where, $count, $op); |
|
53 | 59 |
push @$where, $op if $pushed; |
54 | 60 |
} |
55 |
- |
|
56 | 61 |
pop @$where if $where->[-1] eq $op; |
57 | 62 |
|
63 |
+ # Undo |
|
58 | 64 |
if ($where->[-1] eq '(') { |
59 | 65 |
pop @$where; |
60 | 66 |
pop @$where; |
61 | 67 |
} |
68 |
+ |
|
69 |
+ # End |
|
62 | 70 |
else { |
63 | 71 |
push @$where, ')'; |
64 | 72 |
} |
65 | 73 |
} |
74 |
+ |
|
75 |
+ # String |
|
66 | 76 |
else { |
67 | 77 |
|
68 | 78 |
# Column |
... | ... |
@@ -71,11 +81,11 @@ sub _forward { |
71 | 81 |
unless @$columns == 1; |
72 | 82 |
my $column = $columns->[0]; |
73 | 83 |
|
74 |
- # Count up |
|
84 |
+ # Column count up |
|
75 | 85 |
my $count = ++$count->{$column}; |
76 | 86 |
|
77 |
- # Push element |
|
78 |
- my $param = $self->param; |
|
87 |
+ # Push |
|
88 |
+ my $param = $self->param; |
|
79 | 89 |
my $pushed; |
80 | 90 |
if (exists $param->{$column}) { |
81 | 91 |
if (ref $param->{$column} eq 'ARRAY') { |
... | ... |
@@ -85,7 +95,6 @@ sub _forward { |
85 | 95 |
$pushed = 1; |
86 | 96 |
} |
87 | 97 |
} |
88 |
- |
|
89 | 98 |
push @$where, $clause if $pushed; |
90 | 99 |
|
91 | 100 |
return $pushed; |
... | ... |
@@ -100,9 +109,7 @@ DBIx::Custom::Where - Where clause |
100 | 109 |
|
101 | 110 |
=head1 SYNOPSYS |
102 | 111 |
|
103 |
- $where = DBIx::Custom::Where->new; |
|
104 |
- |
|
105 |
- my $sql = "select * from book $where"; |
|
112 |
+ my $where = DBIx::Custom::Where->new; |
|
106 | 113 |
|
107 | 114 |
=head1 ATTRIBUTES |
108 | 115 |
|
... | ... |
@@ -120,7 +127,10 @@ DBIx::Custom::Where - Where clause |
120 | 127 |
['and', '{= title}', ['or', '{< date}', '{> date}']] |
121 | 128 |
); |
122 | 129 |
|
123 |
-Where clause. |
|
130 |
+Where clause. Above one is expanded to the following SQL by to_string |
|
131 |
+If all parameter names is exists. |
|
132 |
+ |
|
133 |
+ "where ( {= title} and ( {< date} or {> date} ) )" |
|
124 | 134 |
|
125 | 135 |
=head2 C<to_string> |
126 | 136 |
|
... | ... |
@@ -268,7 +268,7 @@ $dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2, key3 => 3, key4 |
268 | 268 |
$dbi->insert(table => 'table1', param => {key1 => 6, key2 => 7, key3 => 8, key4 => 9, key5 => 10}); |
269 | 269 |
$dbi->register_filter(twice => sub { $_[0] * 2 }); |
270 | 270 |
$dbi->update(table => 'table1', param => {key2 => 11}, where => {key1 => 1}, |
271 |
- filter => {key2 => 'twice'}); |
|
271 |
+ filter => {key2 => sub { $_[0] * 2 }}); |
|
272 | 272 |
$result = $dbi->execute($SELECT_SOURCES->{0}); |
273 | 273 |
$rows = $result->fetch_hash_all; |
274 | 274 |
is_deeply($rows, [{key1 => 1, key2 => 22, key3 => 3, key4 => 4, key5 => 5}, |
... | ... |
@@ -707,6 +707,14 @@ $dbi->table('table2', ppp => sub { |
707 | 707 |
}); |
708 | 708 |
is($dbi->table('table2')->ppp, 'table2', "$test : helper"); |
709 | 709 |
|
710 |
+$dbi->table('table2', {qqq => sub { |
|
711 |
+ my $self = shift; |
|
712 |
+ |
|
713 |
+ return $self->name; |
|
714 |
+}}); |
|
715 |
+is($dbi->table('table2')->qqq, 'table2', "$test : helper"); |
|
716 |
+ |
|
717 |
+ |
|
710 | 718 |
test 'limit'; |
711 | 719 |
$dbi = DBIx::Custom->connect($NEW_ARGS->{0}); |
712 | 720 |
$dbi->execute($CREATE_TABLE->{0}); |
... | ... |
@@ -782,9 +790,10 @@ $result->end_filter(key1 => sub { $_[0] * 3 }, key2 => sub { $_[0] * 5 }); |
782 | 790 |
$row = $result->fetch_first; |
783 | 791 |
is_deeply($row, [6, 40]); |
784 | 792 |
|
793 |
+$dbi->register_filter(five_times => sub { $_[0] * 5 }); |
|
785 | 794 |
$result = $dbi->select(table => 'table1'); |
786 | 795 |
$result->filter(key1 => sub { $_[0] * 2 }, key2 => sub { $_[0] * 4 }); |
787 |
-$result->end_filter(key1 => sub { $_[0] * 3 }, key2 => sub { $_[0] * 5 }); |
|
796 |
+$result->end_filter({key1 => sub { $_[0] * 3 }, key2 => 'five_times' }); |
|
788 | 797 |
$row = $result->fetch_hash_first; |
789 | 798 |
is_deeply($row, {key1 => 6, key2 => 40}); |
790 | 799 |
|
... | ... |
@@ -911,6 +920,22 @@ $result = $dbi->select( |
911 | 920 |
$row = $result->fetch_hash_all; |
912 | 921 |
is_deeply($row, [{key1 => 1, key2 => 2}]); |
913 | 922 |
|
923 |
+$where = $dbi->where |
|
924 |
+ ->clause('{= key1}') |
|
925 |
+ ->param({key1 => 1}); |
|
926 |
+$result = $dbi->select( |
|
927 |
+ table => 'table1', |
|
928 |
+ where => $where, |
|
929 |
+); |
|
930 |
+$row = $result->fetch_hash_all; |
|
931 |
+is_deeply($row, [{key1 => 1, key2 => 2}]); |
|
932 |
+ |
|
933 |
+$where = $dbi->where |
|
934 |
+ ->clause('{= key1} {= key2}') |
|
935 |
+ ->param({key1 => 1}); |
|
936 |
+eval{$where->to_string}; |
|
937 |
+like($@, qr/one column/); |
|
938 |
+ |
|
914 | 939 |
test 'dbi_options default'; |
915 | 940 |
$dbi = DBIx::Custom->new; |
916 | 941 |
is_deeply($dbi->dbi_options, {}); |
... | ... |
@@ -932,3 +957,93 @@ eval {$dbi->delete}; |
932 | 957 |
like($@, qr/table/); |
933 | 958 |
eval {$dbi->select}; |
934 | 959 |
like($@, qr/table/); |
960 |
+ |
|
961 |
+ |
|
962 |
+test 'more tests'; |
|
963 |
+$dbi = DBIx::Custom->connect($NEW_ARGS->{0}); |
|
964 |
+eval{$dbi->apply_filter('table', 'column', [])}; |
|
965 |
+like($@, qr/apply_filter/); |
|
966 |
+ |
|
967 |
+eval{$dbi->apply_filter('table', 'column', {outer => 2})}; |
|
968 |
+like($@, qr/apply_filter/); |
|
969 |
+ |
|
970 |
+$dbi->apply_filter( |
|
971 |
+ |
|
972 |
+); |
|
973 |
+$dbi = DBIx::Custom->connect($NEW_ARGS->{0}); |
|
974 |
+$dbi->execute($CREATE_TABLE->{0}); |
|
975 |
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2}); |
|
976 |
+$dbi->insert(table => 'table1', param => {key1 => 3, key2 => 4}); |
|
977 |
+$dbi->apply_filter('table1', 'key2', |
|
978 |
+ {in => sub { $_[0] * 3 }, out => sub { $_[0] * 2 }}); |
|
979 |
+$rows = $dbi->select(table => 'table1', where => {key2 => 1})->fetch_hash_all; |
|
980 |
+is_deeply($rows, [{key1 => 1, key2 => 6}]); |
|
981 |
+ |
|
982 |
+$dbi = DBIx::Custom->connect($NEW_ARGS->{0}); |
|
983 |
+$dbi->execute($CREATE_TABLE->{0}); |
|
984 |
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2}); |
|
985 |
+$dbi->insert(table => 'table1', param => {key1 => 3, key2 => 4}); |
|
986 |
+$dbi->apply_filter('table1', 'key2', {}); |
|
987 |
+$rows = $dbi->select(table => 'table1', where => {key2 => 2})->fetch_hash_all; |
|
988 |
+is_deeply($rows, [{key1 => 1, key2 => 2}]); |
|
989 |
+ |
|
990 |
+$dbi = DBIx::Custom->connect($NEW_ARGS->{0}); |
|
991 |
+eval {$dbi->apply_filter('table1', 'key2', {out => 'no'})}; |
|
992 |
+like($@, qr/not registered/); |
|
993 |
+eval {$dbi->apply_filter('table1', 'key2', {in => 'no'})}; |
|
994 |
+like($@, qr/not registered/); |
|
995 |
+$dbi->helper({one => sub { 1 }}); |
|
996 |
+is($dbi->one, 1); |
|
997 |
+ |
|
998 |
+eval{DBIx::Custom->connect()}; |
|
999 |
+like($@, qr/connect/); |
|
1000 |
+ |
|
1001 |
+$dbi = DBIx::Custom->connect($NEW_ARGS->{0}); |
|
1002 |
+$dbi->execute($CREATE_TABLE->{0}); |
|
1003 |
+$dbi->register_filter(twice => sub { $_[0] * 2 }); |
|
1004 |
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2}, |
|
1005 |
+ filter => {key1 => 'twice'}); |
|
1006 |
+$row = $dbi->select(table => 'table1')->fetch_hash_first; |
|
1007 |
+is_deeply($row, {key1 => 2, key2 => 2}); |
|
1008 |
+eval {$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2}, |
|
1009 |
+ filter => {key1 => 'no'}) }; |
|
1010 |
+like($@, qr//); |
|
1011 |
+$dbi->table_class('!!!!'); |
|
1012 |
+eval {$dbi->table}; |
|
1013 |
+like($@, qr/Invalid table/); |
|
1014 |
+ |
|
1015 |
+$dbi->table_class('NOTEXIST'); |
|
1016 |
+eval {$dbi->table}; |
|
1017 |
+ok($@); |
|
1018 |
+$dbi->register_filter(one => sub { }); |
|
1019 |
+$dbi->default_fetch_filter('one'); |
|
1020 |
+ok($dbi->default_fetch_filter); |
|
1021 |
+$dbi->default_bind_filter('one'); |
|
1022 |
+ok($dbi->default_bind_filter); |
|
1023 |
+eval{$dbi->default_fetch_filter('no')}; |
|
1024 |
+like($@, qr/not registered/); |
|
1025 |
+eval{$dbi->default_bind_filter('no')}; |
|
1026 |
+like($@, qr/not registered/); |
|
1027 |
+$dbi->default_bind_filter(undef); |
|
1028 |
+ok(!defined $dbi->default_bind_filter); |
|
1029 |
+$dbi->default_fetch_filter(undef); |
|
1030 |
+ok(!defined $dbi->default_fetch_filter); |
|
1031 |
+eval {$dbi->execute('select * from table1 {= author') }; |
|
1032 |
+like($@, qr/Tag not finished/); |
|
1033 |
+ |
|
1034 |
+$dbi = DBIx::Custom->connect($NEW_ARGS->{0}); |
|
1035 |
+$dbi->execute($CREATE_TABLE->{0}); |
|
1036 |
+$dbi->register_filter(one => sub { 1 }); |
|
1037 |
+$result = $dbi->select(table => 'table1'); |
|
1038 |
+eval {$result->filter(key1 => 'no')}; |
|
1039 |
+like($@, qr/not registered/); |
|
1040 |
+eval {$result->end_filter(key1 => 'no')}; |
|
1041 |
+like($@, qr/not registered/); |
|
1042 |
+$result->default_filter(undef); |
|
1043 |
+ok(!defined $result->default_filter); |
|
1044 |
+$result->default_filter('one'); |
|
1045 |
+is($result->default_filter->(), 1); |
|
1046 |
+ |
|
1047 |
+$dbi->table('book'); |
|
1048 |
+eval{$dbi->table('book')->no_exists}; |
|
1049 |
+like($@, qr/locate/); |
... | ... |
@@ -15,4 +15,4 @@ eval "use Pod::Coverage $min_pc"; |
15 | 15 |
plan skip_all => "Pod::Coverage $min_pc required for testing POD coverage" |
16 | 16 |
if $@; |
17 | 17 |
|
18 |
-all_pod_coverage_ok(); |
|
18 |
+all_pod_coverage_ok({also_private => [qr/default_bind_filter|default_fetch_filter|default_filter/]}); |