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 potions inside someones inventory, or inside applied containers:

   type=POTION also in type=CONTAINER and applied in inv

=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

A C<cond> receives a set of "context objects" that it is applied to. This
is initially just one object - for altars, it is the object dropped on it,
for pedestals, the object on top of it and so on.

This set of context objects can be modified in various ways, for example
by replacing it with the inventories of all objects, or all objects on the
same mapspace, and so on, by using the C<in> operator:

   condition in inv
   condition in inv in originator

Once the set of context objects has been established, each object is
matched against the C<cond> expression. Sometimes the server is only
interested in knowing whether I<anything> matches, and sometimes the
server is interested in I<all> objects that match.

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

   type=WEAPON and applied

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 object

Replaces all objects by the default object - this is the object passed to
the match to match against by default. All matches have an explicit C<in
ctx> appended.

This must be the last C<in> expression in a match.

=item in source

Replaces all objects by the source object - this object is sometimes
passed to matches and represents the object is the source of the action,
such as a rod or a potion when it is applied. Often, the I<source> is the
same as the I<originator>.

This must be the last C<in> expression in a match.

=item in originator

Replaces all objects by the originator object - one step farther removed
than the I<source>, the I<originator> is sometimes passed to matches and
represents the original initiator of an action, most commonly a player or
monster.

=item in self

Replaces all objects by the object initiating/asking for the match - this
is basically always the object thatt he match expression is attached to.

This must be the last C<in> expression in a match.

=item in inv

Replaces all objects by their inventory.

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 map

Replaces all objects by the objects that are on the same mapspace as them.

=item in <cond>

Finds all context objects matching the condition, and then puts their
inventories into the context set.

Note that C<in inv> is simply a special case of an C<< in <cond> >> that
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 repeatedly in ...

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

=item also repeatedly in ...

C<also> and C<repeatedly> can be combined.

Example: check if there are any unpaid items in an inventory,
or in the inventories of the inventory objects, and so on.

   unpaid also repeatedly in inv

Example: check if a object is inside a player.

   type=PLAYER also repeatedly in env

=back

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

True iff the object has a matching inventory object.

=item count(match)

Number of matching objects - the context object for the C<match> are the
original context objects for the overall C<match>. # TODO bullshit?

=item match(match)

An independent match - unlike C<count>, 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     = set
             | match also rep 'in' set
   also      = nothing | 'also'
   rep       = nothing | 'rep' | 'repeatedly'

   set       = 'inv' | 'env' | 'map'
             | 'object' | 'source' | 'originator' | 'self'

   empty     =

   # boolean matching condition

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

   factor    = 'not' factor
             | '(' cond ')'
             | 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: repeatedly, env, contains, possbly matches

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

   sub env_chain {
      my @res;
      push @res, $_
         while $_ = $_->env;
      @res
   }

   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 . ')'
      },
   );

   our %special = (
      any => sub {
         1
      },
      dump => sub {
         'do {
            warn "cf::match::match dump:\n"
               . "self: " . eval { $self->name } . "\n"
               . $_->as_string;
            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;
         if (/\G(?=also\b|in\b|\)|$)/gc) {
            # early stop => faster and requires no backtracking
            last;
         } elsif (/\Gor\b/gc) {
            $res .= " || ";
         } else {
            /\Gand\b/gc;
            $res .= " && ";
         }
         $res .= factor;
      }

      $res
   }

   sub match {
      my $res;

      my $also; # undef means first iteration
      while () {
         if (/\G\s*(inv|env|map|object|subject|originator)\b/gc) {
            if ($1 eq "inv") {
               $res .= " map+(${also}\$_->inv),";
            } elsif ($1 eq "env") {
               $res .= " map+(${also}env_chain), "; # TODO
            } elsif ($1 eq "map") {
               $res .= " map+(${also}\$_->map->at (\$_->x, \$_->y)),";
            } elsif ($1 eq "self") {
               return "$res \$self";
            } elsif ($1 eq "object") {
               last; # default
            } elsif ($1 eq "source") {
               return "$res \$source";
            } elsif ($1 eq "originator") {
               return "$res \$originator";
            }
            last unless /\G\s*in\b/gc;
         } else {
            $res .= " map+($also\$_->inv)," if defined $also;
            $res .= $all ? " grep { " : " first {";
            $res .= condition;
            $res .= "}";

            $also = /\G\s*also\b/gc ? '$_, ' : '';
            last unless /\G\s*in\b/gc;
         }
      }

      "$res \$object"
   }

}

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

   my $res = cf::match::parser::match;

   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
}

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

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

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

=cut

our %CACHE;

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

   $expr
}

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

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

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