File Coverage

blib/lib/DBR/Query/Part/Compare.pm
Criterion Covered Total %
statement 40 47 85.1
branch 17 26 65.3
condition 3 5 60.0
subroutine 13 15 86.6
pod 0 8 0.0
total 73 101 72.2


line stmt bran cond sub pod time code
1             package DBR::Query::Part::Compare;
2              
3 18     18   102 use strict;
  18         37  
  18         672  
4 18     18   105 use base 'DBR::Query::Part';
  18         35  
  18         3736  
5 18     18   112 use Carp;
  18         37  
  18         1725  
6              
7             use constant ({
8 18         23881 F_FIELD => 0,
9             F_OPERATOR => 1,
10             F_VALUE => 2,
11             F_SQLFUNC => 3
12 18     18   140 });
  18         134  
13              
14             my %sql_ops = (
15             eq => '=',
16             not => '!=',
17             ge => '>=',
18             le => '<=',
19             gt => '>',
20             lt => '<',
21             like => 'LIKE',
22             notlike => 'NOT LIKE',
23             between => 'BETWEEN',
24             notbetween => 'NOT BETWEEN',
25              
26             in => 'IN', # \
27             notin => 'NOT IN', # | not directly accessable
28             is => 'IS', # |
29             isnot => 'IS NOT' # /
30             );
31              
32             my %str_operators = map {$_ => 1} qw'eq not like notlike';
33             my %num_operators = map {$_ => 1} qw'eq not ge le gt lt between notbetween';
34              
35              
36             sub new{
37 830     830 0 2161 my( $package ) = shift;
38 830         4086 my %params = @_;
39              
40 830         1748 my $field = $params{field};
41 830         1696 my $value = $params{value};
42              
43 830 50       17700 croak 'field must be a Field object' unless ref($field) =~ /^DBR::Config::Field/; # Could be ::Anon
44 830 50       2834 croak 'value must be a Value object' unless ref($value) eq 'DBR::Query::Part::Value';
45              
46 830         1701 my $ref = ref($value);
47              
48 830   100     3209 my $operator = $value->op_hint || $params{operator} || 'eq';
49              
50 830 100       3948 if ($value->{is_number}){
51 590 50       2231 $num_operators{ $operator } or croak "invalid operator '$operator'";
52             }else{
53 240 50       1444 $str_operators{ $operator } or croak "invalid operator '$operator'";
54             }
55              
56 830         2155 my $sqlfunc = \&_sql;
57 830 50 33     25685 if ($operator eq 'between' or $operator eq 'notbetween'){
    100          
    100          
58 0 0       0 $value->count == 2 or croak "between/notbetween comparison requires two values";
59 0         0 $sqlfunc = \&_betweensql;
60             }elsif ( $value->count != 1 ){
61 85 100       1859 $operator = 'in' if $operator eq 'eq';
62 85 100       263 $operator = 'notin' if $operator eq 'not';
63             }elsif ($value->is_null) {
64 25 50       156 $operator = 'is' if $operator eq 'eq';
65 25 50       67 $operator = 'isnot' if $operator eq 'not';
66             }
67              
68 830         3431 my $self = [ $field, $operator, $value, $sqlfunc];
69              
70 830         3529 bless( $self, $package );
71              
72 830         5519 return $self;
73             }
74              
75 0     0 0 0 sub type { return 'COMPARE' };
76 786     786 0 3203 sub children { return () };
77 842     842 0 4736 sub field { return $_[0]->[F_FIELD] }
78 830     830 0 5278 sub operator { return $_[0]->[F_OPERATOR] }
79 843     843 0 4458 sub value { return $_[0]->[F_VALUE] }
80              
81 830     830 0 4794 sub sql { shift->[F_SQLFUNC]->(@_) }
82              
83 830     830   3916 sub _sql{ return $_[0]->field->sql($_[1]) . ' ' . $sql_ops{ $_[0]->operator } . ' ' . $_[0]->value->sql($_[1]) }
84              
85             sub _betweensql{
86 0     0   0 my $quoted = $_[0]->value->quoted( $_[1] );
87 0         0 @$quoted = sort {$a <=> $b} @$quoted;
  0         0  
88 0         0 return $_[0]->field->sql($_[1]) . ' ' . $sql_ops{ $_[0]->operator } . " $quoted->[0] AND $quoted->[1]";
89             }
90              
91 786     786   3235 sub _validate_self{ 1 }
92              
93             #Might be buggy for nullsets with a notin operator? think about this.
94 13     13 0 61 sub is_emptyset{ $_[0]->value->is_emptyset }