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-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.

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