File Coverage

blib/lib/Fey/SQL/Fragment/Where/Comparison.pm
Criterion Covered Total %
statement 71 71 100.0
branch 32 32 100.0
condition 24 27 88.8
subroutine 12 12 100.0
pod 1 3 33.3
total 140 145 96.5


line stmt bran cond sub pod time code
1             package Fey::SQL::Fragment::Where::Comparison;
2              
3 27     27   184 use strict;
  27         40  
  27         1297  
4 27     27   130 use warnings;
  27         49  
  27         853  
5 27     27   170 use namespace::autoclean;
  27         49  
  27         219  
6              
7             our $VERSION = '0.43';
8              
9 27     27   2452 use Fey::Exceptions qw( param_error );
  27         50  
  27         1684  
10 27     27   9229 use Fey::Literal;
  27         87  
  27         1459  
11 27     27   12977 use Fey::Placeholder;
  27         99  
  27         1231  
12 27     27   228 use Fey::Types qw( ArrayRef WhereClauseSide Str );
  27         42  
  27         227  
13 27     27   306070 use Scalar::Util qw( blessed );
  27         68  
  27         2045  
14              
15 27     27   147 use Moose 2.1200;
  27         830  
  27         227  
16              
17             has '_lhs' => (
18             is => 'ro',
19             isa => WhereClauseSide,
20             required => 1,
21             );
22              
23             has '_operator' => (
24             is => 'ro',
25             isa => Str,
26             required => 1,
27             );
28              
29             has '_rhs' => (
30             is => 'ro',
31             isa => ArrayRef [WhereClauseSide],
32             required => 1,
33             );
34              
35             has '_bind_params' => (
36             is => 'ro',
37             isa => ArrayRef,
38             default => sub { [] },
39             );
40              
41             our $eq_comp_re = qr/^(?:=|!=|<>)$/;
42             our $in_comp_re = qr/^(?:not\s+)?in$/i;
43              
44             sub BUILDARGS {
45 99     99 1 148 my $class = shift;
46 99         165 my $auto_placeholders = shift;
47 99         119 my $lhs = shift;
48 99         191 my $operator = shift;
49 99         202 my @rhs = @_;
50              
51 99         121 my @bind;
52 99         222 for ( $lhs, @rhs ) {
53 221 100 100     1980 if ( defined $_ && blessed $_ && $_->can('is_comparable') ) {
      100        
54 114 100       521 if ( $_->can('bind_params') ) {
55 10         44 push @bind, $_->bind_params();
56             }
57              
58 114         269 next;
59             }
60              
61 107 100 100     553 if ( defined $_ && blessed $_ ) {
62 7 100       31 if ( overload::Overloaded($_) ) {
63              
64             # This "de-references" the value, which will make
65             # things simpler when we pass it to DBI, test
66             # code, etc. It works fine with numbers, more or
67             # less (see Fey::Literal).
68 6         298 $_ .= q{};
69             }
70             else {
71 1         54 param_error
72             "Cannot pass an object as part of a where clause comparison"
73             . " unless that object does Fey::Role::Comparable or is overloaded.";
74             }
75             }
76              
77 106 100 100     584 if ( defined $_ && $auto_placeholders ) {
78 40         61 push @bind, $_;
79              
80 40         1068 $_ = Fey::Placeholder->new();
81             }
82             else {
83 66         386 $_ = Fey::Literal->new_from_scalar($_);
84             }
85              
86             }
87              
88 98 100       213 if ( grep { $_->does('Fey::Role::SQL::ReturnsData') } @rhs ) {
  121         1344  
89 10 100       3006 param_error
90             "Cannot use a subselect on the right-hand side with $operator"
91             unless $operator =~ /$eq_comp_re|$in_comp_re/;
92             }
93              
94 96 100 100     8385 if ( defined $operator && lc $operator eq 'between' ) {
95 5 100       171 param_error "The BETWEEN operator requires two arguments"
96             unless @rhs == 2;
97             }
98              
99 94 100       261 if ( @rhs > 1 ) {
100 15 100       335 param_error
101             "Cannot pass more than one right-hand side argument with $operator"
102             unless $operator =~ /^(?:$in_comp_re|between)$/i;
103             }
104              
105             return {
106 92         3915 _lhs => $lhs,
107             _operator => $operator,
108             _rhs => \@rhs,
109             _bind_params => \@bind,
110             };
111             }
112              
113             sub sql {
114 90     90 0 137 my $self = shift;
115 90         117 my $dbh = shift;
116              
117 90         3116 my $sql = $self->_lhs()->sql_or_alias($dbh);
118              
119 90 100 100     9169 if ( $self->_operator() =~ /$eq_comp_re/
120             && $self->_rhs()->[0]->isa('Fey::Literal::Null') ) {
121             return (
122 5 100       173 $sql
123             . (
124             $self->_operator() eq '='
125             ? ' IS NULL'
126             : ' IS NOT NULL'
127             )
128             );
129             }
130              
131 85 100       2806 if ( lc $self->_operator() eq 'between' ) {
132 2         73 return ( $sql
133             . ' BETWEEN '
134             . $self->_rhs()->[0]->sql_or_alias($dbh) . ' AND '
135             . $self->_rhs()->[1]->sql_or_alias($dbh) );
136             }
137              
138 83 100       2857 if ( $self->_operator() =~ /$in_comp_re/ ) {
139             return (
140 39         209 $sql . ' '
141             . ( uc $self->_operator() ) . ' ('
142             . (
143             join ', ',
144 16         548 map { $_->sql_or_alias($dbh) } @{ $self->_rhs() }
  16         529  
145             )
146             . ')'
147             );
148             }
149              
150 67 100 66     2183 if ( $self->_operator() =~ /$eq_comp_re/
  65   66     2054  
      66        
151             && @{ $self->_rhs() } == 1
152             && blessed $self->_rhs()->[0]
153             && $self->_rhs()->[0]->does('Fey::Role::SQL::ReturnsData') ) {
154 1         113 return ( $sql . ' '
155             . $self->_operator() . ' ('
156             . $self->_rhs()->[0]->sql_or_alias($dbh)
157             . ')' );
158             }
159              
160 66         5047 return ( $sql . ' '
161             . $self->_operator() . ' '
162             . $self->_rhs()->[0]->sql_or_alias($dbh) );
163             }
164              
165             sub bind_params {
166 30     30 0 30 return @{ $_[0]->_bind_params() };
  30         930  
167             }
168              
169             __PACKAGE__->meta()->make_immutable();
170              
171             1;
172              
173             # ABSTRACT: Represents a comparison in a WHERE clause
174              
175             __END__
176              
177             =pod
178              
179             =head1 NAME
180              
181             Fey::SQL::Fragment::Where::Comparison - Represents a comparison in a WHERE clause
182              
183             =head1 VERSION
184              
185             version 0.43
186              
187             =head1 DESCRIPTION
188              
189             This class represents a comparison in a WHERE clause.
190              
191             It is intended solely for internal use in L<Fey::SQL> objects, and as
192             such is not intended for public use.
193              
194             =head1 BUGS
195              
196             See L<Fey> for details on how to report bugs.
197              
198             =head1 AUTHOR
199              
200             Dave Rolsky <autarch@urth.org>
201              
202             =head1 COPYRIGHT AND LICENSE
203              
204             This software is Copyright (c) 2011 - 2015 by Dave Rolsky.
205              
206             This is free software, licensed under:
207              
208             The Artistic License 2.0 (GPL Compatible)
209              
210             =cut