File Coverage

blib/lib/Fey/Role/SQL/HasWhereClause.pm
Criterion Covered Total %
statement 87 87 100.0
branch 14 14 100.0
condition n/a
subroutine 20 20 100.0
pod 3 4 75.0
total 124 125 99.2


line stmt bran cond sub pod time code
1             package Fey::Role::SQL::HasWhereClause;
2              
3 27     27   17645 use strict;
  27         128  
  27         1094  
4 27     27   134 use warnings;
  27         41  
  27         898  
5 27     27   130 use namespace::autoclean;
  27         34  
  27         190  
6              
7             our $VERSION = '0.43';
8              
9 27     27   2697 use Fey::Exceptions qw( param_error );
  27         45  
  27         1942  
10              
11 27     27   10882 use Fey::SQL::Fragment::Where::Boolean;
  27         87  
  27         1266  
12 27     27   16613 use Fey::SQL::Fragment::Where::Comparison;
  27         104  
  27         1271  
13 27     27   15553 use Fey::SQL::Fragment::Where::SubgroupStart;
  27         327  
  27         1095  
14 27     27   13839 use Fey::SQL::Fragment::Where::SubgroupEnd;
  27         91  
  27         1154  
15 27     27   223 use Fey::Types qw( ArrayRef );
  27         42  
  27         236  
16              
17 27     27   116511 use Moose::Role;
  27         69  
  27         255  
18              
19             has '_where' => (
20             traits => ['Array'],
21             is => 'bare',
22             isa => ArrayRef,
23             default => sub { [] },
24             handles => {
25             _add_where_element => 'push',
26             _has_where_elements => 'count',
27             _last_where_element => [ 'get', -1 ],
28             _where => 'elements',
29             },
30             init_arg => undef,
31             );
32              
33             sub where {
34 88     88 1 8284 my $self = shift;
35              
36 88         352 $self->_condition( 'where', @_ );
37              
38 82         220 return $self;
39             }
40              
41             # Just some sugar
42             sub and {
43 1     1 1 91 my $self = shift;
44              
45 1         4 return $self->where(@_);
46             }
47              
48             {
49             my %dispatch = (
50             'and' => '_and',
51             'or' => '_or',
52             '(' => '_subgroup_start',
53             ')' => '_subgroup_end',
54             );
55              
56             sub _condition {
57 115     115   147 my $self = shift;
58 115         176 my $key = shift;
59              
60 115 100       352 if ( @_ == 1 ) {
61 16 100       83 if ( my $meth = $dispatch{ lc $_[0] } ) {
62 15         68 $self->$meth($key);
63 15         40 return;
64             }
65             else {
66 1         8 param_error
67             qq|Cannot pass one argument to $key() unless it is one of "and", "or", "(", or ")".|;
68             }
69             }
70              
71 99         402 $self->_add_and_if_needed($key);
72              
73 99         250 my $add_method = '_add_' . $key . '_element';
74 99         3085 $self->$add_method(
75             Fey::SQL::Fragment::Where::Comparison->new(
76             $self->auto_placeholders(), @_
77             )
78             );
79             }
80             }
81              
82             sub _add_and_if_needed {
83 104     104   156 my $self = shift;
84 104         135 my $key = shift;
85              
86 104         254 my $has_method = '_has_' . $key . '_elements';
87              
88 104 100       4509 return unless $self->$has_method();
89              
90 18         65 my $last_method = '_last_' . $key . '_element';
91 18         1082 my $last = $self->$last_method();
92              
93 18 100       256 return if $last->isa('Fey::SQL::Fragment::Where::Boolean');
94 13 100       90 return if $last->isa('Fey::SQL::Fragment::Where::SubgroupStart');
95              
96 8         35 $self->_and($key);
97             }
98              
99             sub _and {
100 8     8   16 my $self = shift;
101 8         28 my $key = shift;
102              
103 8         37 my $add_method = '_add_' . $key . '_element';
104 8         357 $self->$add_method(
105             Fey::SQL::Fragment::Where::Boolean->new( comparison => 'AND' ) );
106              
107 8         19 return $self;
108             }
109              
110             sub _or {
111 5     5   11 my $self = shift;
112 5         10 my $key = shift;
113              
114 5         19 my $add_method = '_add_' . $key . '_element';
115 5         226 $self->$add_method(
116             Fey::SQL::Fragment::Where::Boolean->new( comparison => 'OR' ) );
117              
118 5         12 return $self;
119             }
120              
121             sub _subgroup_start {
122 5     5   10 my $self = shift;
123 5         11 my $key = shift;
124              
125 5         17 $self->_add_and_if_needed($key);
126              
127 5         20 my $add_method = '_add_' . $key . '_element';
128 5         240 $self->$add_method( Fey::SQL::Fragment::Where::SubgroupStart->new() );
129              
130 5         12 return $self;
131             }
132              
133             sub _subgroup_end {
134 5     5   10 my $self = shift;
135 5         9 my $key = shift;
136              
137 5         17 my $add_method = '_add_' . $key . '_element';
138 5         246 $self->$add_method( Fey::SQL::Fragment::Where::SubgroupEnd->new() );
139              
140 5         10 return $self;
141             }
142              
143             sub where_clause {
144 130     130 1 759 my $self = shift;
145 130         184 my $dbh = shift;
146 130         155 my $skip_where = shift;
147              
148 130 100       5014 return unless $self->_has_where_elements();
149              
150 61         114 my $sql = '';
151 61 100       174 $sql = 'WHERE '
152             unless $skip_where;
153              
154             return (
155 89         781 $sql
156             . (
157             join ' ',
158 61         2487 map { $_->sql($dbh) } $self->_where()
159             )
160             );
161             }
162              
163             sub bind_params {
164 36     36 0 61 my $self = shift;
165              
166             return (
167 27         91 map { $_->bind_params() }
  30         155  
168 36         1450 grep { $_->can('bind_params') } $self->_where()
169             );
170             }
171              
172             1;
173              
174             # ABSTRACT: A role for queries which can include a WHERE clause
175              
176             __END__
177              
178             =pod
179              
180             =head1 NAME
181              
182             Fey::Role::SQL::HasWhereClause - A role for queries which can include a WHERE clause
183              
184             =head1 VERSION
185              
186             version 0.43
187              
188             =head1 SYNOPSIS
189              
190             use Moose 2.1200;
191              
192             with 'Fey::Role::SQL::HasWhereClause';
193              
194             =head1 DESCRIPTION
195              
196             Classes which do this role represent a query which can include a
197             C<WHERE> clause.
198              
199             =head1 METHODS
200              
201             This role provides the following methods:
202              
203             =head2 $query->where(...)
204              
205             See the L<Fey::SQL section on WHERE Clauses|Fey::SQL/WHERE Clauses>
206             for more details.
207              
208             =head2 $query->and(...)
209              
210             See the L<Fey::SQL section on WHERE Clauses|Fey::SQL/WHERE Clauses>
211             for more details.
212              
213             =head2 $query->where_clause( $dbh, $skip_where )
214              
215             Returns the C<WHERE> clause portion of the SQL statement as a string. The
216             first argument, a database handle, is required. If the second argument is
217             true, the string returned will not start with "WHERE", it will simply start
218             with the where clause conditions.
219              
220             =head1 BUGS
221              
222             See L<Fey> for details on how to report bugs.
223              
224             =head1 AUTHOR
225              
226             Dave Rolsky <autarch@urth.org>
227              
228             =head1 COPYRIGHT AND LICENSE
229              
230             This software is Copyright (c) 2011 - 2015 by Dave Rolsky.
231              
232             This is free software, licensed under:
233              
234             The Artistic License 2.0 (GPL Compatible)
235              
236             =cut