... | ... |
@@ -1,3 +1,6 @@ |
1 |
+0.1632 |
|
2 |
+ added experimental DBIx::Custom::Where. |
|
3 |
+ removed DBIx::Custom::Or |
|
1 | 4 |
0.1631 |
2 | 5 |
added experimental DBIx::Custom::Result end_filter method |
3 | 6 |
experimental extended select method's where option |
... | ... |
@@ -1,6 +1,6 @@ |
1 | 1 |
package DBIx::Custom; |
2 | 2 |
|
3 |
-our $VERSION = '0.1631'; |
|
3 |
+our $VERSION = '0.1632'; |
|
4 | 4 |
|
5 | 5 |
use 5.008001; |
6 | 6 |
use strict; |
... | ... |
@@ -13,12 +13,12 @@ use DBI; |
13 | 13 |
use DBIx::Custom::Result; |
14 | 14 |
use DBIx::Custom::Query; |
15 | 15 |
use DBIx::Custom::QueryBuilder; |
16 |
-use DBIx::Custom::Or; |
|
16 |
+use DBIx::Custom::Where; |
|
17 | 17 |
use Encode qw/encode_utf8 decode_utf8/; |
18 | 18 |
|
19 | 19 |
__PACKAGE__->attr( |
20 |
- [qw/data_source dbh dbi_options password user/], |
|
21 |
- |
|
20 |
+ [qw/data_source dbh password user/], |
|
21 |
+ dbi_options => sub { {} }, |
|
22 | 22 |
cache => 1, |
23 | 23 |
filters => sub { |
24 | 24 |
{ |
... | ... |
@@ -523,7 +523,7 @@ sub select { |
523 | 523 |
# Where clause |
524 | 524 |
my $param; |
525 | 525 |
my $wexists; |
526 |
- if (ref $where eq 'HASH' && keys %$where) { |
|
526 |
+ if (ref $where eq 'HASH') { |
|
527 | 527 |
$param = $where; |
528 | 528 |
$wexists = keys %$where; |
529 | 529 |
|
... | ... |
@@ -540,41 +540,14 @@ sub select { |
540 | 540 |
my $w = $where->[0] || ''; |
541 | 541 |
$param = $where->[1]; |
542 | 542 |
|
543 |
- if (ref $w eq 'HASH') { |
|
544 |
- $wexists = keys %$param; |
|
545 |
- if ($wexists) { |
|
546 |
- $source .= 'where ('; |
|
547 |
- |
|
548 |
- foreach my $column (keys %$param) { |
|
549 |
- croak qq{"$column" don't correspond to where clause} |
|
550 |
- unless exists $w->{$column}; |
|
551 |
- |
|
552 |
- my $value = $param->{$column}; |
|
553 |
- if (ref $value eq 'DBIx::Custom::Or') { |
|
554 |
- my $values = $value->values; |
|
555 |
- |
|
556 |
- $source .= '( '; |
|
557 |
- foreach my $value (@$values) { |
|
558 |
- $source .= $w->{$column}; |
|
559 |
- $source .= ' or '; |
|
560 |
- } |
|
561 |
- $source =~ s/ or $//; |
|
562 |
- $source .= ' )'; |
|
563 |
- $source .= ' and '; |
|
564 |
- $param->{$column} = $values; |
|
565 |
- } |
|
566 |
- elsif ($w->{$column}) { |
|
567 |
- $source .= $w->{$column} . ' and '; |
|
568 |
- } |
|
569 |
- } |
|
570 |
- $source =~ s/ and $//; |
|
571 |
- $source .= ') '; |
|
572 |
- } |
|
573 |
- } |
|
574 |
- else { |
|
575 |
- $wexists = $w =~ /\S/; |
|
576 |
- $source .= "where ($w) " if $wexists; |
|
577 |
- } |
|
543 |
+ $wexists = $w =~ /\S/; |
|
544 |
+ $source .= "where ($w) " if $wexists; |
|
545 |
+ } |
|
546 |
+ elsif (ref $where eq 'DBIx::Custom::Where') { |
|
547 |
+ $param = $where->param; |
|
548 |
+ my $w = $where->to_string; |
|
549 |
+ $wexists = $w =~ /\S/; |
|
550 |
+ $source .= $w; |
|
578 | 551 |
} |
579 | 552 |
|
580 | 553 |
# Relation |
... | ... |
@@ -713,6 +686,8 @@ sub update { |
713 | 686 |
|
714 | 687 |
sub update_all { shift->update(allow_update_all => 1, @_) }; |
715 | 688 |
|
689 |
+sub where { DBIx::Custom::Where->new } |
|
690 |
+ |
|
716 | 691 |
sub _build_binds { |
717 | 692 |
my ($self, $params, $columns, $filter) = @_; |
718 | 693 |
|
... | ... |
@@ -1,26 +0,0 @@ |
1 |
-package DBIx::Custom::Or; |
|
2 |
- |
|
3 |
-use strict; |
|
4 |
-use warnings; |
|
5 |
- |
|
6 |
-use base 'Object::Simple'; |
|
7 |
- |
|
8 |
-__PACKAGE__->attr(values => sub { [] }); |
|
9 |
- |
|
10 |
-1; |
|
11 |
- |
|
12 |
-=head1 NAME |
|
13 |
- |
|
14 |
-DBIx::Custom::Or - or condition |
|
15 |
- |
|
16 |
-=head1 SYNOPSYS |
|
17 |
- |
|
18 |
- my $or = DBIx::Custom::Or->new; |
|
19 |
- |
|
20 |
-=head1 ATTRIBUTES |
|
21 |
- |
|
22 |
-=head2 C<values> |
|
23 |
- |
|
24 |
- my $values = $or->values; |
|
25 |
- $or = $or->values([1, 2]); |
|
26 |
- |
... | ... |
@@ -7,6 +7,9 @@ use base 'Object::Simple'; |
7 | 7 |
|
8 | 8 |
use Carp 'croak'; |
9 | 9 |
|
10 |
+# Carp trust relationship |
|
11 |
+push @DBIx::Custom::CARP_NOT, __PACKAGE__; |
|
12 |
+ |
|
10 | 13 |
__PACKAGE__->attr(['dbi', 'name', 'model']); |
11 | 14 |
|
12 | 15 |
our $AUTOLOAD; |
... | ... |
@@ -0,0 +1,132 @@ |
1 |
+package DBIx::Custom::Where; |
|
2 |
+ |
|
3 |
+use strict; |
|
4 |
+use warnings; |
|
5 |
+ |
|
6 |
+use base 'Object::Simple'; |
|
7 |
+ |
|
8 |
+use overload 'bool' => sub {1}, fallback => 1; |
|
9 |
+use overload '""' => sub { shift->to_string }, fallback => 1; |
|
10 |
+ |
|
11 |
+use Carp 'croak'; |
|
12 |
+ |
|
13 |
+__PACKAGE__->attr(param => sub { {} }); |
|
14 |
+ |
|
15 |
+sub clause { |
|
16 |
+ my $self = shift; |
|
17 |
+ |
|
18 |
+ if (@_) { |
|
19 |
+ $self->{clause} = ref $_[0] eq 'HASH' ? $_[0] : {@_}; |
|
20 |
+ |
|
21 |
+ return $self; |
|
22 |
+ } |
|
23 |
+ return $self->{clause} ||= {}; |
|
24 |
+} |
|
25 |
+ |
|
26 |
+sub or_clause { |
|
27 |
+ my $self = shift; |
|
28 |
+ |
|
29 |
+ if (@_) { |
|
30 |
+ $self->{or_clause} = ref $_[0] eq 'HASH' ? $_[0] : {@_}; |
|
31 |
+ |
|
32 |
+ return $self; |
|
33 |
+ } |
|
34 |
+ |
|
35 |
+ return $self->{or_clause} ||= {}; |
|
36 |
+} |
|
37 |
+ |
|
38 |
+sub to_string { |
|
39 |
+ my $self = shift; |
|
40 |
+ |
|
41 |
+ my $param = $self->param; |
|
42 |
+ my $clauses = $self->clause; |
|
43 |
+ my $or_clauses = $self->or_clause; |
|
44 |
+ |
|
45 |
+ # Clause check |
|
46 |
+ my $wexists = keys %$param; |
|
47 |
+ |
|
48 |
+ # Where |
|
49 |
+ my $where = ''; |
|
50 |
+ if ($wexists) { |
|
51 |
+ $where .= 'where ('; |
|
52 |
+ |
|
53 |
+ foreach my $column (keys %$param) { |
|
54 |
+ |
|
55 |
+ croak qq{"$column" is not found in "clause" or "or_clause"} |
|
56 |
+ if exists $clauses->{$column} |
|
57 |
+ && exists $or_clauses->{$column}; |
|
58 |
+ |
|
59 |
+ if (exists $clauses->{$column}) { |
|
60 |
+ if (ref $clauses->{$column} eq 'ARRAY') { |
|
61 |
+ foreach my $clause (@{$clauses->{$column}}) { |
|
62 |
+ $where .= $clause . ' and '; |
|
63 |
+ } |
|
64 |
+ } |
|
65 |
+ else { |
|
66 |
+ $where .= $clauses->{$column} . ' and '; |
|
67 |
+ } |
|
68 |
+ } |
|
69 |
+ elsif (exists $or_clauses->{$column}) { |
|
70 |
+ my $clause = $or_clauses->{$column}; |
|
71 |
+ |
|
72 |
+ if (ref $param->{$column} eq 'ARRAY') { |
|
73 |
+ my $count = @{$param->{$column}}; |
|
74 |
+ if ($count) { |
|
75 |
+ $where .= '( '; |
|
76 |
+ $where .= $clause . ' or ' for (1 .. $count); |
|
77 |
+ $where =~ s/ or $//; |
|
78 |
+ $where .= ' ) and '; |
|
79 |
+ } |
|
80 |
+ } |
|
81 |
+ else { |
|
82 |
+ $where .= $clause . ' and '; |
|
83 |
+ } |
|
84 |
+ } |
|
85 |
+ } |
|
86 |
+ |
|
87 |
+ $where =~ s/ and $//; |
|
88 |
+ $where .= ' )'; |
|
89 |
+ } |
|
90 |
+ |
|
91 |
+ return $where; |
|
92 |
+} |
|
93 |
+ |
|
94 |
+1; |
|
95 |
+ |
|
96 |
+=head1 NAME |
|
97 |
+ |
|
98 |
+DBIx::Custom::Where - Where clause |
|
99 |
+ |
|
100 |
+=head1 SYNOPSYS |
|
101 |
+ |
|
102 |
+ $where = DBIx::Custom::Where->new; |
|
103 |
+ |
|
104 |
+ my $sql = "select * from book $where"; |
|
105 |
+ |
|
106 |
+=head1 ATTRIBUTES |
|
107 |
+ |
|
108 |
+=head2 C<param> |
|
109 |
+ |
|
110 |
+ my $param = $where->param; |
|
111 |
+ $where = $where->param({title => 'Perl', |
|
112 |
+ date => ['2010-11-11', '2011-03-05']}, |
|
113 |
+ name => ['Ken', 'Taro']); |
|
114 |
+=head1 METHODS |
|
115 |
+ |
|
116 |
+=head2 C<clause> |
|
117 |
+ |
|
118 |
+ $where->clause(title => '{= title}', date => '{< date}', |
|
119 |
+ date => '{> date}'); |
|
120 |
+ |
|
121 |
+Where clause. These clauses is joined by ' and ' in C<to_string()> |
|
122 |
+if corresponding parameter name is exists in C<param>. |
|
123 |
+ |
|
124 |
+=head2 C<or_join> |
|
125 |
+ |
|
126 |
+ $where->or_join('name', ...); |
|
127 |
+ |
|
128 |
+The clause which has these paramter name is joined by ' or '. |
|
129 |
+ |
|
130 |
+=head2 C<to_string> |
|
131 |
+ |
|
132 |
+ $where->to_string; |
... | ... |
@@ -63,6 +63,7 @@ my $update_query; |
63 | 63 |
my $ret_val; |
64 | 64 |
my $infos; |
65 | 65 |
my $table; |
66 |
+my $where; |
|
66 | 67 |
|
67 | 68 |
# Prepare table |
68 | 69 |
$dbi = DBIx::Custom->connect($NEW_ARGS->{0}); |
... | ... |
@@ -815,70 +816,102 @@ is(ref $query, 'DBIx::Custom::Query'); |
815 | 816 |
|
816 | 817 |
1; |
817 | 818 |
|
818 |
-test 'select where option'; |
|
819 |
+test 'DBIx::Custom::Where'; |
|
819 | 820 |
$dbi = DBIx::Custom->connect($NEW_ARGS->{0}); |
820 | 821 |
$dbi->execute($CREATE_TABLE->{0}); |
821 | 822 |
$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2}); |
822 | 823 |
$dbi->insert(table => 'table1', param => {key1 => 3, key2 => 4}); |
824 |
+$where = $dbi->where |
|
825 |
+ ->clause(key1 => '{= key1}', key2 => '{= key2}') |
|
826 |
+ ->param({key1 => 1}); |
|
823 | 827 |
$result = $dbi->select( |
824 | 828 |
table => 'table1', |
825 |
- where => [ |
|
826 |
- { key1 => '{= key1}', key2 => '{= key2}' }, |
|
827 |
- {key1 => 1} |
|
828 |
- ] |
|
829 |
+ where => $where |
|
829 | 830 |
); |
830 | 831 |
$row = $result->fetch_hash_all; |
831 | 832 |
is_deeply($row, [{key1 => 1, key2 => 2}]); |
832 | 833 |
|
834 |
+$where = $dbi->where |
|
835 |
+ ->clause(key1 => '{= key1}', key2 => '{= key2}') |
|
836 |
+ ->param({key1 => 1, key2 => 2}); |
|
833 | 837 |
$result = $dbi->select( |
834 | 838 |
table => 'table1', |
835 |
- where => [ |
|
836 |
- { key1 => '{= key1}', key2 => '{= key2}' }, |
|
837 |
- {key1 => 1, key2 => 2} |
|
838 |
- ] |
|
839 |
+ where => $where |
|
839 | 840 |
); |
840 | 841 |
$row = $result->fetch_hash_all; |
841 | 842 |
is_deeply($row, [{key1 => 1, key2 => 2}]); |
842 | 843 |
|
844 |
+$where = $dbi->where |
|
845 |
+ ->clause(key1 => '{= key1}', key2 => '{= key2}') |
|
846 |
+ ->param({}); |
|
843 | 847 |
$result = $dbi->select( |
844 | 848 |
table => 'table1', |
845 |
- where => [ |
|
846 |
- { key1 => '{= key1}', key2 => '{= key2}' }, |
|
847 |
- {} |
|
848 |
- ] |
|
849 |
+ where => $where, |
|
849 | 850 |
); |
850 | 851 |
$row = $result->fetch_hash_all; |
851 | 852 |
is_deeply($row, [{key1 => 1, key2 => 2}, {key1 => 3, key2 => 4}]); |
852 | 853 |
|
854 |
+$where = $dbi->where |
|
855 |
+ ->clause(key1 => ['{> key1}', '{< key1}'], key2 => '{= key2}') |
|
856 |
+ ->param({key1 => [0, 3], key2 => 2}); |
|
853 | 857 |
$result = $dbi->select( |
854 | 858 |
table => 'table1', |
855 |
- where => [ |
|
856 |
- { key1 => '{= key1}', key2 => '{= key2}' }, |
|
857 |
- { key1 => 1, key2 => $dbi->or(1, 2)} |
|
858 |
- ] |
|
859 |
+ where => $where, |
|
859 | 860 |
); |
860 | 861 |
$row = $result->fetch_hash_all; |
861 | 862 |
is_deeply($row, [{key1 => 1, key2 => 2}]); |
862 | 863 |
|
864 |
+$where = $dbi->where |
|
865 |
+ ->clause(key1 => "{= key1}" ) |
|
866 |
+ ->or_clause(key2 => "{= key2}" ) |
|
867 |
+ ->param({ key1 => 1, key2 => [1, 2]}); |
|
863 | 868 |
$result = $dbi->select( |
864 | 869 |
table => 'table1', |
865 |
- where => [ |
|
866 |
- { key1 => '{= key1}', key2 => '{= key2}' }, |
|
867 |
- { key1 => 1, key2 => $dbi->or(2)} |
|
868 |
- ] |
|
870 |
+ where => $where, |
|
871 |
+); |
|
872 |
+$row = $result->fetch_hash_all; |
|
873 |
+is_deeply($row, [{key1 => 1, key2 => 2}]); |
|
874 |
+ |
|
875 |
+$where = $dbi->where |
|
876 |
+ ->clause(key1 => "{= key1}" ) |
|
877 |
+ ->or_clause(key2 => "{= key2}" ) |
|
878 |
+ ->param({ key1 => 1, key2 => [2]}); |
|
879 |
+$result = $dbi->select( |
|
880 |
+ table => 'table1', |
|
881 |
+ where => $where |
|
869 | 882 |
); |
870 | 883 |
$row = $result->fetch_hash_all; |
871 | 884 |
is_deeply($row, [{key1 => 1, key2 => 2}]); |
872 | 885 |
|
886 |
+$where = $dbi->where; |
|
887 |
+$result = $dbi->select( |
|
888 |
+ table => 'table1', |
|
889 |
+ where => $where |
|
890 |
+); |
|
891 |
+$row = $result->fetch_hash_all; |
|
892 |
+is_deeply($row, [{key1 => 1, key2 => 2}, {key1 => 3, key2 => 4}]); |
|
893 |
+ |
|
873 | 894 |
eval { |
895 |
+$where = $dbi->where |
|
896 |
+ ->clause(key1 => "{= key1}" ) |
|
897 |
+ ->or_clause(key2 => "{= key2}" ) |
|
898 |
+ ->param({key3 => 5}); |
|
874 | 899 |
$result = $dbi->select( |
875 | 900 |
table => 'table1', |
876 |
- where => [ |
|
877 |
- { key2 => '{= key2}' }, |
|
878 |
- { key1 => 1} |
|
879 |
- ] |
|
901 |
+ where => $where |
|
880 | 902 |
); |
881 | 903 |
}; |
882 | 904 |
ok($@); |
883 | 905 |
|
906 |
+$where = $dbi->where; |
|
907 |
+is("$where", ''); |
|
908 |
+ |
|
909 |
+$where = $dbi->where->clause(key1 => 'pppp')->param({key1 => 1}); |
|
910 |
+like("$where", qr/pppp/); |
|
911 |
+ |
|
912 |
+test 'dbi_options default'; |
|
913 |
+$dbi = DBIx::Custom->new; |
|
914 |
+is_deeply($dbi->dbi_options, {}); |
|
915 |
+ |
|
916 |
+ |
|
884 | 917 |
|