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