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

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 expression, and parentheses can be used to
group conditions.

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

An independent match - semantics like C<count>, except it only matters
whether the match finds any object (which is faster).

=item dump()

Dumps the object to the server log when executed, and evaluates to true.

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' set
   also      = nothing | 'also'
   deep      = nothing | 'deep'
   set       = 'inv' | 'env' | 'arch' | 'map'

   empty     =

   # boolean matching condition

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

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

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

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

   func      = <any function name>
   sattr     = <any scalar object attribute>
   aattr     = <any array object attribute>
   flag      = <any object flag>
   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 ();

# 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);

   package cf::match::parser;

   use common::sense;

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

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

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

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

   sub expr {
      # ws done by factor
      my $res;

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

         my $expr = $1;

         $res .= $expr =~ /\{([^;]+)\}/ ? $1 : "do $expr";

      } 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 {
         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 .= &condition;
         ws;
         /\G\)/gc or die "')' 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 $default = shift;

      my $res = ($all ? " grep { " : " first {") . condition . " }";

      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)\b/gc) {
               if ($1 eq "inv") {
                  $expand = "map \$_->inv,";
               } elsif ($1 eq "env") {
                  $expand = "map \$_->env // (),";
               } 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";
            }
         } elsif (/\Gof\s+(self|object|source|originator)\b/gc) {
            $also || $deep
               and die "neither 'also' nor 'deep' can be used with 'of'\n";

            if ($1 eq "self") {
               return "$res \$self // ()";
            } elsif ($1 eq "object") {
               return "$res \$object";
            } elsif ($1 eq "source") {
               return "$res \$source // ()";
            } elsif ($1 eq "originator") {
               return "$res \$originator // \$source // ()";
            }
         } else {
            return "$res $default";
         }
      }
   }
}

sub parse($;$) {
   local $_   = shift;
   local $all = shift;

   my $res;

   eval {
      $res = cf::match::parser::match "\$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 'type=SPELL_EFFECT and match(name="bullet" in arch)', 1;
   exit 0;
}

=item cf::match::match $match, $object[, $self[, $source[, $originator]]]

Compiles (and caches) the C<$match> expression and matches it against
the C<$object>. C<$self> should be the object initiating the match (or
C<undef>), C<$source> should be the actor/source and C<$originator> the
object that initiated the action (such as the player). C<$originator>
defaults to C<$source> when not given.

In list context it finds and returns all matching objects, in scalar
context only a true or false value.

=cut

our %CACHE;

sub compile($$) {
   my ($match, $all) = @_;
   my $expr = parse $match, $all;
   warn "MATCH DEBUG $match,$all => $expr\n";#d#
   $expr = eval "
      package cf::match::exec;
      sub {
         my (\$object, \$self, \$source, \$originator) = \@_;
         $expr
      }
   ";
   die if $@;

   $expr
}

sub match($$;$$$) {
   my $match = shift;
   my $all = wantarray+0;

   &{
      $CACHE{"$all$match"} ||= compile $match, $all
   }
}

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