%{

#
# Copyright (C) Motorola 2003 - All rights reserved
# Copyright (C) Crawford Currie 2004
#

=begin text

---++ class Search
Search operators work on the fields of a TWiki::Contrib::DBCacheContrib::Map. The fields are given by name, and the values by strings. Strings should always be surrounded by 'single-quotes'. String which are regular expressions use 'perl' re syntax (see =man perlre= for help)

*Warning* single and double quotes are not allowed in values!

The following operators are available:

| *Operator* | *LHS* | *RHS* | *Meaning* |
| <code>=</code> | field name | regular expression | Value exactly matches this regular expression. The expression must match the whole string. |
| <code>!=</code> | field name | regular expression | Field is not this RE. Inverse of = |
| <code>=~</code> | field name | regular expression | Value contains this regular expression i.e. the RE is found somewhere in the field value. |
| <code>&lt;</code> | field name | integer (string containing an integer e.g '4') | Number is < |
| <code>&gt;</code> | field name | integer | Number is > |
| <code>&gt;=</code> | field name | integer | Number is >= |
| <code>&lt;=</code> | field name | integer | Number is <= |
| <code>!</code> | none | expr | Boolean NOT |
| <code>AND</code> | expr | expr | Boolean AND |
| <code>OR</code> | expr | expr | Boolean OR |
| <code>()</code> | N/A | N/A | Bracketed subexpression |

A search object implements the "matches" method as its general
contract with the rest of the world.

---+++ Example
Get a list of attachments that have a date earlier than 1st January 2000
<verbatim>
  $db = new TWiki::Contrib::DBCacheContrib::DBCache( $web ); # always done
  $db->load();
  my $search = new TWiki::Contrib::DBCacheContrib::Search("date EARLIER_THAN '1st January 2000'");

  foreach my $topic ($db->getKeys()) {
     my $attachments = $topic->get("attachments");
     foreach my $val ($attachments->getValues()) {
       if ($search->matches($val)) {
          print $val->get("name") . "\n";
       }
     }
  }
</verbatim>

=cut


use TWiki::Plugins::SpreadSheetPlugin::Calc;
use TWiki::Func;

=begin text

---+++ =create($string)=
   * =$string= - string containing an expression to parse
Construct a new search node by parsing the passed expression.

=cut

  sub create {
    my ( $class, $string, $left, $op, $right, $evalright ) = @_;
    if ( defined( $string )) {
      if ( $string =~ m/^\s*$/o ) {
	return create Search( undef, undef, "TRUE", undef );
      } else {
	my $calc = new Search;
	$calc->YYData->{INPUT} = $string;
	return $calc->YYParse(yylex => \&Lexer);
      }
    } else {
      my $this;
      $this = bless( {}, $class );
      $this->{right} = $right;
      $this->{eval} = $evalright;
      $this->{left} = $left;
      $this->{op} = $op;
      return $this;
    }
  }



%}

%left  'OR'
%left  'AND'
%right '!'
%left  '=' '=~' '!=' '>=' '<=' '<' '>' 'EARLIER_THAN' 'LATER_THAN' 'WITHIN_DAYS' 'IS_DATE'

%%
input:  #empty
        |   line  { $_[1] }
;

line:   
           exp          { ++$_[0]->YYData->{LINE}; $_[1] }
	|  error 	{ ++$_[0]->YYData->{LINE}; undef }
;

prim:       NUM
        |   TERM
	|   QUOT
;

TERM:       PRIM                { $_[1] }
	|   CALC		{ create Search( undef, undef, 'calc', $_[1], undef ) }
;

exp:
            TERM '=' QUOT	{ create Search( undef, $_[1], $_[2], $_[3] ) }
	|   TERM '=~' QUOT	{ create Search( undef, $_[1], $_[2], $_[3] ) }
	|   TERM '!=' QUOT	{ create Search( undef, $_[1], $_[2], $_[3] ) }
        |   TERM '=' TERM	{ create Search( undef, $_[1], $_[2], $_[3], 1 ) }
	|   TERM '=~' TERM	{ create Search( undef, $_[1], $_[2], $_[3], 1 ) }
	|   TERM '!=' TERM	{ create Search( undef, $_[1], $_[2], $_[3], 1 ) }
	|   TERM '>=' QUOT	{ create Search( undef, $_[1], $_[2], $_[3] ) }
	|   TERM '<=' QUOT	{ create Search( undef, $_[1], $_[2], $_[3] ) }
	|   TERM '<' QUOT		{ create Search( undef, $_[1], $_[2], $_[3] ) }
	|   TERM '>' QUOT		{ create Search( undef, $_[1], $_[2], $_[3] ) }
	|   TERM 'EARLIER_THAN' QUOT	{ create Search( undef, $_[1], $_[2], $_[3] ) }
	|   TERM 'LATER_THAN' QUOT	{ create Search( undef, $_[1], $_[2], $_[3] ) }	
	|   TERM 'WITHIN_DAYS' QUOT	{ create Search( undef, $_[1], $_[2], $_[3] ) }
	|   TERM 'IS_DATE' QUOT	{ create Search( undef, $_[1], $_[2], $_[3] ) }
	|   TERM '>=' TERM	{ create Search( undef, $_[1], $_[2], $_[3], 1 ) }
	|   TERM '<=' TERM	{ create Search( undef, $_[1], $_[2], $_[3], 1 ) }
	|   TERM '<' TERM		{ create Search( undef, $_[1], $_[2], $_[3], 1 ) }
	|   TERM '>' TERM		{ create Search( undef, $_[1], $_[2], $_[3], 1 ) }
	|   PRIM		{ create Search( undef, "text", "=~", $_[1] ) }
	|   CALC		{ create Search( undef, undef, 'calc', $_[1], undef ) }
	|   '!' exp		{ create Search( undef, undef, $_[1], $_[2], undef ) }
	|   MATCH		{ create Search( undef, undef, 'match', $_[1], undef ) }
	|   exp 'AND' exp	{ create Search( undef, $_[1], $_[2], $_[3] ) }	
	|   exp 'OR' exp	{ create Search( undef, $_[1], $_[2], $_[3] ) }	
	|   '(' exp ')'		{ $_[2] }	
;

%%

sub Error {
    my($parser)=shift;

	push(@{$parser->YYData->{ERRLINES}}, $parser->YYData->{LINE});
}

sub Lexer {
    my($parser)=shift;

        exists($parser->YYData->{LINE})
    or  $parser->YYData->{LINE}=1;

        $parser->YYData->{INPUT}
    or  return('',undef);

    $parser->YYData->{INPUT}=~s/^[ \t]//;

    for ($parser->YYData->{INPUT}) {
        s/^([0-9]+(?:\.[0-9]+)?)// and return('NUM',$1);
	s/^(\'.*?\')// and return('QUOT',substr($1,1,-1));
	s/^(\=\~)// and return($1,$1);
	s/^(\=)// and return($1,$1);
	s/^(\!\=)// and return($1,$1);
	s/^(\>\=)// and return($1,$1);
	s/^(\>)// and return($1,$1);
	s/^(\<\=)// and return($1,$1);
	s/^(\<)// and return($1,$1);
	s/^(\!)// and return($1,$1);
	s/^(\()// and return($1,$1);
	s/^(\))// and return($1,$1);
	s/^(AND)// and return($1,$1);
	s/^(OR)// and return($1,$1);
	s/^\$CALC\(\"(.*?)\"\)// and return('CALC',$1);
        s/^(\w+\[\?.*?\])// and return('MATCH',$1);
        s/^(\w+(?:(?:\.\w+)|(?:\[[0-9]+\]))*)// and return('PRIM',$1);
    }
}

=begin text

---+++ =matches($object)= -> boolean
   * =$object= - object to test; must implement =get=
See if object matches the search. =$object= can actually be any object that provides
the method "get" that returns a value given a string key.

=cut
  sub matches {
    my ( $this, $map, $case ) = @_;

    my $op = $this->{op};

    return 1 if ( $op eq "TRUE" );

    my $r = $this->{right};
    return 0 unless ( defined( $r ));

    if ($op eq "!") { return !( $r->matches( $map, $case )) };

    if ($op eq "match") { 
      my $subfield = $map->get( $r );
      if ( defined( $subfield )) {
	if ( $subfield->isa( "TWiki::Contrib::DBCacheContrib::Array" ) && ($subfield->size() > 0) ) {
	  return $subfield;
	} else { return 0; }
      } else { return 0; }
    }

    if ($op eq "calc") {
	return _evalCalc($r, $map);
    }

    my $l = $this->{left};
    return 0 unless ( defined( $l ));

    if ( $op eq "OR" ) {  
      my $tmp = $l->matches( $map, $case );
      return $tmp if ($tmp || ! defined $tmp);
      return $r->matches( $map, $case );
    }
    if ( $op eq "AND" ) {
      my $tmp = $l->matches( $map, $case );
      return $tmp if (! $tmp && defined $tmp);
      return $r->matches( $map, $case );
    }

    return 0 unless ( defined( $map ));

    my $val;

    if ( ref($l) eq "Search" && $l->{op} eq "calc" ) {
      $val = _evalCalc($l->{right}, $map);
    } else {
      $val = $map->get( $l );
      # Compatibility: values have now moved down into the form for topics,
      # but we need this just in case the search specifier is "old style"
      unless ($val) {
	$val = $map->get($map->get("form"))->get( $l );
      }
      return 0 unless ( defined( $val ));
    }

    $val = undef unless $val;
    return $val unless ( $r );
    if ( ref($r) eq "Search" && $r->{op} eq "calc" ) {
      $r = _evalCalc($r->{right}, $map);
    } else {
      # expand variables
      $r = $map->get( $r ) if $this->{eval};
    }

    if ( $case ) {
      if ( $op eq "=" )  { return ( $val =~ m/^$r$/ ) };
      if ( $op eq "!=" ) { return ( $val !~ m/^$r$/ ) };
      if ( $op eq "=~" ) { return ( $val =~ m/$r/ ) };
    } else {
      if ( $op eq "=" )  { return ( $val =~ m/^$r$/i ) };
      if ( $op eq "!=" ) { return ( $val !~ m/^$r$/i ) };
      if ( $op eq "=~" ) { return ( $val =~ m/$r/i ) };
    }
    if ( $op eq ">" )  { return ( $val > $r ) };
    if ( $op eq "<" )  { return ( $val < $r ) };
    if ( $op eq ">=" ) { return ( $val >= $r ) };
    if ( $op eq "<=" ) { return ( $val <= $r ) };

    return 0;
  }

  sub _evalCalc {
    my ($calc, $map) = @_;
    # substitute for "$T(\s*xxx\s*)" the value of $map->get("xxx");
    # then evaluate calc
    $calc =~ s/\$T\(\s*(\w+(?:(?:\.\w+)|(?:\[[0-9]+\]))*)\s*\)/$map->get($1)/geos;
    return TWiki::Plugins::SpreadSheetPlugin::Calc::doCalc($calc);
  }

=begin text

---+++ =toString()= -> string
Generates a string representation of the object.

=cut

  sub toString {
    my $this = shift;

    my $text = "";
    if ( defined( $this->{left} )) {
      if ( !ref($this->{left}) ) {
	$text .= $this->{left}; 
      } else {
	$text .= "(" . $this->{left}->toString() . ")";
      }
      $text .= " ";
    }
    $text .= $this->{op} . " ";
    if ( !ref($this->{right}) ) {
      $text .= "'" . $this->{right} . "'"; 
    } else {
      $text .= "(" . $this->{right}->toString() . ")";
    }
    return $text;
  }