1# BEGIN BPS TAGGED BLOCK {{{ 2# 3# COPYRIGHT: 4# 5# This software is Copyright (c) 1996-2021 Best Practical Solutions, LLC 6# <sales@bestpractical.com> 7# 8# (Except where explicitly superseded by other copyright notices) 9# 10# 11# LICENSE: 12# 13# This work is made available to you under the terms of Version 2 of 14# the GNU General Public License. A copy of that license should have 15# been provided with this software, but in any event can be snarfed 16# from www.gnu.org. 17# 18# This work is distributed in the hope that it will be useful, but 19# WITHOUT ANY WARRANTY; without even the implied warranty of 20# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 21# General Public License for more details. 22# 23# You should have received a copy of the GNU General Public License 24# along with this program; if not, write to the Free Software 25# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 26# 02110-1301 or visit their web page on the internet at 27# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html. 28# 29# 30# CONTRIBUTION SUBMISSION POLICY: 31# 32# (The following paragraph is not intended to limit the rights granted 33# to you to modify and distribute this software under the terms of 34# the GNU General Public License and is only of importance to you if 35# you choose to contribute your changes and enhancements to the 36# community by submitting them to Best Practical Solutions, LLC.) 37# 38# By intentionally submitting any modifications, corrections or 39# derivatives to this work, or any other work intended for use with 40# Request Tracker, to Best Practical Solutions, LLC, you confirm that 41# you are the copyright holder for those contributions and you grant 42# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable, 43# royalty-free, perpetual, license to use, copy, create derivative 44# works based on those contributions, and sublicense and distribute 45# those contributions and any derivatives thereof. 46# 47# END BPS TAGGED BLOCK }}} 48 49package RT::SQL; 50 51use strict; 52use warnings; 53 54 55# States 56use constant VALUE => 1; 57use constant AGGREG => 2; 58use constant OP => 4; 59use constant OPEN_PAREN => 8; 60use constant CLOSE_PAREN => 16; 61use constant KEYWORD => 32; 62my @tokens = qw[VALUE AGGREGATOR OPERATOR OPEN_PAREN CLOSE_PAREN KEYWORD]; 63 64use Regexp::Common qw /delimited/; 65my $re_aggreg = qr[(?i:AND|OR)]; 66my $re_delim = qr[$RE{delimited}{-delim=>qq{\'\"}}]; 67 68# We need to support bare(not quoted) strings like CF.{Beta Date} to use the 69# content of related custom field as the value to compare, e.g. 70# 71# Due < CF.{Beta Date} 72# 73# Support it in keyword part is mainly for consistency. 74 75my $re_value = qr[(?i:CF)\.\{.+?\}(?:\.(?i:Content|LargeContent))?|[\w\.]+|[+-]?\d+|(?i:NULL)|$re_delim]; 76my $re_keyword = qr[(?i:CF)\.\{.+?\}(?:\.(?i:Content|LargeContent))?|[{}\w\.]+|$re_delim]; 77my $re_op = qr[(?i:SHALLOW )?(?:=|!=|>=|<=|>|<|(?i:IS NOT)|(?i:IS)|(?i:NOT LIKE)|(?i:LIKE)|(?i:NOT STARTSWITH)|(?i:STARTSWITH)|(?i:NOT ENDSWITH)|(?i:ENDSWITH))]; # long to short 78my $re_open_paren = qr[\(]; 79my $re_close_paren = qr[\)]; 80 81sub ParseToArray { 82 my ($string) = shift; 83 84 my ($tree, $node, @pnodes); 85 $node = $tree = []; 86 87 my %callback; 88 $callback{'OpenParen'} = sub { push @pnodes, $node; $node = []; push @{ $pnodes[-1] }, $node }; 89 $callback{'CloseParen'} = sub { $node = pop @pnodes }; 90 $callback{'EntryAggregator'} = sub { push @$node, $_[0] }; 91 $callback{'Condition'} = sub { push @$node, { key => $_[0], op => $_[1], value => $_[2] } }; 92 93 Parse($string, \%callback); 94 return $tree; 95} 96 97sub Parse { 98 my ($string, $cb) = @_; 99 my $loc = sub {HTML::Mason::Commands::loc(@_)}; 100 $string = '' unless defined $string; 101 102 my $want = KEYWORD | OPEN_PAREN; 103 my $last = 0; 104 105 my $depth = 0; 106 my ($key,$op,$value) = ("","",""); 107 108 # order of matches in the RE is important.. op should come early, 109 # because it has spaces in it. otherwise "NOT LIKE" might be parsed 110 # as a keyword or value. 111 112 while ($string =~ /( 113 $re_aggreg 114 |$re_op 115 |$re_keyword 116 |$re_value 117 |$re_open_paren 118 |$re_close_paren 119 )/iogx ) 120 { 121 my $match = $1; 122 123 # Highest priority is last 124 my $current = 0; 125 $current = OP if ($want & OP) && $match =~ /^$re_op$/io; 126 $current = VALUE if ($want & VALUE) && $match =~ /^$re_value$/io; 127 $current = KEYWORD if ($want & KEYWORD) && $match =~ /^$re_keyword$/io; 128 $current = AGGREG if ($want & AGGREG) && $match =~ /^$re_aggreg$/io; 129 $current = OPEN_PAREN if ($want & OPEN_PAREN) && $match =~ /^$re_open_paren$/io; 130 $current = CLOSE_PAREN if ($want & CLOSE_PAREN) && $match =~ /^$re_close_paren$/io; 131 132 133 unless ($current && $want & $current) { 134 my $tmp = substr($string, 0, pos($string)- length($match)); 135 $tmp .= '>'. $match .'<--here'. substr($string, pos($string)); 136 my $msg = $loc->("Wrong query, expecting a [_1] in '[_2]'", _BitmaskToString($want), $tmp); 137 return $cb->{'Error'}->( $msg ) if $cb->{'Error'}; 138 die $msg; 139 } 140 141 # State Machine: 142 143 # Parens are highest priority 144 if ( $current & OPEN_PAREN ) { 145 $cb->{'OpenParen'}->(); 146 $depth++; 147 $want = KEYWORD | OPEN_PAREN; 148 } 149 elsif ( $current & CLOSE_PAREN ) { 150 $cb->{'CloseParen'}->(); 151 $depth--; 152 $want = AGGREG; 153 $want |= CLOSE_PAREN if $depth; 154 } 155 elsif ( $current & AGGREG ) { 156 $cb->{'EntryAggregator'}->( $match ); 157 $want = KEYWORD | OPEN_PAREN; 158 } 159 elsif ( $current & KEYWORD ) { 160 $key = $match; 161 $want = OP; 162 } 163 elsif ( $current & OP ) { 164 $op = $match; 165 $want = VALUE; 166 } 167 elsif ( $current & VALUE ) { 168 $value = $match; 169 170 # Remove surrounding quotes and unescape escaped 171 # characters from $key, $match 172 for ( $key, $value ) { 173 if ( /$re_delim/o ) { 174 substr($_,0,1) = ""; 175 substr($_,-1,1) = ""; 176 } 177 s!\\(.)!$1!g; 178 } 179 180 my $quote_value; 181 if ( $match =~ /$re_delim/o ) { 182 $quote_value = 1; 183 184 # It's really rare to search strings like "CF.foo", to DWIM, 185 # automatically convert to columns 186 if ( $value =~ /^CF\.(?:\{(.*)\}|(.*?))(?:\.(Content|LargeContent))?$/i ) { 187 RT->Logger->debug("Unquote value($match) to search custom field instead"); 188 $quote_value = 0; 189 } 190 } 191 elsif ( $match =~ /^[a-z]/i ) { 192 # Value is a column 193 $quote_value = 0; 194 } 195 else { 196 # Not setting value here to fallback to default behavior 197 } 198 199 $cb->{'Condition'}->( $key, $op, $value, $quote_value ); 200 201 ($key,$op,$value) = ("","",""); 202 $want = AGGREG; 203 $want |= CLOSE_PAREN if $depth; 204 } else { 205 my $msg = $loc->("Query parser is lost"); 206 return $cb->{'Error'}->( $msg ) if $cb->{'Error'}; 207 die $msg; 208 } 209 210 $last = $current; 211 } # while 212 213 unless( !$last || $last & (CLOSE_PAREN | VALUE) ) { 214 my $msg = $loc->("Incomplete query, last element ([_1]) is not close paren or value in '[_2]'", 215 _BitmaskToString($last), 216 $string); 217 return $cb->{'Error'}->( $msg ) if $cb->{'Error'}; 218 die $msg; 219 } 220 221 if( $depth ) { 222 my $msg = $loc->("Incomplete query, [quant,_1,unclosed paren,unclosed parens] in '[_2]'", $depth, $string); 223 return $cb->{'Error'}->( $msg ) if $cb->{'Error'}; 224 die $msg; 225 } 226} 227 228sub _BitmaskToString { 229 my $mask = shift; 230 231 my @res; 232 for( my $i = 0; $i<@tokens; $i++ ) { 233 next unless $mask & (1<<$i); 234 push @res, $tokens[$i]; 235 } 236 237 my $tmp = join ', ', splice @res, 0, -1; 238 unshift @res, $tmp if $tmp; 239 return join ' or ', @res; 240} 241 242RT::Base->_ImportOverlays(); 243 2441; 245