1# Module of TWiki Enterprise Collaboration Platform, http://TWiki.org/
2#
3# Copyright (C) 2005-2018 Peter Thoeny, peter[at]thoeny.org
4# and TWiki Contributors. All Rights Reserved. TWiki Contributors
5# are listed in the AUTHORS file in the root of this distribution.
6# NOTE: Please extend that file, not this notice.
7#
8# This program is free software; you can redistribute it and/or
9# modify it under the terms of the GNU General Public License
10# as published by the Free Software Foundation; either version 3
11# of the License, or (at your option) any later version. For
12# more details read LICENSE in the root of this distribution.
13#
14# This program is distributed in the hope that it will be useful,
15# but WITHOUT ANY WARRANTY; without even the implied warranty of
16# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
17#
18# As per the GPL, removal of this notice is prohibited.
19#
20# Author: Crawford Currie http://c-dot.co.uk
21
22=pod
23
24---+ package TWiki::Query
25
26A Query object is a representation of a query over the TWiki database.
27
28Fields are given by name, and values by strings or numbers. Strings should always be surrounded by 'single-quotes'. Numbers can be signed integers or decimals. Single quotes in values may be escaped using backslash (\).
29
30See TWiki.QuerySearch for details of the query language. At the time of writing
31only a subset of the entire query language is supported, for use in searching.
32
33A query object implements the =evaluate= method as its general
34contract with the rest of the world. This method does a "hard work" evaluation
35of the parser tree. Of course, smarter Store implementations should be
36able to do it better....
37
38=cut
39
40package TWiki::Query::Node;
41use base 'TWiki::Infix::Node';
42
43use Assert;
44use Error qw( :try );
45
46# 1 for debug
47sub MONITOR_EVAL { 0 };
48
49=pod
50
51---++ PUBLIC $aliases
52A hash mapping short aliases for META: entry names. For example, this hash
53maps 'form' to 'META:FORM'. Published so extensions can extend the range
54of supported types.
55
56---++ PUBLIC %isArrayType
57Maps META: entry type names to true if the type is an array type (such as
58FIELD, ATTACHMENT or PREFERENCE). Published so extensions can extend the range
59or supported types. The type name should be given without the leading 'META:'
60
61=cut
62
63use vars qw ( %aliases %isArrayType );
64
65%aliases = (
66    attachments => 'META:FILEATTACHMENT',
67    fields      => 'META:FIELD',
68    form        => 'META:FORM',
69    info        => 'META:TOPICINFO',
70    moved       => 'META:TOPICMOVED',
71    parent      => 'META:TOPICPARENT',
72    preferences => 'META:PREFERENCE',
73   );
74
75%isArrayType =
76  map { $_ => 1 } ( 'FILEATTACHMENT', 'FIELD', 'PREFERENCE' );
77
78# $data is the indexed object
79# $field is the scalar being used to index the object
80sub _getField {
81    my( $this, $data, $field ) = @_;
82
83    my $result;
84    if (UNIVERSAL::isa($data, 'TWiki::Meta')) {
85        # The object being indexed is a TWiki::Meta object, so
86        # we have to use a different approach to treating it
87        # as an associative array. The first thing to do is to
88        # apply our "alias" shortcuts.
89        my $realField = $field;
90        if( $aliases{$field} ) {
91            $realField = $aliases{$field};
92        }
93        if ($realField =~ s/^META://) {
94            if ($isArrayType{$realField}) {
95                # Array type, have to use find
96                my @e = $data->find( $realField );
97                $result = \@e;
98            } else {
99                $result = $data->get( $realField );
100            }
101        } elsif ($realField eq 'name') {
102            # Special accessor to compensate for lack of a topic
103            # name anywhere in the saved fields of meta
104            return $data->topic();
105        } elsif ($realField eq 'topictitle') {
106            # Special accessor to compensate for lack of a topic
107            # name anywhere in the saved fields of meta
108            return $data->topicTitle();
109        } elsif ($realField eq 'text') {
110            # Special accessor to compensate for lack of the topic text
111            # name anywhere in the saved fields of meta
112            return $data->text();
113        } elsif ($realField eq 'web') {
114            # Special accessor to compensate for lack of a web
115            # name anywhere in the saved fields of meta
116            return $data->web();
117        } else {
118            # The field name isn't an alias, check to see if it's
119            # the form name
120            my $form = $data->get( 'FORM' );
121            if( $form && $field eq $form->{name}) {
122                # SHORTCUT;it's the form name, so give me the fields
123                # as if the 'field' keyword had been used.
124                # TODO: This is where multiple form support needs to reside.
125                # Return the array of FIELD for further indexing.
126                my @e = $data->find( 'FIELD' );
127                return \@e;
128            } else {
129                # SHORTCUT; not a predefined name; assume it's a field
130                # 'name' instead.
131                # SMELL: Needs to error out if there are multiple forms -
132                # or perhaps have a heuristic that gives access to the
133                # uniquely named field.
134                $result = $data->get( 'FIELD', $field );
135                $result = $result->{value} if $result;
136            }
137        }
138    } elsif( ref( $data ) eq 'ARRAY' ) {
139        # Indexing an array object. The index will be one of:
140        # 1. An integer, which is an implicit index='x' query
141        # 2. A name, which is an implicit name='x' query
142        if( $field =~ /^\d+$/ ) {
143            # Integer index
144            $result = $data->[$field];
145        } else {
146            # String index
147            my @res;
148            # Get all array entries that match the field
149            foreach my $f ( @$data ) {
150                my $val = $this->_getField( $f, $field );
151                push( @res, $val ) if defined( $val );
152            }
153            if (scalar( @res )) {
154                $result = \@res;
155            } else {
156                # The field name wasn't explicitly seen in any of the records.
157                # Try again, this time matching 'name' and returning 'value'
158                foreach my $f ( @$data ) {
159                    next unless ref($f) eq 'HASH';
160                    if ($f->{name} && $f->{name} eq $field
161                          && defined $f->{value}) {
162                        push( @res, $f->{value} );
163                    }
164                }
165                if (scalar( @res )) {
166                    $result = \@res;
167                }
168            }
169        }
170    } elsif( ref( $data ) eq 'HASH' ) {
171        $result = $data->{$this->{params}[0]};
172    } else {
173        $result = $this->{params}[0];
174    }
175    return $result;
176}
177
178# <DEBUG SUPPORT>
179sub toString {
180    my ($a) = @_;
181    return 'undef' unless defined($a);
182    if (ref($a) eq 'ARRAY') {
183        return '['.join(',', map { toString($_) } @$a).']'
184    } elsif (UNIVERSAL::isa($a, 'TWiki::Meta')) {
185        return $a->stringify();
186    } elsif (ref($a) eq 'HASH') {
187        return '{'.join(',', map { "$_=>".toString($a->{$_}) } keys %$a).'}'
188    } else {
189        return $a;
190    }
191}
192
193my $ind = 0;
194# </DEBUG SUPPORT>
195
196# Evalute this node by invoking the operator function named in the 'exec'
197# field of the operator. The return result is either an array ref (for many
198# results) or a scalar (for a single result)
199sub evaluate {
200    my $this = shift;
201    ASSERT( scalar(@_) % 2 == 0);
202    my $result;
203
204    print STDERR ('-' x $ind).$this->stringify() if MONITOR_EVAL;
205
206    if (!ref( $this->{op})) {
207        my %domain = @_;
208        if ($this->{op} == $TWiki::Infix::Node::NAME &&
209              defined $domain{data}) {
210            # a name; look it up in clientData
211            $result = $this->_getField( $domain{data}, $this->{params}[0]);
212        } else {
213            $result = $this->{params}[0];
214        }
215    } else {
216        print STDERR " {\n" if MONITOR_EVAL;
217        $ind++ if MONITOR_EVAL;
218        $result = $this->{op}->evaluate( $this, @_ );
219        $ind-- if MONITOR_EVAL;
220        print STDERR ('-' x $ind).'}' if MONITOR_EVAL;
221    }
222    print STDERR ' -> ',toString($result),"\n" if MONITOR_EVAL;
223
224    return $result;
225}
226
2271;
228