lib/cf/match.pm

=head1 NAME

cf::match - object matching language

=head1 DESCRIPTION

This module implements a simple object matching language. It can be asked
to find any ("check for a match"), or all ("find all objects") matching
objects.

=head1 MATCH EXAMPLES

Match the object if it has a slaying field of C<key1>:

   slaying = "key1"

Match the object if it has an object with name C<force> and 
slaying C<poison> in it's inventory:

   has (name = "force" and slaying = "poison")

Find all inventory objects with value >= 10, which are not invisible:

   value >= 10 and not invisible in inv

Find all potions with spell objects inside them in someones inventory:

   type=SPELL in type=POTION in inv

Find all scrolls inside someones inventory, or inside applied scroll
containers:

   type=SCROLL also in applied type=CONTAINER race="scroll" 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

=head2 STRUCTURE

The two main structures are the C<match>, which selects objects matching
various criteria, and the C<condition, which determines if an object
matches some desired properties:

   condition
   condition in set-modifier
   condition of root-object

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 items on the
same mapspace, and so on, by using the C<in> operator:

   condition in inv
   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

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

=over 4

=item and, or, not, ()

Conditions can be combined with C<and> or C<or> to build larger
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.

   applied type=WEAPON

Example: match horns or rods.

   type=HORN or type=ROD

=item in ...

The in operator takes the context set and modifies it in various ways. As
a less technical description, think of the C<in> as being a I<look into>
or I<look at> operator - instead of looking at whatever was provided to
the match, the C<in> operator lets you look at other sets of objects, most
often the inventory.

=over 4

=item in inv

Replaces all objects by their inventory.

Example: find all spell objects inside the object to be matched.

   type=SPELL in inv

=item in env

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 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 <condition> >> that
matches any object.

Example: find all spells inside potions inside the inventory of the context
object(s).

   type=SPELL in type=POTION in inv

=item also in ...

Instead of replacing the context set with something new, the new objects
are added to the existing set.

Example: check if the context object I<is> a spell, or I<contains> a spell.

   type=SPELL also in inv

=item also deep in ...

Repeats the operation as many times as possible. This can be used to
recursively look into objects.

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.

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 deep in inv

Example: check if a object is inside a player.

   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

Expressions used in conditions usually consist of simple boolean checks
(flag XYZ is set) or simple comparisons.

=over 4

=item flags

Flag names (without the leading C<FLAG_>) can be used as-is, in which case
their corresponding flag value is used.

=item scalar object attributes

Object attributes that consist of a single value (C<name>, C<title>,
C<value> and so on) can be specified by simply using their name, in which
acse their corresponding value is used.

=item array objects attributes

The C<resist> array can be accessed by specifying C<< resist [ ATNR_type ]
>>.

Example: match an acid resistance higher than 30.

   resist[ATNR_ACID] > 30

=item functions

Some additional functions with or without arguments in parentheses are
available.

=item { BLOCK }

You can specify perl code to execute by putting it inside curly
braces. The last expression evaluated inside will become the result.

The perlcode can access C<$_>, which rferes to the object currently being
matches, and the C<$object>, C<$self>, C<$source> and C<$originator>.

Example: check whether the slaying field consists of digits only.

   { $_->slaying =~ /^\d+$/ }

=item comparisons, <, <=, ==, =, !=, =>, >

You can compare expressions against constants via any of these
operators. If the constant is a string, then a string compare will be
done, otherwise a numerical comparison is used.

Example: match an object with name "schnops" that has a value >= 10.

   name="schnops" and value >= 10

=item uppercase constant names

Any uppercase word that exists as constant inside the C<cf::> namespace
(that is, any deliantra constant) can also be used as-is, but needs to be
specified in uppercase.

Example: match a type of POTION (using C<cf::POTION>).

   type=POTION

=back

=head2 FUNCTIONS

=over 4

=item any

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.

=item count(match)

Number of matching objects - the context object for the C<match> is the
currently tested object - you can override this with an C<in object> for
example.

=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()

=back

=head2 GRAMMAR

This is the grammar that was used to implement the matching language
module. It is meant to be easily readable by humans, not to implement it
exactly as-is.

   # object matching and selecting

   match     = chain
             | chain 'of' root
   root      = 'object' | 'self' | 'source' | 'originator'
   chain     = condition
             | chain also deep 'in' modifier
   also      = nothing | 'also'
   deep      = nothing | 'deep'
   modifier  ='inv' | 'env' | 'arch' | 'map' | 'head'

   nothing   =

   # boolean matching condition

   condition = factor
             | factor 'and'? condition
             | factor 'or'   condition

   factor    = 'not' factor
             | '(' match ')'
             | expr
             | expr operator constant

   operator  = '=' | '==' | '!=' | '<' | '<=' | '>' | '>='

   expr      = flag
             | sattr
             | aattr '[' <constant> ']'
             | 'stat.' statattr
             | special
             | func '(' args ')'
             | '{' perl code block '}'

   func      = <any function name>
   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: contains, matches, query_name, selling_price, buying_price?

=cut

=head2 PERL FUNCTIONS

=over 4

=cut

package cf::match;

use common::sense;

use List::Util ();

{
   package cf::match::exec;

   use List::Util qw(first);

   package cf::match::parser;

   use common::sense;

   sub ws {
      /\G\s+/gc;
   }

   sub condition ();
   sub match ($$);

   our %func = (
      has => sub {
         'first { ' . condition . ' } $_->inv'
      },
      count => sub {
         '(scalar ' . (match 1, '$_') . ')'
      },
      dump => sub {
         'do {
            warn "cf::match::match dump:\n"
               . "self: " . eval { $self->name } . "\n"
               . $_->as_string;
            1
         }';
      },
   );

   our %special = (
      any => sub {
         1
      },
      none => sub {
         0
      },
   );

   sub constant {
      ws;

      return $1       if /\G([\-\+0-9\.]+)/gc;
      return "cf::$1" if /\G([A-Z0-9_]+)/gc;

      #TODO better string parsing, also include ''
      return $1       if /\G("[^"]+")/gc;

      die "number, string or uppercase constant name expected\n";
   }

   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
      my $res;

      if (/\G ( \{ (?: (?> [^{}]+ ) | (?-1) )* \} ) /gcx) {
         # perl

         my $expr = $1;

         $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}) {
            /\G\s*\(/gc
               or die "'(' expected after function name\n";

            $res .= $func->();

            /\G\s*\)/gc
               or die "')' expected after function arguments\n";

         } elsif (my $func = $special{$1}) {
            $res .= $func->();

         } elsif (exists $flag->{lc $1}) {
            $res .= "\$_->flag (cf::FLAG_\U$1)";

         } elsif (exists $sattr->{$1}) {
            $res .= "\$_->$1";

         } elsif (exists $aattr->{$1}) {

            $res .= "\$_->$1";

            /\G\s*\[/gc
               or die "'[' expected after array name\n";

            $res .= "(" . constant . ")";

            /\G\s*\]/gc
               or die "']' expected after array index\n";

         } else {
            $res .= constant;
         }

      } else {
         Carp::cluck;#d#
         die "expr expected\n";
      }

      $res
   }

   our %stringop = (
      "==" => "eq",
      "!=" => "ne",
      "<=" => "le",
      ">=" => "ge",
      "<"  => "lt",
      ">"  => "gt",
   );

   sub factor {
      ws;

      my $res;

      if (/\Gnot\b\s*/gc) {
         $res .= "!";
      }

      if (/\G\(/gc) {
         # ()

         $res .= '(' . (match 0, '$_') . ')';

         /\G\s*\)/gc or die "closing ')' expected\n";

      } else {
         my $expr = expr;

         $res .= $expr;

         if (/\G\s*([=!<>]=?)/gc) {
            my $op = $1;

            $op = "==" if $op eq "=";
            my $const = constant;
            $op = $stringop{$op} if $const =~ /^"/;

            $res .= " $op $const";
         }
      }

      "($res)"
   }

   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) {
            pos = pos; # argh. the misop hits again. again. again. again. you die.
            last;

         } elsif (/\Gor\b/gc) {
            $res .= " || ";

         } else {
            /\Gand\b/gc;
            $res .= " && ";
         }
         $res .= factor;
      }

      $res
   }

   sub match ($$) {
      my ($wantarray, $defctx) = @_;

      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 . "}";

      while () {
         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";
            }
         } else {

            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($$) { # wantarray, matchexpr
   my $res;

   local $_ = $_[1];

   eval {
      $res = cf::match::parser::match $_[0], "\$object";

      /\G$/gc
          or die "unexpected trailing characters after match\n";
   };

   if ($@) {
      my $ctx = 20;
      my $str = substr $_, (List::Util::max 0, (pos) - $ctx), $ctx * 2;
      substr $str, (List::Util::min $ctx, pos), 0, "<-- HERE -->";

      chomp $@;
      die "$@ ($str)\n";
   }

   $res
}

if (0) {#d#
   die parse 1, 'stats.pow';
   exit 0;
}

our %CACHE;

sub compile($$) {
   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) = \@_;
         $expr
      }
   ";
   die if $@;

   $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 $wantarray = wantarray+0;

   &{
      $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


=back

=head1 AUTHOR

 Marc Lehmann <schmorp@schmorp.de>
 http://home.schmorp.de/

=cut

1;

Revision:	1.22
Committed:	Sat Oct 24 11:45:40 2009 UTC (14 years, 8 months ago) by root
Branch:	MAIN
Changes since 1.21:	+14 -1 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.1	=head1 NAME
2
3			cf::match - object matching language
4
5			=head1 DESCRIPTION
6
7			This module implements a simple object matching language. It can be asked
8	root	1.9	to find any ("check for a match"), or all ("find all objects") matching
9			objects.
10	root	1.1
11			=head1 MATCH EXAMPLES
12
13			Match the object if it has a slaying field of C<key1>:
14
15			slaying = "key1"
16
17			Match the object if it has an object with name C<force> and
18			slaying C<poison> in it's inventory:
19
20			has (name = "force" and slaying = "poison")
21
22	root	1.4	Find all inventory objects with value >= 10, which are not invisible:
23	root	1.1
24	root	1.4	value >= 10 and not invisible in inv
25	root	1.1
26			Find all potions with spell objects inside them in someones inventory:
27
28			type=SPELL in type=POTION in inv
29
30	root	1.12	Find all scrolls inside someones inventory, or inside applied scroll
31			containers:
32	root	1.1
33	root	1.12	type=SCROLL also in applied type=CONTAINER race="scroll" in inv
34
35			Find all unpaid items, anywhere, even deeply nested inside other items, in
36			the originator:
37
38			unpaid also deep in inv of originator
39	root	1.1
40	root	1.9	=head1 MATCH EXPRESSIONS
41	root	1.1
42			=head2 STRUCTURE
43
44	root	1.9	The two main structures are the C<match>, which selects objects matching
45			various criteria, and the C<condition, which determines if an object
46			matches some desired properties:
47
48			condition
49	root	1.12	condition in set-modifier
50			condition of root-object
51	root	1.9
52	root	1.12	A C<condition> receives a set of "context objects" that it is applied
53			to. This is initially just one object - by default, for altars, it is the
54			object dropped on it, for pedestals, the object on top of it and so on.
55	root	1.1
56			This set of context objects can be modified in various ways, for example
57	root	1.12	by replacing it with the inventories of all objects, or all items on the
58	root	1.9	same mapspace, and so on, by using the C<in> operator:
59
60			condition in inv
61	root	1.12	condition in map
62
63			Also, besides the default root object where all this begins, you can start
64			elsewhere, for example in the I<originator> (usually the player):
65
66			condition in inv of originator
67	root	1.1
68	root	1.12	Once the final set of context objects has been established, each object
69			is matched against the C<condition>.
70
71	root	1.19	It is possible to chain modifiers from right-to-left, so this example
72			would start with the originator, take it's inventory, find all inventory
73			items which are potions, looks into their inventory, and then finds all
74			spells.
75
76			type=SPELL in type=POTION in inv of originator
77
78	root	1.12	Sometimes the server is only interested in knowing whether I<anything>
79			matches, and sometimes the server is interested in I<all> objects that
80			match.
81	root	1.1
82			=head2 OPERATORS
83
84			=over 4
85
86			=item and, or, not, ()
87
88	root	1.9	Conditions can be combined with C<and> or C<or> to build larger
89	root	1.20	expressions. C<not> negates the condition, and parentheses can be used to
90			override operator precedence and execute submatches.
91
92			Not that C<not> only negates a condition and not the whole match
93			expressions, thus
94
95			not applied in inv
96
97			is true if there is I<any> non-object in the inventory. To negate a whole
98			match, you have to use a sub-match. To check whether there is I<no>
99			applied object in someones inventory, write this:
100
101			not (applied in inv)
102	root	1.1
103			Example: match applied weapons.
104
105	root	1.12	applied type=WEAPON
106	root	1.1
107			Example: match horns or rods.
108
109			type=HORN or type=ROD
110
111			=item in ...
112
113	root	1.8	The in operator takes the context set and modifies it in various ways. As
114			a less technical description, think of the C<in> as being a I<look into>
115			or I<look at> operator - instead of looking at whatever was provided to
116			the match, the C<in> operator lets you look at other sets of objects, most
117			often the inventory.
118	root	1.1
119			=over 4
120
121			=item in inv
122
123			Replaces all objects by their inventory.
124
125			Example: find all spell objects inside the object to be matched.
126
127			type=SPELL in inv
128
129			=item in env
130
131			Replaces all objects by their containing object, if they have one.
132
133	root	1.14	=item in arch
134
135			Replaces all objects by their archetypes.
136
137	root	1.1	=item in map
138
139			Replaces all objects by the objects that are on the same mapspace as them.
140
141	root	1.21	=item in head
142
143			Replaces all objects by their head objects.
144
145	root	1.15	=item in <condition>
146	root	1.1
147	root	1.9	Finds all context objects matching the condition, and then puts their
148			inventories into the context set.
149	root	1.1
150	root	1.15	Note that C<in inv> is simply a special case of an C<< in <condition> >> that
151	root	1.1	matches any object.
152
153			Example: find all spells inside potions inside the inventory of the context
154			object(s).
155
156			type=SPELL in type=POTION in inv
157
158			=item also in ...
159
160			Instead of replacing the context set with something new, the new objects
161			are added to the existing set.
162
163			Example: check if the context object I<is> a spell, or I<contains> a spell.
164
165			type=SPELL also in inv
166
167	root	1.16	=item also deep in ...
168	root	1.1
169			Repeats the operation as many times as possible. This can be used to
170			recursively look into objects.
171
172	root	1.16	So for example, C<also deep in inv> means to take the inventory of all
173			objects, taking their inventories, and so on, and adding all these objects
174			to the context set.
175	root	1.1
176	root	1.16	Similarly, C<also deep in env> means to take the environment object, their
177			environemnt object and so on.
178	root	1.1
179			Example: check if there are any unpaid items in an inventory,
180			or in the inventories of the inventory objects, and so on.
181
182	root	1.12	unpaid also deep in inv
183	root	1.1
184			Example: check if a object is inside a player.
185
186	root	1.12	type=PLAYER also deep in env
187	root	1.1
188			=back
189
190	root	1.12	=item of ...
191
192			By default, all matches are applied to the "obviously appropriate" object,
193			such as the item dropped on a button or moving over a detector. This can
194			be changed to a number of other objects - not all of them are available
195			for each match (when not available, the match will simply fail).
196
197			An C<of> term ends a match, nothing is allowed to follow.
198
199			=over 4
200
201			=item of object
202
203			Starts with the default object - this is the object passed to the match to
204			match against by default. Matches have an explicit C<of object> appended,
205			but submatches start at the current object, and in this case C<of object>
206			can be used to start at the original object once more.
207
208			=item of source
209
210			Starts with the I<source> object - this object is sometimes passed to
211			matches and represents the object that is the source of the action, such
212			as a rod or a potion when it is applied. Often, the I<source> is the same
213			as the I<originator>.
214
215			=item of originator
216
217			Starts with the I<originator> - one step farther removed than the
218			I<source>, the I<originator> is sometimes passed to matches and represents
219			the original initiator of an action, most commonly a player or monster.
220
221			This object is often identical to the I<source> (e.g. when a player casts
222			a spell, the player is both source and originator).
223
224			=item of self
225
226			Starts with the object initiating/asking for the match - this is basically
227			always the object that the match expression is attached to.
228
229	root	1.1	=back
230
231			=head2 EXPRESSIONS
232
233	root	1.9	Expressions used in conditions usually consist of simple boolean checks
234			(flag XYZ is set) or simple comparisons.
235	root	1.1
236			=over 4
237
238	root	1.2	=item flags
239
240			Flag names (without the leading C<FLAG_>) can be used as-is, in which case
241			their corresponding flag value is used.
242
243			=item scalar object attributes
244
245			Object attributes that consist of a single value (C<name>, C<title>,
246			C<value> and so on) can be specified by simply using their name, in which
247			acse their corresponding value is used.
248
249			=item array objects attributes
250
251			The C<resist> array can be accessed by specifying C<< resist [ ATNR_type ]
252			>>.
253
254	root	1.4	Example: match an acid resistance higher than 30.
255	root	1.2
256			resist[ATNR_ACID] > 30
257
258			=item functions
259
260			Some additional functions with or without arguments in parentheses are
261			available.
262
263			=item { BLOCK }
264
265			You can specify perl code to execute by putting it inside curly
266			braces. The last expression evaluated inside will become the result.
267
268	root	1.10	The perlcode can access C<$_>, which rferes to the object currently being
269			matches, and the C<$object>, C<$self>, C<$source> and C<$originator>.
270
271			Example: check whether the slaying field consists of digits only.
272
273			{ $_->slaying =~ /^\d+$/ }
274
275	root	1.2	=item comparisons, <, <=, ==, =, !=, =>, >
276
277			You can compare expressions against constants via any of these
278			operators. If the constant is a string, then a string compare will be
279			done, otherwise a numerical comparison is used.
280
281	root	1.4	Example: match an object with name "schnops" that has a value >= 10.
282	root	1.2
283	root	1.4	name="schnops" and value >= 10
284	root	1.2
285			=item uppercase constant names
286
287	root	1.4	Any uppercase word that exists as constant inside the C<cf::> namespace
288			(that is, any deliantra constant) can also be used as-is, but needs to be
289	root	1.2	specified in uppercase.
290
291			Example: match a type of POTION (using C<cf::POTION>).
292
293			type=POTION
294
295	root	1.1	=back
296
297			=head2 FUNCTIONS
298
299			=over 4
300
301	root	1.2	=item any
302
303			This simply evaluates to true, and simply makes matching I<any> object a
304			bit easier to read.
305
306	root	1.21	=item none
307
308			This simply evaluates to false, and simply makes matching I<never> a bit
309			easier to read.
310
311	root	1.11	=item has(condition)
312	root	1.1
313			True iff the object has a matching inventory object.
314
315	root	1.9	=item count(match)
316
317	root	1.11	Number of matching objects - the context object for the C<match> is the
318			currently tested object - you can override this with an C<in object> for
319			example.
320	root	1.9
321	root	1.14	=item dump()
322	root	1.10
323			Dumps the object to the server log when executed, and evaluates to true.
324
325			Note that logical operations are short-circuiting, so this only dumps
326			potions:
327
328	root	1.14	type=POTION and dump()
329	root	1.10
330	root	1.1	=back
331
332	root	1.9	=head2 GRAMMAR
333
334			This is the grammar that was used to implement the matching language
335			module. It is meant to be easily readable by humans, not to implement it
336			exactly as-is.
337
338			# object matching and selecting
339
340	root	1.12	match = chain
341			\| chain 'of' root
342			root = 'object' \| 'self' \| 'source' \| 'originator'
343			chain = condition
344	root	1.21	\| chain also deep 'in' modifier
345	root	1.9	also = nothing \| 'also'
346	root	1.12	deep = nothing \| 'deep'
347	root	1.21	modifier ='inv' \| 'env' \| 'arch' \| 'map' \| 'head'
348	root	1.9
349	root	1.21	nothing =
350	root	1.9
351			# boolean matching condition
352
353			condition = factor
354	root	1.15	\| factor 'and'? condition
355			\| factor 'or' condition
356	root	1.9
357			factor = 'not' factor
358	root	1.20	\| '(' match ')'
359	root	1.9	\| expr
360			\| expr operator constant
361
362			operator = '=' \| '==' \| '!=' \| '<' \| '<=' \| '>' \| '>='
363
364			expr = flag
365			\| sattr
366			\| aattr '[' <constant> ']'
367	root	1.22	\| 'stat.' statattr
368	root	1.9	\| special
369			\| func '(' args ')'
370			\| '{' perl code block '}'
371
372			func = <any function name>
373			sattr = <any scalar object attribute>
374			aattr = <any array object attribute>
375			flag = <any object flag>
376	root	1.22	statattr = <any stat attribute: exp, food, str, dex, hp, maxhp...>
377	root	1.9	special = <any ()-less "function">
378
379			constant = <number> \| '"' <string> '"' \| <uppercase cf::XXX name>
380			args = <depends on function>
381
382	root	1.12	TODO: contains, matches, query_name, selling_price, buying_price?
383	root	1.9
384	root	1.1	=cut
385
386	root	1.10	=head2 PERL FUNCTIONS
387
388			=over 4
389
390			=cut
391	root	1.1
392			package cf::match;
393
394			use common::sense;
395
396			use List::Util ();
397
398			{
399			package cf::match::exec;
400
401			use List::Util qw(first);
402
403			package cf::match::parser;
404
405			use common::sense;
406
407			sub ws {
408			/\G\s+/gc;
409			}
410
411	root	1.20	sub condition ();
412			sub match ($$);
413
414	root	1.1	our %func = (
415			has => sub {
416	root	1.20	'first { ' . condition . ' } $_->inv'
417	root	1.1	},
418			count => sub {
419	root	1.20	'(scalar ' . (match 1, '$_') . ')'
420	root	1.1	},
421	root	1.10	dump => sub {
422			'do {
423			warn "cf::match::match dump:\n"
424			. "self: " . eval { $self->name } . "\n"
425			. $_->as_string;
426			1
427			}';
428			},
429	root	1.1	);
430
431	root	1.14	our %special = (
432			any => sub {
433			1
434			},
435	root	1.21	none => sub {
436			0
437			},
438	root	1.14	);
439
440	root	1.1	sub constant {
441			ws;
442
443			return $1 if /\G([\-\+0-9\.]+)/gc;
444			return "cf::$1" if /\G([A-Z0-9_]+)/gc;
445
446			#TODO better string parsing, also include ''
447			return $1 if /\G("[^"]+")/gc;
448
449			die "number, string or uppercase constant name expected\n";
450			}
451
452			our $flag = $cf::REFLECT{object}{flags};
453			our $sattr = $cf::REFLECT{object}{scalars};
454			our $aattr = $cf::REFLECT{object}{arrays};
455	root	1.22	our $lattr = $cf::REFLECT{living}{scalars};
456	root	1.1
457			sub expr {
458			# ws done by factor
459			my $res;
460
461			if (/\G ( \{ (?: (?> [^{}]+ ) \| (?-1) )* \} ) /gcx) {
462			# perl
463
464			my $expr = $1;
465
466			$res .= $expr =~ /\{([^;]+)\}/ ? $1 : "do $expr";
467
468	root	1.22	} elsif (/\Gstats\.([A-Za-z0-9_]+)/gc) {
469
470			if (exists $lattr->{$1}) {
471			$res .= "\$_->stats->$1";
472			} elsif (exists $lattr->{"\u$1"}) {
473			$res .= "\$_->stats->\u$1";
474			} else {
475			die "living statistic name expected (str, pow, hp, sp...)\n";
476			}
477
478	root	1.1	} elsif (/\G([A-Za-z0-9_]+)/gc) {
479
480			if (my $func = $func{$1}) {
481			/\G\s*\(/gc
482			or die "'(' expected after function name\n";
483
484			$res .= $func->();
485
486			/\G\s*\)/gc
487			or die "')' expected after function arguments\n";
488
489			} elsif (my $func = $special{$1}) {
490			$res .= $func->();
491
492			} elsif (exists $flag->{lc $1}) {
493			$res .= "\$_->flag (cf::FLAG_\U$1)";
494
495			} elsif (exists $sattr->{$1}) {
496			$res .= "\$_->$1";
497
498			} elsif (exists $aattr->{$1}) {
499
500			$res .= "\$_->$1";
501
502			/\G\s*\[/gc
503			or die "'[' expected after array name\n";
504
505			$res .= "(" . constant . ")";
506
507			/\G\s*\]/gc
508			or die "']' expected after array index\n";
509
510			} else {
511			$res .= constant;
512			}
513
514			} else {
515	root	1.20	Carp::cluck;#d#
516	root	1.1	die "expr expected\n";
517			}
518
519			$res
520			}
521
522			our %stringop = (
523			"==" => "eq",
524			"!=" => "ne",
525			"<=" => "le",
526			">=" => "ge",
527			"<" => "lt",
528			">" => "gt",
529			);
530
531			sub factor {
532			ws;
533
534			my $res;
535
536			if (/\Gnot\b\s*/gc) {
537			$res .= "!";
538			}
539
540			if (/\G\(/gc) {
541			# ()
542	root	1.20
543			$res .= '(' . (match 0, '$_') . ')';
544
545			/\G\s*\)/gc or die "closing ')' expected\n";
546	root	1.1
547			} else {
548			my $expr = expr;
549
550			$res .= $expr;
551
552			if (/\G\s*([=!<>]=?)/gc) {
553			my $op = $1;
554
555			$op = "==" if $op eq "=";
556			my $const = constant;
557			$op = $stringop{$op} if $const =~ /^"/;
558
559			$res .= " $op $const";
560			}
561			}
562
563			"($res)"
564			}
565
566	root	1.20	sub condition () {
567	root	1.1	my $res = factor;
568
569			while () {
570			ws;
571	root	1.12
572			# first check some stop-symbols, so we don't have to backtrack
573	root	1.20	if (/\G(?=also\b\|deep\b\|in\b\|of\b\|\)\|\z)/gc) {
574	root	1.14	pos = pos; # argh. the misop hits again. again. again. again. you die.
575	root	1.1	last;
576	root	1.12
577	root	1.1	} elsif (/\Gor\b/gc) {
578			$res .= " \|\| ";
579	root	1.12
580	root	1.1	} else {
581			/\Gand\b/gc;
582			$res .= " && ";
583			}
584			$res .= factor;
585			}
586
587			$res
588			}
589
590	root	1.20	sub match ($$) {
591			my ($wantarray, $defctx) = @_;
592	root	1.11
593	root	1.20	my $res = condition;
594
595			# if nothing follows, we have a simple condition, so
596			# optimise a comon case.
597			if ($defctx eq '$_' and /\G\s*(?=\)\|$)/gc) {
598			return $wantarray
599			? "$res ? \$_ : ()"
600			: $res;
601			}
602
603			$res = ($wantarray ? " grep { " : " first { ") . $res . "}";
604	root	1.1
605			while () {
606	root	1.12	ws;
607
608			my $also = /\Galso\s+/gc + 0;
609			my $deep = /\Gdeep\s+/gc + 0;
610
611			if (/\Gin\s+/gc) {
612			my $expand;
613
614	root	1.21	if (/\G(inv\|env\|map\|arch\|head)\b/gc) {
615	root	1.12	if ($1 eq "inv") {
616			$expand = "map \$_->inv,";
617			} elsif ($1 eq "env") {
618			$expand = "map \$_->env // (),";
619	root	1.21	} elsif ($1 eq "head") {
620			$expand = "map \$_->head,";
621			$deep = 0; # infinite loop otherwise
622	root	1.14	} elsif ($1 eq "arch") {
623			$expand = "map \$_->arch,";
624	root	1.17	$deep = 0; # infinite loop otherwise
625	root	1.12	} elsif ($1 eq "map") {
626			$expand = "map \$_->map->at (\$_->x, \$_->y),";
627	root	1.17	$deep = 0; # infinite loop otherwise
628	root	1.12	}
629			} else {
630			$expand = "map \$_->inv, grep { " . condition . " }";
631			}
632
633			if ($also \|\| $deep) {
634			$res .= " do {\n"
635			. " my \@res;\n";
636			$res .= " while (\@_) {\n" if $deep;
637			$res .= " push \@res, \@_;\n" if $also;
638			$res .= " \@_ = $expand \@_;\n";
639			$res .= " }\n" if $deep;
640			$res .= " (\@res, \@_)\n"
641			. "}";
642			} else {
643			$res .= " $expand";
644			}
645	root	1.20	} else {
646
647			if (/\Gof\s+(self\|object\|source\|originator)\b/gc) {
648			$also \|\| $deep
649			and die "neither 'also' nor 'deep' can be used with 'of'\n";
650
651			if ($1 eq "self") {
652			return "$res \$self // ()";
653			} elsif ($1 eq "object") {
654			return "$res \$object";
655			} elsif ($1 eq "source") {
656			return "$res \$source // ()";
657			} elsif ($1 eq "originator") {
658			return "$res \$originator // \$source // ()";
659			}
660			} else {
661			return "$res $defctx";
662	root	1.1	}
663			}
664			}
665			}
666			}
667
668	root	1.20	sub parse($$) { # wantarray, matchexpr
669			my $res;
670	root	1.1
671	root	1.20	local $_ = $_[1];
672	root	1.12
673			eval {
674	root	1.20	$res = cf::match::parser::match $_[0], "\$object";
675	root	1.12
676	root	1.14	/\G$/gc
677	root	1.12	or die "unexpected trailing characters after match\n";
678			};
679	root	1.1
680			if ($@) {
681			my $ctx = 20;
682			my $str = substr $_, (List::Util::max 0, (pos) - $ctx), $ctx * 2;
683			substr $str, (List::Util::min $ctx, pos), 0, "<-- HERE -->";
684
685			chomp $@;
686			die "$@ ($str)\n";
687			}
688
689			$res
690			}
691
692	root	1.13	if (0) {#d#
693	root	1.22	die parse 1, 'stats.pow';
694	root	1.11	exit 0;
695			}
696
697	root	1.9	our %CACHE;
698	root	1.1
699	root	1.10	sub compile($$) {
700	root	1.20	my ($wantarray, $match) = @_;
701			my $expr = parse $wantarray, $match;
702			warn "MATCH DEBUG $match,$wantarray => $expr\n";#d#
703	root	1.10	$expr = eval "
704			package cf::match::exec;
705			sub {
706			my (\$object, \$self, \$source, \$originator) = \@_;
707			$expr
708			}
709			";
710			die if $@;
711
712			$expr
713			}
714	root	1.9
715	root	1.20	=item cf::match::match $match, $object[, $self[, $source[, $originator]]]
716
717			Compiles (and caches) the C<$match> expression and matches it against
718			the C<$object>. C<$self> should be the object initiating the match (or
719			C<undef>), C<$source> should be the actor/source and C<$originator> the
720			object that initiated the action (such as the player). C<$originator>
721			defaults to C<$source> when not given.
722
723			In list context it finds and returns all matching objects, in scalar
724			context only a true or false value.
725
726			=cut
727
728	root	1.10	sub match($$;$$$) {
729	root	1.20	my $match = shift;
730			my $wantarray = wantarray+0;
731	root	1.9
732			&{
733	root	1.20	$CACHE{"$wantarray$match"} \|\|= compile $wantarray, $match
734	root	1.9	}
735	root	1.2	}
736	root	1.1
737	root	1.18	our $CACHE_CLEARER = AE::timer 3600, 3600, sub {
738			%CACHE = ();
739			};
740
741	root	1.10	#d# $::schmorp=cf::player::find "schmorp"&
742			#d# cf::match::match '', $::schmorp->ob
743
744
745			=back
746
747			=head1 AUTHOR
748
749			Marc Lehmann <schmorp@schmorp.de>
750			http://home.schmorp.de/
751
752			=cut
753	root	1.9
754	root	1.1	1;
755