File Coverage

blib/lib/DBIx/Custom/Where.pm
Criterion Covered Total %
statement 72 74 97.3
branch 38 42 90.4
condition 7 9 77.7
subroutine 10 10 100.0
pod 2 2 100.0
total 129 137 94.1


line stmt bran cond sub pod time code
1             package DBIx::Custom::Where;
2 16     16   115 use Object::Simple -base;
  16         36  
  16         98  
3              
4 16     16   1745 use Carp 'confess';
  16         34  
  16         797  
5 16     16   94 use DBIx::Custom::Util '_subname';
  16         32  
  16         1017  
6 16     16   20258 use overload 'bool' => sub {1}, fallback => 1;
  16     186   16481  
  16         132  
  186         394  
7 16     16   1670 use overload '""' => sub { shift->to_string }, fallback => 1;
  16     42   36  
  16         85  
  42         8301  
8              
9             # Carp trust relationship
10             push @DBIx::Custom::CARP_NOT, __PACKAGE__;
11              
12             has 'dbi';
13             has 'param';
14             has clause => sub { [] };
15             has 'join';
16              
17             sub new {
18 186     186 1 668 my $self = shift->SUPER::new(@_);
19            
20             # Check attribute names
21 186         2011 my @attrs = keys %$self;
22 186         442 for my $attr (@attrs) {
23 317 100       1194 confess qq{"$attr" is invalid attribute name (} . _subname . ")"
24             unless $self->can($attr);
25             }
26            
27 183         2159 return $self;
28             }
29              
30             sub to_string {
31 165     165 1 276 my $self = shift;
32            
33             # Clause
34 165         3038 my $clause = $self->clause;
35 165 100       1236 $clause = ['and', $clause] unless ref $clause eq 'ARRAY';
36 165 100       392 $clause->[0] = 'and' unless @$clause;
37            
38             # Parse
39 165         269 my $where = [];
40 165         288 my $count = {};
41 165         2685 my $c = $self->dbi->safety_character;
42 165 50       4453 $self->{_re} = $c eq 'a-zA-Z0-9_' ?
43             qr/[^\\]:([$c\.]+)/so : qr/[^\\]:([$c\.]+)/s;
44            
45 165         2686 $self->{_quote} = $self->dbi->_quote;
46             $self->{_tag_parse} = exists $ENV{DBIX_CUSTOM_TAG_PARSE}
47 165 50       3644 ? $ENV{DBIX_CUSTOM_TAG_PARSE} : $self->dbi->{tag_parse};
48 165         1297 $self->_parse($clause, $where, $count, 'and');
49              
50             # Stringify
51 162 100       491 unshift @$where, 'where' if @$where;
52 162         1057 return join(' ', @$where);
53             }
54            
55             our %VALID_OPERATIONS = map { $_ => 1 } qw/and or/;
56             sub _parse {
57 450     450   946 my ($self, $clause, $where, $count, $op, $info) = @_;
58            
59             # Array
60 450 100       904 if (ref $clause eq 'ARRAY') {
61             # Start
62 180         371 push @$where, '(';
63            
64             # Operation
65 180   50     455 my $op = $clause->[0] || '';
66             confess qq{First argument must be "and" or "or" in where clause } .
67             qq{"$op" is passed} . _subname . ")"
68 180 100       433 unless $VALID_OPERATIONS{$op};
69            
70 177         253 my $pushed_array;
71             # Parse internal clause
72 177         452 for (my $i = 1; $i < @$clause; $i++) {
73 285         650 my $pushed = $self->_parse($clause->[$i], $where, $count, $op);
74 285 100       584 push @$where, $op if $pushed;
75 285 100       764 $pushed_array = 1 if $pushed;
76             }
77 177 100       424 pop @$where if $where->[-1] eq $op;
78            
79             # Undo
80 177 100       371 if ($where->[-1] eq '(') {
81 42         68 pop @$where;
82 42 50 100     205 pop @$where if ($where->[-1] || '') eq $op;
83             }
84             # End
85 135         233 else { push @$where, ')' }
86            
87 177         405 return $pushed_array;
88             }
89            
90             # String
91             else {
92             # Pushed
93 270         387 my $pushed;
94            
95             # Column
96 270         414 my $re = $self->{_re};
97            
98 270         326 my $column;
99 270   50     712 my $sql = " " . $clause || '';
100 270         636 $sql =~ s/([0-9]):/$1\\:/g;
101 270         1433 ($column) = $sql =~ /$re/;
102              
103 270 100       633 unless (defined $column) {
104 9         22 push @$where, $clause;
105 9         16 $pushed = 1;
106 9         20 return $pushed;
107             }
108            
109             # Column count up
110 261         554 my $count = ++$count->{$column};
111            
112             # Push
113 261         394 my $param = $self->{param};
114 261 100       577 if (ref $param eq 'HASH') {
    50          
115 243 100       545 if (exists $param->{$column}) {
116 204 100       507 if (ref $param->{$column} eq 'ARRAY') {
    100          
117             $pushed = 1 if exists $param->{$column}->[$count - 1]
118 102 100 100     456 && ref $param->{$column}->[$count - 1] ne 'DBIx::Custom::NotExists'
119             }
120 99         147 elsif ($count == 1) { $pushed = 1 }
121             }
122 243 100       522 push @$where, $clause if $pushed;
123             }
124             elsif (!defined $param) {
125 18         40 push @$where, $clause;
126 18         31 $pushed = 1;
127             }
128             else {
129 0         0 confess "Parameter must be hash reference or undfined value ("
130             . _subname . ")"
131             }
132 261         624 return $pushed;
133             }
134 0           return;
135             }
136             1;
137              
138             =head1 NAME
139              
140             DBIx::Custom::Where - Where clause
141              
142             =head1 SYNOPSYS
143            
144             # Create DBIx::Custom::Where object
145             my $where = $dbi->where;
146            
147             # Clause
148             $where->clause(['and', 'title like :title', 'price = :price']);
149             $where->clause(['and', ':title{like}', ':price{=}']);
150            
151             # Stringify where clause
152             my $where_clause = "$where";
153             my $where_clause = $where->to_string;
154             # -> where title like :title and price = :price
155            
156             # Only price condition
157             $where->clause(['and', ':title{like}', ':price{=}']);
158             $where->param({price => 1900});
159             # -> where price = :price
160            
161             # Only title condition
162             $where->clause(['and', ':title{like}', ':price{=}']);
163             $where->param({title => 'Perl'});
164             # -> where title like :title
165            
166             # Nothing
167             $where->clause(['and', ':title{like}', ':price{=}']);
168             $where->param({});
169             # => Nothing
170            
171             # or condition
172             $where->clause(['or', ':title{like}', ':price{=}']);
173             # -> where title = :title or price like :price
174            
175             # More than one parameter
176             $where->clause(['and', ':price{>}', ':price{<}']);
177             $where->param({price => [1000, 2000]});
178             # -> where price > :price and price < :price
179            
180             # Only first condition
181             $where->clause(['and', ':price{>}', ':price{<}']);
182             $where->param({price => [1000, $dbi->not_exists]});
183             # -> where price > :price
184            
185             # Only second condition
186             $where->clause(['and', ':price{>}', ':price{<}']);
187             $where->param({price => [$dbi->not_exists, 2000]});
188             # -> where price < :price
189            
190             # More complex condition
191             $where->clause(
192             [
193             'and',
194             ':price{=}',
195             ['or', ':title{=}', ':title{=}', ':title{=}']
196             ]
197             );
198             # -> pirce = :price and (title = :title or title = :title or tilte = :title)
199            
200             # Using Full-qualified column name
201             $where->clause(['and', ':book.title{like}', ':book.price{=}']);
202             # -> book.title like :book.title and book.price = :book.price
203              
204             =head1 ATTRIBUTES
205              
206             =head2 clause
207              
208             my $clause = $where->clause;
209             $where = $where->clause(
210             ['and',
211             ':title{=}',
212             ['or', ':date{<}', ':date{>}']
213             ]
214             );
215              
216             Where clause. Above one is expanded to the following SQL by to_string
217             If all parameter names is exists.
218              
219             where title = :title and ( date < :date or date > :date )
220              
221             =head2 param
222              
223             my $param = $where->param;
224             $where = $where->param({
225             title => 'Perl',
226             date => ['2010-11-11', '2011-03-05'],
227             });
228              
229             =head2 dbi
230              
231             my $dbi = $where->dbi;
232             $where = $where->dbi($dbi);
233              
234             L object.
235              
236             =head2 join
237              
238             my $join = $where->join;
239             $join = $where->join($join);
240              
241             join information. This values is addd to select method C option values.
242              
243             $where->join(['left join author on book.author = authro.id']);
244            
245             =head1 METHODS
246              
247             L inherits all methods from L
248             and implements the following new ones.
249              
250             =head2 to_string
251              
252             $where->to_string;
253              
254             Convert where clause to string.
255              
256             double quote is override to execute C method.
257              
258             my $string_where = "$where";
259              
260             =cut