added experimental DBIx::Cus...
|
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 | ||
changed DBIx::Custom::Where ...
|
13 |
__PACKAGE__->attr(clause => sub { [] }); |
added experimental DBIx::Cus...
|
14 |
__PACKAGE__->attr(param => sub { {} }); |
changed DBIx::Custom::Where ...
|
15 |
__PACKAGE__->attr(sql_builder => sub { {} }); |
added experimental DBIx::Cus...
|
16 | |
changed DBIx::Custom::Where ...
|
17 |
sub to_string { |
18 |
my ($self, $param, $clause) = @_; |
|
added experimental DBIx::Cus...
|
19 |
|
changed DBIx::Custom::Where ...
|
20 |
local $self->{_where} = ''; |
21 |
local $self->{_count} = {}; |
|
22 |
local $self->{_op_stack} = []; |
|
23 |
local $self->{_param} = $param; |
|
added experimental DBIx::Cus...
|
24 |
|
changed DBIx::Custom::Where ...
|
25 |
$clause = ['and', $clause] unless ref $clause eq 'ARRAY'; |
26 |
|
|
27 |
$self->_forward($clause); |
|
added experimental DBIx::Cus...
|
28 |
|
changed DBIx::Custom::Where ...
|
29 |
return $self->{_where}; |
added experimental DBIx::Cus...
|
30 |
} |
31 | ||
changed DBIx::Custom::Where ...
|
32 |
our %VALID_OPERATIONS = map { $_ => 1 } qw/and or or_repeat/; |
33 | ||
34 |
sub _forward { |
|
35 |
my ($self, $clause) = @_; |
|
added experimental DBIx::Cus...
|
36 |
|
changed DBIx::Custom::Where ...
|
37 |
if (ref $clause eq 'ARRAY') { |
38 |
$self->{_where} .= '( '; |
|
39 |
|
|
40 |
my $op = $clause->[0] || ''; |
|
41 |
|
|
42 |
croak qq{"$op" is invalid operation} |
|
43 |
unless $VALID_OPERATIONS{$op}; |
|
44 |
|
|
45 |
push @{$self->{_op_stack}}, $op; |
|
46 |
|
|
47 |
for (my $i = 1; $i < @$clause; $i++) { |
|
48 |
$self->_forword($clause->[$i]); |
|
49 |
} |
|
added experimental DBIx::Cus...
|
50 |
|
changed DBIx::Custom::Where ...
|
51 |
pop @{$self->{_op_stack}}; |
52 | ||
53 |
if ($self->{_where} =~ /\( $/) { |
|
54 |
$self->{_where} =~ s/\( $//; |
|
55 |
$self->{_where} .= ' '; |
|
56 |
} |
|
57 |
$self->{_where} =~ s/ $op $//; |
|
58 |
$self->{_where} .= ' ) '; |
|
59 |
} |
|
60 |
else { |
|
61 |
my $op = $self->{_op_stack}->[-1]; |
|
62 |
|
|
63 |
my $columns = $self->sql_builder->build_query($clause)->columns; |
|
64 |
|
|
65 |
croak qq{each tag contains one column name: tag "$clause"} |
|
66 |
unless @$columns == 1; |
|
67 |
|
|
68 |
my $column = $columns->[0]; |
|
69 |
|
|
70 |
my $ccount = ++$self->{_count}->{$column}; |
|
71 |
|
|
72 |
my $param = $self->{_param}; |
|
73 |
|
|
74 |
if (exists $param->{$column}) { |
|
75 |
if ($op eq 'and' || $op eq 'or') { |
|
76 |
if (ref $param->{$column} eq 'ARRAY') { |
|
77 |
$self->{_where} .= $clause . " $op " |
|
78 |
if exists $param->{$column}->[$ccount]; |
|
added experimental DBIx::Cus...
|
79 |
} |
80 |
else { |
|
changed DBIx::Custom::Where ...
|
81 |
$self->{_where} .= $clause . " $op " |
82 |
if $ccount == 1; |
|
added experimental DBIx::Cus...
|
83 |
} |
changed DBIx::Custom::Where ...
|
84 |
} |
85 |
elsif ($op eq 'or_repeat') { |
|
added experimental DBIx::Cus...
|
86 |
if (ref $param->{$column} eq 'ARRAY') { |
changed DBIx::Custom::Where ...
|
87 |
$self->{_where} .= $clause . " or " |
88 |
for (1 .. @{$param->{$column}}); |
|
added experimental DBIx::Cus...
|
89 |
} |
90 |
else { |
|
changed DBIx::Custom::Where ...
|
91 |
$self->{_where} .= $clause; |
added experimental DBIx::Cus...
|
92 |
} |
93 |
} |
|
94 |
} |
|
95 |
} |
|
96 |
} |
|
97 | ||
98 |
1; |
|
99 | ||
100 |
=head1 NAME |
|
101 | ||
102 |
DBIx::Custom::Where - Where clause |
|
103 | ||
104 |
=head1 SYNOPSYS |
|
105 | ||
106 |
$where = DBIx::Custom::Where->new; |
|
107 |
|
|
108 |
my $sql = "select * from book $where"; |
|
109 | ||
110 |
=head1 ATTRIBUTES |
|
111 | ||
112 |
=head2 C<param> |
|
113 | ||
114 |
my $param = $where->param; |
|
115 |
$where = $where->param({title => 'Perl', |
|
116 |
date => ['2010-11-11', '2011-03-05']}, |
|
117 |
name => ['Ken', 'Taro']); |
|
118 |
=head1 METHODS |
|
119 | ||
120 |
=head2 C<clause> |
|
121 | ||
fix tests
|
122 |
$where->clause(title => '{= title}', date => ['{< date}', '{> date}']); |
added experimental DBIx::Cus...
|
123 | |
fix tests
|
124 |
Where clause. These clauses is joined by ' and ' at C<to_string()> |
added experimental DBIx::Cus...
|
125 |
if corresponding parameter name is exists in C<param>. |
126 | ||
127 |
=head2 C<to_string> |
|
128 | ||
129 |
$where->to_string; |