File Coverage

blib/lib/OPTiMaDe/Filter/Comparison.pm
Criterion Covered Total %
statement 79 89 88.7
branch 26 38 68.4
condition 4 6 66.6
subroutine 11 13 84.6
pod 0 10 0.0
total 120 156 76.9


line stmt bran cond sub pod time code
1             package OPTiMaDe::Filter::Comparison;
2              
3 5     5   31 use strict;
  5         11  
  5         157  
4 5     5   25 use warnings;
  5         7  
  5         131  
5 5     5   24 use Scalar::Util qw(blessed);
  5         2007  
  5         5017  
6              
7             sub new {
8 156     156 0 358 my( $class, $operator ) = @_;
9 156         520 return bless { operands => [], operator => $operator }, $class;
10             }
11              
12             sub push_operand
13             {
14 159     159 0 281 my( $self, $operand ) = @_;
15 159 50       224 die 'attempt to insert more than two operands' if @{$self->{operands}} >= 2;
  159         351  
16 159         202 push @{$self->{operands}}, $operand;
  159         357  
17             }
18              
19             sub unshift_operand
20             {
21 153     153 0 248 my( $self, $operand ) = @_;
22 153 50       218 die 'attempt to insert more than two operands' if @{$self->{operands}} >= 2;
  153         311  
23 153         207 unshift @{$self->{operands}}, $operand;
  153         322  
24             }
25              
26             sub operator
27             {
28 222     222 0 323 my( $self, $operator ) = @_;
29 222         323 my $previous_operator = $self->{operator};
30 222 50       354 $self->{operator} = $operator if defined $operator;
31 222         487 return $previous_operator;
32             }
33              
34             sub left
35             {
36 0     0 0 0 my( $self, $operand ) = @_;
37 0         0 my $previous_operand = $self->{operands}[0];
38 0 0       0 $self->{operands}[0] = $operand if defined $operand;
39 0         0 return $previous_operand;
40             }
41              
42             sub right
43             {
44 0     0 0 0 my( $self, $operand ) = @_;
45 0         0 my $previous_operand = $self->{operands}[1];
46 0 0       0 $self->{operands}[1] = $operand if defined $operand;
47 0         0 return $previous_operand;
48             }
49              
50             sub to_filter
51             {
52 148     148 0 21920 my( $self ) = @_;
53 148         346 $self->validate;
54              
55 148         248 my $operator = $self->{operator};
56 148         184 my @operands;
57 148         189 for my $i (0..$#{$self->{operands}}) {
  148         323  
58 296         425 my $arg = $self->{operands}[$i];
59 296 100 66     1013 if( blessed $arg && $arg->can( 'to_filter' ) ) {
60 160         326 $arg = $arg->to_filter;
61             } else {
62 136         270 $arg =~ s/\\/\\\\/g;
63 136         184 $arg =~ s/"/\\"/g;
64 136         218 $arg = "\"$arg\"";
65             }
66 296         561 push @operands, $arg;
67             }
68              
69 148         470 return "($operands[0] $operator $operands[1])";
70             }
71              
72             sub to_SQL
73             {
74 74     74 0 219 my( $self, $options ) = @_;
75 74         153 $self->validate;
76              
77 74 100       149 $options = {} unless $options;
78             my( $delim, $placeholder ) = (
79             $options->{delim},
80             $options->{placeholder},
81 74         143 );
82 74 50       131 $delim = "'" unless $delim;
83              
84 74         102 my $operator = $self->{operator};
85 74         92 my @operands = @{$self->{operands}};
  74         147  
86              
87             # Handle STARTS/ENDS WITH
88 74 100       243 if( $operator eq 'CONTAINS' ) {
    100          
    100          
89 3         6 $operator = 'LIKE';
90 3 50       15 $operands[1] = '%' . $operands[1] . '%' if !blessed $operands[1];
91             } elsif( $operator =~ /^STARTS( WITH)?$/ ) {
92 4         9 $operator = 'LIKE';
93 4 100       20 $operands[1] = $operands[1] . '%' if !blessed $operands[1];
94             } elsif( $operator =~ /^ENDS( WITH)?$/ ) {
95 1         3 $operator = 'LIKE';
96 1 50       5 $operands[1] = '%' . $operands[1] if !blessed $operands[1];
97             }
98              
99 74         92 my @values;
100             my @operands_now;
101 74         131 for my $arg (@operands) {
102 148 100 66     520 if( blessed $arg && $arg->can( 'to_SQL' ) ) {
103 80         189 ( $arg, my $values ) = $arg->to_SQL( $options );
104 80         143 push @values, @$values;
105             } else {
106 68         119 push @values, $arg;
107 68 100       114 if( $placeholder ) {
108 15         20 $arg = $placeholder;
109             } else {
110 53         98 $arg =~ s/"/""/g;
111 53         95 $arg = "\"$arg\"";
112             }
113             }
114 148         270 push @operands_now, $arg;
115             }
116 74         173 @operands = @operands_now;
117              
118 74 100       130 if( wantarray ) {
119 60         236 return ( "($operands[0] $operator $operands[1])", \@values );
120             } else {
121 14         119 return "($operands[0] $operator $operands[1])";
122             }
123             }
124              
125             sub modify
126             {
127 3     3 0 7 my $self = shift;
128 3         4 my $code = shift;
129              
130 6         35 $self->{operands} = [ map { OPTiMaDe::Filter::modify( $_, $code, @_ ) }
131 3         3 @{$self->{operands}} ];
  3         5  
132 3         28 return $code->( $self, @_ );
133             }
134              
135             sub validate
136             {
137 222     222 0 309 my $self = shift;
138              
139 222 50       264 if( @{$self->{operands}} != 2 ) {
  222         454  
140             die 'number of operands for OPTiMaDe::Filter::Comparison must be 2, ' .
141 0         0 'got ' . @{$self->{operands}};
  0         0  
142             }
143 222 50       397 die 'operator undefined for OPTiMaDe::Filter::Comparison'
144             if !$self->operator;
145             }
146              
147             1;