--- deliantra/server/lib/cf/match.pm	2009/10/11 18:18:03	1.11
+++ deliantra/server/lib/cf/match.pm	2009/11/03 23:44:21	1.24
@@ -1,3 +1,25 @@
+#
+# This file is part of Deliantra, the Roguelike Realtime MMORPG.
+# 
+# Copyright (©) 2009 Marc Alexander Lehmann / Robin Redeker / the Deliantra team
+# 
+# Deliantra is free software: you can redistribute it and/or modify it under
+# the terms of the Affero GNU General Public License as published by the
+# Free Software Foundation, either version 3 of the License, or (at your
+# option) any later version.
+# 
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+# 
+# You should have received a copy of the Affero GNU General Public License
+# and the GNU General Public License along with this program. If not, see
+# <http://www.gnu.org/licenses/>.
+# 
+# The authors can be reached via e-mail to <support@deliantra.net>
+#
+
 =head1 NAME
 
 cf::match - object matching language
@@ -27,9 +49,15 @@
 
    type=SPELL in type=POTION in inv
 
-Find all potions inside someones inventory, or inside applied containers:
+Find all scrolls inside someones inventory, or inside applied scroll
+containers:
+
+   type=SCROLL also in applied type=CONTAINER race="scroll" in inv
 
-   type=POTION also in type=CONTAINER and applied in inv
+Find all unpaid items, anywhere, even deeply nested inside other items, in
+the originator:
+
+   unpaid also deep in inv of originator
 
 =head1 MATCH EXPRESSIONS
 
@@ -40,23 +68,38 @@
 matches some desired properties:
 
    condition
-   condition in set
+   condition in set-modifier
+   condition of root-object
 
-A C<cond> receives a set of "context objects" that it is applied to. This
-is initially just one object - for altars, it is the object dropped on it,
-for pedestals, the object on top of it and so on.
+A C<condition> receives a set of "context objects" that it is applied
+to. This is initially just one object - by default, for altars, it is the
+object dropped on it, for pedestals, the object on top of it and so on.
 
 This set of context objects can be modified in various ways, for example
-by replacing it with the inventories of all objects, or all objects on the
+by replacing it with the inventories of all objects, or all items on the
 same mapspace, and so on, by using the C<in> operator:
 
    condition in inv
-   condition in inv in originator
+   condition in map
+
+Also, besides the default root object where all this begins, you can start
+elsewhere, for example in the I<originator> (usually the player):
+
+   condition in inv of originator
+
+Once the final set of context objects has been established, each object
+is matched against the C<condition>.
+
+It is possible to chain modifiers from right-to-left, so this example
+would start with the originator, take it's inventory, find all inventory
+items which are potions, looks into their inventory, and then finds all
+spells.
+
+   type=SPELL in type=POTION in inv of originator
 
-Once the set of context objects has been established, each object is
-matched against the C<cond> expression. Sometimes the server is only
-interested in knowing whether I<anything> matches, and sometimes the
-server is interested in I<all> objects that match.
+Sometimes the server is only interested in knowing whether I<anything>
+matches, and sometimes the server is interested in I<all> objects that
+match.
 
 =head2 OPERATORS
 
@@ -65,17 +108,32 @@
 =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-applied 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.
 
-   type=WEAPON and applied
+   applied type=WEAPON
 
 Example: match horns or rods.
 
    type=HORN or type=ROD
 
+Example: see if the originator is a player.
+
+   type=PLAYER of originator
+
 =item in ...
 
 The in operator takes the context set and modifies it in various ways. As
@@ -86,37 +144,6 @@
 
 =over 4
 
-=item in object
-
-Replaces all objects by the default object - this is the object passed to
-the match to match against by default. All matches have an explicit C<in
-ctx> appended.
-
-This must be the last C<in> expression in a match.
-
-=item in source
-
-Replaces all objects by the source object - this object is sometimes
-passed to matches and represents the object is the source of the action,
-such as a rod or a potion when it is applied. Often, the I<source> is the
-same as the I<originator>.
-
-This must be the last C<in> expression in a match.
-
-=item in originator
-
-Replaces all objects by the originator object - one step farther removed
-than the I<source>, the I<originator> is sometimes passed to matches and
-represents the original initiator of an action, most commonly a player or
-monster.
-
-=item in self
-
-Replaces all objects by the object initiating/asking for the match - this
-is basically always the object thatt he match expression is attached to.
-
-This must be the last C<in> expression in a match.
-
 =item in inv
 
 Replaces all objects by their inventory.
@@ -129,16 +156,24 @@
 
 Replaces all objects by their containing object, if they have one.
 
+=item in arch
+
+Replaces all objects by their archetypes.
+
 =item in map
 
 Replaces all objects by the objects that are on the same mapspace as them.
 
-=item in <cond>
+=item in head
+
+Replaces all objects by their head objects.
+
+=item in <condition>
 
 Finds all context objects matching the condition, and then puts their
 inventories into the context set.
 
-Note that C<in inv> is simply a special case of an C<< in <cond> >> that
+Note that C<in inv> is simply a special case of an C<< in <condition> >> that
 matches any object.
 
 Example: find all spells inside potions inside the inventory of the context
@@ -155,26 +190,68 @@
 
    type=SPELL also in inv
 
-=item repeatedly in ...
+=item also deep in ...
 
 Repeats the operation as many times as possible. This can be used to
 recursively look into objects.
 
-=item also repeatedly in ...
+So for example, C<also deep in inv> means to take the inventory of all
+objects, taking their inventories, and so on, and adding all these objects
+to the context set.
 
-C<also> and C<repeatedly> can be combined.
+Similarly, C<also deep in env> means to take the environment object, their
+environemnt object and so on.
 
 Example: check if there are any unpaid items in an inventory,
 or in the inventories of the inventory objects, and so on.
 
-   unpaid also repeatedly in inv
+   unpaid also deep in inv
 
 Example: check if a object is inside a player.
 
-   type=PLAYER also repeatedly in env
+   type=PLAYER also deep in env
 
 =back
 
+=item of ...
+
+By default, all matches are applied to the "obviously appropriate" object,
+such as the item dropped on a button or moving over a detector. This can
+be changed to a number of other objects - not all of them are available
+for each match (when not available, the match will simply fail).
+
+An C<of> term ends a match, nothing is allowed to follow.
+
+=over 4
+
+=item of object
+
+Starts with the default object - this is the object passed to the match to
+match against by default. Matches have an explicit C<of object> appended,
+but submatches start at the current object, and in this case C<of object>
+can be used to start at the original object once more.
+
+=item of source
+
+Starts with the I<source> object - this object is sometimes passed to
+matches and represents the object that is the source of the action, such
+as a rod or a potion when it is applied. Often, the I<source> is the same
+as the I<originator>.
+
+=item of originator
+
+Starts with the I<originator> - one step farther removed than the
+I<source>, the I<originator> is sometimes passed to matches and represents
+the original initiator of an action, most commonly a player or monster.
+
+This object is often identical to the I<source> (e.g. when a player casts
+a spell, the player is both source and originator).
+
+=item of self
+
+Starts with the object initiating/asking for the match - this is basically
+always the object that the match expression is attached to.
+
 =back
 
 =head2 EXPRESSIONS
@@ -252,6 +329,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.
@@ -262,19 +344,14 @@
 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
+=item dump()
 
 Dumps the object to the server log when executed, and evaluates to true.
 
 Note that logical operations are short-circuiting, so this only dumps
 potions:
 
-   type=POTION and dump
+   type=POTION and dump()
 
 =back
 
@@ -286,24 +363,25 @@
 
    # object matching and selecting
 
-   match     = set
-             | match also rep 'in' set
+   match     = chain
+             | chain 'of' root
+   root      = 'object' | 'self' | 'source' | 'originator'
+   chain     = condition
+             | chain also deep 'in' modifier
    also      = nothing | 'also'
-   rep       = nothing | 'rep' | 'repeatedly'
+   deep      = nothing | 'deep'
+   modifier  ='inv' | 'env' | 'arch' | 'map' | 'head'
 
-   set       = 'inv' | 'env' | 'map'
-             | 'object' | 'source' | 'originator' | 'self'
-
-   empty     =
+   nothing   =
 
    # boolean matching condition
 
    condition = factor
-             | factor 'and'? cond
-             | factor 'or'   cond
+             | factor 'and'? condition
+             | factor 'or'   condition
 
    factor    = 'not' factor
-             | '(' cond ')'
+             | '(' match ')'
              | expr
              | expr operator constant
 
@@ -312,6 +390,7 @@
    expr      = flag
              | sattr
              | aattr '[' <constant> ']'
+             | 'stat.' statattr
              | special
              | func '(' args ')'
              | '{' perl code block '}'
@@ -320,12 +399,13 @@
    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>
    args      = <depends on function>
 
-   TODO: repeatedly, env, contains, possbly matches
+   TODO: contains, matches, query_name, selling_price, buying_price?
 
 =cut
 
@@ -341,22 +421,11 @@
 
 use List::Util ();
 
-# parser state
-#   $_    # string to be parsed
-our $all; # find all, or just the first matching object
-
 {
    package cf::match::exec;
 
    use List::Util qw(first);
 
-   sub env_chain {
-      my @res;
-      push @res, $_
-         while $_ = $_->env;
-      @res
-   }
-
    package cf::match::parser;
 
    use common::sense;
@@ -365,23 +434,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 ('$_') . ')'
-      },
-   );
-
-   our %special = (
-      any => sub {
-         1
+         '(scalar ' . (match 1, '$_') . ')'
       },
       dump => sub {
          'do {
@@ -393,6 +454,15 @@
       },
    );
 
+   our %special = (
+      any => sub {
+         1
+      },
+      none => sub {
+         0
+      },
+   );
+
    sub constant {
       ws;
 
@@ -408,6 +478,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
@@ -420,6 +491,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}) {
@@ -457,6 +538,7 @@
          }
 
       } else {
+         Carp::cluck;#d#
          die "expr expected\n";
       }
 
@@ -483,9 +565,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;
@@ -506,16 +589,20 @@
       "($res)"
    }
 
-   sub condition {
+   sub condition () {
       my $res = factor;
 
       while () {
          ws;
-         if (/\G(?=also\b|in\b|\)|$)/gc) {
-            # early stop => faster and requires no backtracking
+
+         # first check some stop-symbols, so we don't have to backtrack
+         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;
+
          } elsif (/\Gor\b/gc) {
             $res .= " || ";
+
          } else {
             /\Gand\b/gc;
             $res .= " && ";
@@ -526,51 +613,95 @@
       $res
    }
 
-   sub match {
-      my $default = shift;
+   sub match ($$) {
+      my ($wantarray, $defctx) = @_;
 
-      my $res;
+      my $res = 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 . "}";
 
-      my $also; # undef means first iteration
       while () {
-         if (/\G\s*(inv|env|map|object|subject|originator)\b/gc) {
-            if ($1 eq "inv") {
-               $res .= " map+(${also}\$_->inv),";
-            } elsif ($1 eq "env") {
-               $res .= " map+(${also}env_chain), "; # TODO
-            } elsif ($1 eq "map") {
-               $res .= " map+(${also}\$_->map->at (\$_->x, \$_->y)),";
-            } elsif ($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";
+         ws;
+
+         my $also = /\Galso\s+/gc + 0;
+         my $deep = /\Gdeep\s+/gc + 0;
+
+         if (/\Gin\s+/gc) {
+            my $expand;
+
+            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
+               } elsif ($1 eq "map") {
+                  $expand = "map \$_->map->at (\$_->x, \$_->y),";
+                  $deep = 0; # infinite loop otherwise
+               }
+            } else {
+               $expand = "map \$_->inv, grep { " . condition . " }";
+            }
+
+            if ($also || $deep) {
+               $res .= " do {\n"
+                     . "   my \@res;\n";
+               $res .= "   while (\@_) {\n"       if $deep;
+               $res .= "      push \@res, \@_;\n" if $also;
+               $res .= "      \@_ = $expand \@_;\n";
+               $res .= "   }\n"                   if $deep;
+               $res .= "   (\@res, \@_)\n"
+                     . "}";
+            } else {
+               $res .= " $expand";
             }
-            last unless /\G\s*in\b/gc;
          } else {
-            $res .= " map+($also\$_->inv)," if defined $also;
-            $res .= $all ? " grep { " : " first {";
-            $res .= condition;
-            $res .= "}";
 
-            $also = /\G\s*also\b/gc ? '$_, ' : '';
-            last unless /\G\s*in\b/gc;
+            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";
+            }
          }
       }
-
-      "$res $default"
    }
-
 }
 
-sub parse($;$) {
-   local $_   = shift;
-   local $all = shift;
+sub parse($$) { # wantarray, matchexpr
+   my $res;
 
-   my $res = cf::match::parser::match "\$object";
+   local $_ = $_[1];
+
+   eval {
+      $res = cf::match::parser::match $_[0], "\$object";
+
+      /\G$/gc
+          or die "unexpected trailing characters after match\n";
+   };
 
    if ($@) {
       my $ctx = 20;
@@ -584,35 +715,21 @@
    $res
 }
 
-if (0) {
-   die parse 'match(any in object)', 1;
+if (0) {#d#
+   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,$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 {
          my (\$object, \$self, \$source, \$originator) = \@_;
-         \$originator ||= \$source;
          $expr
       }
    ";
@@ -621,15 +738,32 @@
    $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
    }
 }
 
+our $CACHE_CLEARER = AE::timer 3600, 3600, sub {
+   %CACHE = ();
+};
+
 #d# $::schmorp=cf::player::find "schmorp"&
 #d# cf::match::match '', $::schmorp->ob