--- deliantra/server/lib/cf/match.pm	2009/10/13 15:58:19	1.19
+++ deliantra/server/lib/cf/match.pm	2009/10/24 11:45:40	1.22
@@ -86,8 +86,19 @@
 =item and, or, not, ()
 
 Conditions can be combined with C<and> or C<or> to build larger
-expressions. C<not> negates the expression, and parentheses can be used to
-group conditions.
+expressions. C<not> negates the condition, and parentheses can be used to
+override operator precedence and execute submatches.
+
+Not that C<not> only negates a condition and not the whole match
+expressions, thus
+
+   not applied in inv
+
+is true if there is I<any> non-object in the inventory. To negate a whole
+match, you have to use a sub-match. To check whether there is I<no>
+applied object in someones inventory, write this:
+
+   not (applied in inv)
 
 Example: match applied weapons.
 
@@ -127,6 +138,10 @@
 
 Replaces all objects by the objects that are on the same mapspace as them.
 
+=item in head
+
+Replaces all objects by their head objects.
+
 =item in <condition>
 
 Finds all context objects matching the condition, and then puts their
@@ -288,6 +303,11 @@
 This simply evaluates to true, and simply makes matching I<any> object a
 bit easier to read.
 
+=item none
+
+This simply evaluates to false, and simply makes matching I<never> a bit
+easier to read.
+
 =item has(condition)
 
 True iff the object has a matching inventory object.
@@ -298,11 +318,6 @@
 currently tested object - you can override this with an C<in object> for
 example.
 
-=item match(match)
-
-An independent match - semantics like C<count>, except it only matters
-whether the match finds any object (which is faster).
-
 =item dump()
 
 Dumps the object to the server log when executed, and evaluates to true.
@@ -326,12 +341,12 @@
              | chain 'of' root
    root      = 'object' | 'self' | 'source' | 'originator'
    chain     = condition
-             | chain also deep 'in' set
+             | chain also deep 'in' modifier
    also      = nothing | 'also'
    deep      = nothing | 'deep'
-   set       = 'inv' | 'env' | 'arch' | 'map'
+   modifier  ='inv' | 'env' | 'arch' | 'map' | 'head'
 
-   empty     =
+   nothing   =
 
    # boolean matching condition
 
@@ -340,7 +355,7 @@
              | factor 'or'   condition
 
    factor    = 'not' factor
-             | '(' condition ')'
+             | '(' match ')'
              | expr
              | expr operator constant
 
@@ -349,6 +364,7 @@
    expr      = flag
              | sattr
              | aattr '[' <constant> ']'
+             | 'stat.' statattr
              | special
              | func '(' args ')'
              | '{' perl code block '}'
@@ -357,6 +373,7 @@
    sattr     = <any scalar object attribute>
    aattr     = <any array object attribute>
    flag      = <any object flag>
+   statattr  = <any stat attribute: exp, food, str, dex, hp, maxhp...>
    special   = <any ()-less "function">
 
    constant  = <number> | '"' <string> '"' | <uppercase cf::XXX name>
@@ -378,10 +395,6 @@
 
 use List::Util ();
 
-# parser state
-#   $_    # string to be parsed
-our $all; # find all, or just the first matching object
-
 {
    package cf::match::exec;
 
@@ -395,17 +408,15 @@
       /\G\s+/gc;
    }
 
+   sub condition ();
+   sub match ($$);
+
    our %func = (
       has => sub {
-         'first { ' . &condition . ' } $_->inv'
+         'first { ' . condition . ' } $_->inv'
       },
       count => sub {
-         local $all = 1;
-         '(scalar ' . &match ('$_') . ')'
-      },
-      match => sub {
-         local $all = 0;
-         '(scalar ' . &match ('$_') . ')'
+         '(scalar ' . (match 1, '$_') . ')'
       },
       dump => sub {
          'do {
@@ -421,6 +432,9 @@
       any => sub {
          1
       },
+      none => sub {
+         0
+      },
    );
 
    sub constant {
@@ -438,6 +452,7 @@
    our $flag  = $cf::REFLECT{object}{flags};
    our $sattr = $cf::REFLECT{object}{scalars};
    our $aattr = $cf::REFLECT{object}{arrays};
+   our $lattr = $cf::REFLECT{living}{scalars};
 
    sub expr {
       # ws done by factor
@@ -450,6 +465,16 @@
 
          $res .= $expr =~ /\{([^;]+)\}/ ? $1 : "do $expr";
 
+      } elsif (/\Gstats\.([A-Za-z0-9_]+)/gc) {
+
+         if (exists $lattr->{$1}) {
+            $res .= "\$_->stats->$1";
+         } elsif (exists $lattr->{"\u$1"}) {
+            $res .= "\$_->stats->\u$1";
+         } else {
+            die "living statistic name expected (str, pow, hp, sp...)\n";
+         }
+
       } elsif (/\G([A-Za-z0-9_]+)/gc) {
 
          if (my $func = $func{$1}) {
@@ -487,6 +512,7 @@
          }
 
       } else {
+         Carp::cluck;#d#
          die "expr expected\n";
       }
 
@@ -513,9 +539,10 @@
 
       if (/\G\(/gc) {
          # ()
-         $res .= &condition;
-         ws;
-         /\G\)/gc or die "')' expected\n";
+
+         $res .= '(' . (match 0, '$_') . ')';
+
+         /\G\s*\)/gc or die "closing ')' expected\n";
 
       } else {
          my $expr = expr;
@@ -536,14 +563,14 @@
       "($res)"
    }
 
-   sub condition {
+   sub condition () {
       my $res = factor;
 
       while () {
          ws;
 
          # first check some stop-symbols, so we don't have to backtrack
-         if (/\G(?=also\b|deep\b|in\b|of\b\)|\z)/gc) {
+         if (/\G(?=also\b|deep\b|in\b|of\b|\)|\z)/gc) {
             pos = pos; # argh. the misop hits again. again. again. again. you die.
             last;
 
@@ -560,10 +587,20 @@
       $res
    }
 
-   sub match {
-      my $default = shift;
+   sub match ($$) {
+      my ($wantarray, $defctx) = @_;
+
+      my $res = condition;
 
-      my $res = ($all ? " grep { " : " first {") . condition . " }";
+      # if nothing follows, we have a simple condition, so
+      # optimise a comon case.
+      if ($defctx eq '$_' and /\G\s*(?=\)|$)/gc) {
+         return $wantarray
+                ? "$res ? \$_ : ()"
+                : $res;
+      }
+
+      $res = ($wantarray ? " grep { " : " first { ") . $res . "}";
 
       while () {
          ws;
@@ -574,11 +611,14 @@
          if (/\Gin\s+/gc) {
             my $expand;
 
-            if (/\G(inv|env|map|arch)\b/gc) {
+            if (/\G(inv|env|map|arch|head)\b/gc) {
                if ($1 eq "inv") {
                   $expand = "map \$_->inv,";
                } elsif ($1 eq "env") {
                   $expand = "map \$_->env // (),";
+               } elsif ($1 eq "head") {
+                  $expand = "map \$_->head,";
+                  $deep = 0; # infinite loop otherwise
                } elsif ($1 eq "arch") {
                   $expand = "map \$_->arch,";
                   $deep = 0; # infinite loop otherwise
@@ -602,34 +642,36 @@
             } else {
                $res .= " $expand";
             }
-         } elsif (/\Gof\s+(self|object|source|originator)\b/gc) {
-            $also || $deep
-               and die "neither 'also' nor 'deep' can be used with 'of'\n";
-
-            if ($1 eq "self") {
-               return "$res \$self // ()";
-            } elsif ($1 eq "object") {
-               return "$res \$object";
-            } elsif ($1 eq "source") {
-               return "$res \$source // ()";
-            } elsif ($1 eq "originator") {
-               return "$res \$originator // \$source // ()";
-            }
          } else {
-            return "$res $default";
+
+            if (/\Gof\s+(self|object|source|originator)\b/gc) {
+               $also || $deep
+                  and die "neither 'also' nor 'deep' can be used with 'of'\n";
+
+               if ($1 eq "self") {
+                  return "$res \$self // ()";
+               } elsif ($1 eq "object") {
+                  return "$res \$object";
+               } elsif ($1 eq "source") {
+                  return "$res \$source // ()";
+               } elsif ($1 eq "originator") {
+                  return "$res \$originator // \$source // ()";
+               }
+            } else {
+               return "$res $defctx";
+            }
          }
       }
    }
 }
 
-sub parse($;$) {
-   local $_   = shift;
-   local $all = shift;
-
+sub parse($$) { # wantarray, matchexpr
    my $res;
 
+   local $_ = $_[1];
+
    eval {
-      $res = cf::match::parser::match "\$object";
+      $res = cf::match::parser::match $_[0], "\$object";
 
       /\G$/gc
           or die "unexpected trailing characters after match\n";
@@ -648,29 +690,16 @@
 }
 
 if (0) {#d#
-   die parse 'type=SPELL_EFFECT and match(name="bullet" in arch)', 1;
+   die parse 1, 'stats.pow';
    exit 0;
 }
 
-=item cf::match::match $match, $object[, $self[, $source[, $originator]]]
-
-Compiles (and caches) the C<$match> expression and matches it against
-the C<$object>. C<$self> should be the object initiating the match (or
-C<undef>), C<$source> should be the actor/source and C<$originator> the
-object that initiated the action (such as the player). C<$originator>
-defaults to C<$source> when not given.
-
-In list context it finds and returns all matching objects, in scalar
-context only a true or false value.
-
-=cut
-
 our %CACHE;
 
 sub compile($$) {
-   my ($match, $all) = @_;
-   my $expr = parse $match, $all;
-   warn "MATCH DEBUG $match,$all => $expr\n";#d#
+   my ($wantarray, $match) = @_;
+   my $expr = parse $wantarray, $match;
+   warn "MATCH DEBUG $match,$wantarray => $expr\n";#d#
    $expr = eval "
       package cf::match::exec;
       sub {
@@ -683,12 +712,25 @@
    $expr
 }
 
+=item cf::match::match $match, $object[, $self[, $source[, $originator]]]
+
+Compiles (and caches) the C<$match> expression and matches it against
+the C<$object>. C<$self> should be the object initiating the match (or
+C<undef>), C<$source> should be the actor/source and C<$originator> the
+object that initiated the action (such as the player). C<$originator>
+defaults to C<$source> when not given.
+
+In list context it finds and returns all matching objects, in scalar
+context only a true or false value.
+
+=cut
+
 sub match($$;$$$) {
-   my $match = shift;
-   my $all = wantarray+0;
+   my $match     = shift;
+   my $wantarray = wantarray+0;
 
    &{
-      $CACHE{"$all$match"} ||= compile $match, $all
+      $CACHE{"$wantarray$match"} ||= compile $wantarray, $match
    }
 }