[ViewVC] Diff of: cvs/deliantra/server/lib/cf/match.pm

Comparing deliantra/server/lib/cf/match.pm (file contents):
Revision 1.1 by root, Sat Oct 10 05:07:50 2009 UTC vs.
Revision 1.33 by root, Tue Oct 12 20:15:48 2010 UTC

…		…
		1	#
		2	# This file is part of Deliantra, the Roguelike Realtime MMORPG.
		3	#
		4	# Copyright (©) 2009,2010 Marc Alexander Lehmann / Robin Redeker / the Deliantra team
		5	#
		6	# Deliantra is free software: you can redistribute it and/or modify it under
		7	# the terms of the Affero GNU General Public License as published by the
		8	# Free Software Foundation, either version 3 of the License, or (at your
		9	# option) any later version.
		10	#
		11	# This program is distributed in the hope that it will be useful,
		12	# but WITHOUT ANY WARRANTY; without even the implied warranty of
		13	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
		14	# GNU General Public License for more details.
		15	#
		16	# You should have received a copy of the Affero GNU General Public License
		17	# and the GNU General Public License along with this program. If not, see
		18	# <http://www.gnu.org/licenses/>.
		19	#
		20	# The authors can be reached via e-mail to <support@deliantra.net>
		21	#
		22
1	=head1 NAME	23	=head1 NAME
2		24
3	cf::match - object matching language	25	cf::match - object matching language
4		26
5	=head1 DESCRIPTION	27	=head1 DESCRIPTION
6		28
7	This module implements a simple object matching language. It can be asked	29	This module implements a simple object matching language. It can be asked
8	to find any (boolean context), or all (list context), matching objects.	30	to find any ("check for a match"), or all ("find all objects") matching
		31	objects.
9		32
10	=head1 MATCH EXAMPLES	33	=head1 MATCH EXAMPLES
11		34
12	Match the object if it has a slaying field of C<key1>:	35	Match the object if it has a slaying field of C<key1>:
13		36
16	Match the object if it has an object with name C<force> and	39	Match the object if it has an object with name C<force> and
17	slaying C<poison> in it's inventory:	40	slaying C<poison> in it's inventory:
18		41
19	has (name = "force" and slaying = "poison")	42	has (name = "force" and slaying = "poison")
20		43
21	Find all inventory objects with value > 10, which are not invisible:	44	Find all inventory objects with value >= 10, which are not invisible:
22		45
23	value > 10 and not invisible in inv	46	value >= 10 and not invisible in inv
24		47
25	Find all potions with spell objects inside them in someones inventory:	48	Find all potions with spell objects inside them in someones inventory:
26		49
27	type=SPELL in type=POTION in inv	50	type=SPELL in type=POTION in inv
28		51
29	Find all potions inside someones inventory, or inside applied containers:	52	Find all scrolls inside someones inventory, or inside applied scroll
		53	containers:
30		54
31	type=POTION also in type=CONTAINER in inv	55	type=SCROLL also in applied type=CONTAINER race="scroll" in inv
32		56
33	=head1 LANGUAGE	57	Find all unpaid items, anywhere, even deeply nested inside other items, in
		58	the originator:
34		59
35	# object selection	60	unpaid also deep in inv of originator
36		61
37	select = set	62	=head1 MATCH EXPRESSIONS
38	\| select also rep 'in' set
39	also = nothing \| 'also'
40	rep = nothing \| 'rep' \| 'repeatedly'
41
42	set = 'inv' \| 'env' \| 'map'
43
44	empty =
45
46	# object matching
47
48	match = factor
49	\| factor 'and'? match
50	\| factor 'or' match
51
52	factor = 'not' factor
53	\| '(' match ')'
54	\| expr
55	\| expr operator constant
56
57	operator = '=' \| '!=' \| '>' \| '<' \| '<=' \| '>='
58
59	expr = flag
60	\| sattr
61	\| aattr '[' <constant> ']'
62	\| special
63	\| func '(' args ')'
64	\| '{' perl code block '}'
65
66	func = <any function name>
67	sattr = <any scalar object attribute>
68	aattr = <any array object attribute>
69	flag = <any object flag>
70	special = <any ()-less "function">
71
72	constant = <number> \| '"' <string> '"' \| <uppercase cf::XXX name>
73	args = <depends on function>
74
75	TODO: repeatedly, env
76		63
77	=head2 STRUCTURE	64	=head2 STRUCTURE
78		65
79	The two main structures are the C<select>, which selects objects matching	66	The two main structures are the C<match>, which selects objects matching
80	various criteria, and the C<match>, which determines if an object matches	67	various criteria, and the C<condition, which determines if an object
81	some desired properties.	68	matches some desired properties:
82		69
		70	condition
		71	condition in set-modifier
		72	condition of root-object
		73
83	A C<select> is passed a set of "context objects" that it is applied	74	A C<condition> receives a set of "context objects" that it is applied
84	to. This is initially just one object - for altars, it is the object	75	to. This is initially just one object - by default, for altars, it is the
85	dropped on it, for pedestals, the object on top of it and so on.	76	object dropped on it, for pedestals, the object on top of it and so on.
86		77
87	This set of context objects can be modified in various ways, for example	78	This set of context objects can be modified in various ways, for example
88	by replacing it with the inventories of all objects, or all objects on the	79	by replacing it with the inventories of all objects, or all items on the
89	same mapspace, and so on, by using the C<in> operator.	80	same mapspace, and so on, by using the C<in> operator:
90		81
		82	condition in inv
		83	condition in map
		84
		85	Also, besides the default root object where all this begins, you can start
		86	elsewhere, for example in the I<originator> (usually the player):
		87
		88	condition in inv of originator
		89
91	Once the set of context objects has been established, each objetc is	90	Once the final set of context objects has been established, each object
92	matched against the C<match> expression. Sometimes the server is only	91	is matched against the C<condition>.
93	interested in knowing whether I<anything> matches, and sometimes the	92
94	server is interested in I<all> objects that match.	93	It is possible to chain modifiers from right-to-left, so this example
		94	would start with the originator, take it's inventory, find all inventory
		95	items which are potions, looks into their inventory, and then finds all
		96	spells.
		97
		98	type=SPELL in type=POTION in inv of originator
		99
		100	Sometimes the server is only interested in knowing whether I<anything>
		101	matches, and sometimes the server is interested in I<all> objects that
		102	match.
95		103
96	=head2 OPERATORS	104	=head2 OPERATORS
97		105
98	=over 4	106	=over 4
99		107
100	=item and, or, not, ()	108	=item and, or, not, ()
101		109
102	Match expressions can be combined with C<and> or C<or> to build larger	110	Conditions can be combined with C<and> or C<or> to build larger
103	expressions. C<not> negates the expression, and parentheses can be used to	111	expressions. C<not> negates the condition, and parentheses can be used to
104	group match expressions.	112	override operator precedence and execute submatches.
		113
		114	Not that C<not> only negates a condition and not the whole match
		115	expressions, thus
		116
		117	not applied in inv
		118
		119	is true if there is I<any> non-applied object in the inventory. To negate
		120	a whole match, you have to use a sub-match: To check whether there is
		121	I<no> applied object in someones inventory, write this:
		122
		123	not (applied in inv)
105		124
106	Example: match applied weapons.	125	Example: match applied weapons.
107		126
108	type=WEAPON and applied	127	applied type=WEAPON
109		128
110	Example: match horns or rods.	129	Example: match horns or rods.
111		130
112	type=HORN or type=ROD	131	type=HORN or type=ROD
113		132
		133	Example: see if the originator is a player.
		134
		135	type=PLAYER of originator
		136
114	=item in ...	137	=item in ...
115		138
116	The in operator takes the context set and modifies it in various ways.	139	The in operator takes the context set and modifies it in various ways. As
		140	a less technical description, think of the C<in> as being a I<look into>
		141	or I<look at> operator - instead of looking at whatever was provided to
		142	the match, the C<in> operator lets you look at other sets of objects, most
		143	often the inventory.
117		144
118	=over 4	145	=over 4
119		146
120	=item in inv	147	=item in inv
121		148
…		…
127		154
128	=item in env	155	=item in env
129		156
130	Replaces all objects by their containing object, if they have one.	157	Replaces all objects by their containing object, if they have one.
131		158
		159	=item in arch
		160
		161	Replaces all objects by their archetypes.
		162
132	=item in map	163	=item in map
133		164
134	Replaces all objects by the objects that are on the same mapspace as them.	165	Replaces all objects by the objects that are on the same mapspace as them.
135		166
136	=item in <match>	167	=item in head
137		168
		169	Replaces all objects by their head objects.
		170
		171	=item in <condition>
		172
138	Finds all context objects matching the match expression, and then puts	173	Finds all context objects matching the condition, and then puts their
139	their inventories into the context set.	174	inventories into the context set.
140		175
141	Note that C<in inv> is simply a special case of an C<< in <match> >> that	176	Note that C<in inv> is simply a special case of an C<< in <condition> >> that
142	matches any object.	177	matches any object.
143		178
144	Example: find all spells inside potions inside the inventory of the context	179	Example: find all spells inside potions inside the inventory of the context
145	object(s).	180	object(s).
146		181
…		…
153		188
154	Example: check if the context object I<is> a spell, or I<contains> a spell.	189	Example: check if the context object I<is> a spell, or I<contains> a spell.
155		190
156	type=SPELL also in inv	191	type=SPELL also in inv
157		192
158	=item repeatedly in ...	193	=item also deep in ...
159		194
160	Repeats the operation as many times as possible. This can be used to	195	Repeats the operation as many times as possible. This can be used to
161	recursively look into objects.	196	recursively look into objects.
162		197
163	=item also repeatedly in ...	198	So for example, C<also deep in inv> means to take the inventory of all
		199	objects, taking their inventories, and so on, and adding all these objects
		200	to the context set.
164		201
165	C<also> and C<repeatedly> can be combined.	202	Similarly, C<also deep in env> means to take the environment object, their
		203	environemnt object and so on.
166		204
167	Example: check if there are any unpaid items in an inventory,	205	Example: check if there are any unpaid items in an inventory,
168	or in the inventories of the inventory objects, and so on.	206	or in the inventories of the inventory objects, and so on.
169		207
170	unpaid also repeatedly in inv	208	unpaid also deep in inv
171		209
172	Example: check if a object is inside a player.	210	Example: check if a object is inside a player.
173		211
174	type=PLAYER also repeatedly in env	212	type=PLAYER also deep in env
175		213
176	=back	214	=back
177		215
		216	=item of ...
		217
		218	By default, all matches are applied to the "obviously appropriate" object,
		219	such as the item dropped on a button or moving over a detector. This can
		220	be changed to a number of other objects - not all of them are available
		221	for each match (when not available, the match will simply fail).
		222
		223	An C<of> term ends a match, nothing is allowed to follow.
		224
		225	=over 4
		226
		227	=item of object
		228
		229	Starts with the default object - this is the object passed to the match to
		230	match against by default. Matches have an explicit C<of object> appended,
		231	but submatches start at the current object, and in this case C<of object>
		232	can be used to start at the original object once more.
		233
		234	=item of self
		235
		236	Starts with the object initiating/asking for the match - this is basically
		237	always the object that the match expression is attached to.
		238
		239	=item of source
		240
		241	Starts with the I<source> object - this object is sometimes passed to
		242	matches and represents the object that is the source of the action, such
		243	as a rod or a potion when it is applied. Often, the I<source> is the same
		244	as the I<originator>.
		245
		246	=item of originator
		247
		248	Starts with the I<originator> - one step farther removed than the
		249	I<source>, the I<originator> is sometimes passed to matches and represents
		250	the original initiator of an action, most commonly a player or monster.
		251
		252	This object is often identical to the I<source> (e.g. when a player casts
		253	a spell, the player is both source and originator).
		254
178	=back	255	=back
179		256
180	=head2 EXPRESSIONS	257	=head2 EXPRESSIONS
181		258
182	Match expressions usually consist of simple boolean checks (flag XYZ is	259	Expressions used in conditions usually consist of simple boolean checks
183	set) or simple comparisons.	260	(flag XYZ is set) or simple comparisons.
184		261
185	=over 4	262	=over 4
186		263
		264	=item flags
		265
		266	Flag names (without the leading C<FLAG_>) can be used as-is, in which case
		267	their corresponding flag value is used.
		268
		269	=item scalar object attributes
		270
		271	Object attributes that consist of a single value (C<name>, C<title>,
		272	C<value> and so on) can be specified by simply using their name, in which
		273	case their corresponding value is used.
		274
		275	=item array objects attributes
		276
		277	The C<resist> array can be accessed by specifying C<< resist [ ATNR_type ]
		278	>>.
		279
		280	Example: match an acid resistance higher than 30.
		281
		282	resist[ATNR_ACID] > 30
		283
		284	=item functions
		285
		286	Some additional functions with or without arguments in parentheses are
		287	available. They are documented in their own section, below.
		288
		289	=item { BLOCK }
		290
		291	You can specify perl code to execute by putting it inside curly
		292	braces. The last expression evaluated inside will become the result.
		293
		294	The perlcode can access C<$_>, which rferes to the object currently being
		295	matches, and the C<$object>, C<$self>, C<$source> and C<$originator>.
		296
		297	Example: check whether the slaying field consists of digits only.
		298
		299	{ $_->slaying =~ /^\d+$/ }
		300
		301	=item comparisons, <, <=, ==, =, !=, =>, >
		302
		303	You can compare expressions against constants via any of these
		304	operators. If the constant is a string, then a string compare will be
		305	done, otherwise a numerical comparison is used.
		306
		307	Example: match an object with name "schnops" that has a value >= 10.
		308
		309	name="schnops" and value >= 10
		310
		311	=item uppercase constant names
		312
		313	Any uppercase word that exists as constant inside the C<cf::> namespace
		314	(that is, any deliantra constant) can also be used as-is, but needs to be
		315	specified in uppercase.
		316
		317	Example: match a type of POTION (using C<cf::POTION>).
		318
		319	type=POTION
		320
187	=back	321	=back
188		322
189	=head2 FUNCTIONS	323	=head2 FUNCTIONS
190		324
191	=over 4	325	=over 4
192		326
193	=item has(match)	327	=item any
		328
		329	This simply evaluates to true, and simply makes matching I<any> object a
		330	bit easier to read.
		331
		332	=item none
		333
		334	This simply evaluates to false, and simply makes matching I<never> a bit
		335	easier to read.
		336
		337	=item archname
		338
		339	The same as C<< { $_->arch->archname } >> - the archetype name is commonly
		340	used to match items, so this shortcut is provided.
		341
		342	=item resist_xxx
		343
		344	Resistancy values such as C<resist_physical>, C<resist_magic>,
		345	C<resists_fire> etc. are directly available (but can also be accessed via
		346	array syntax, i.e. C<resists[ATNR_FIRE]>).
		347
		348	=item body_xxx_info and body_xxx_used
		349
		350	Every body location (e.g. C<body_neck_info>, C<body_arm_used> etc.) can
		351	be accessed via these functions (these are aliases to more cumbersome C<< {
		352	$_->slot_info (body_xxx) } >> and C<slot_used> method calls).
		353
		354	Example: (e.g. on a door) match only players that have no arms.
		355
		356	match type=PLAYER and body_arm_info=0
		357
		358	=item has(condition)
194		359
195	True iff the object has a matching inventory object.	360	True iff the object has a matching inventory object.
196		361
197	=item count(select)	362	=item count(match)
198		363
199	Number of matching inventory objects.	364	Number of matching objects - the context object for the C<match> is the
		365	currently tested object - you can override this with an C<in object> for
		366	example.
		367
		368	=item dump()
		369
		370	Dumps the object to the server log when executed, and evaluates to true.
		371
		372	Note that logical operations are short-circuiting, so this only dumps
		373	potions:
		374
		375	type=POTION and dump()
200		376
201	=back	377	=back
202		378
		379	=head2 GRAMMAR
		380
		381	This is the grammar that was used to implement the matching language
		382	module. It is meant to be easily readable by humans, not to implement it
		383	exactly as-is.
		384
		385	# object matching and selecting
		386
		387	match = chain
		388	\| chain 'of' root
		389	root = 'object' \| 'self' \| 'source' \| 'originator'
		390	chain = condition
		391	\| chain also deep 'in' modifier
		392	also = nothing \| 'also'
		393	deep = nothing \| 'deep'
		394	modifier ='inv' \| 'env' \| 'arch' \| 'map' \| 'head'
		395
		396	nothing =
		397
		398	# boolean matching condition
		399
		400	condition = factor
		401	\| factor 'and'? condition
		402	\| factor 'or' condition
		403
		404	factor = 'not' factor
		405	\| '(' match ')'
		406	\| expr
		407	\| expr operator constant
		408
		409	operator = '=' \| '==' \| '!=' \| '<' \| '<=' \| '>' \| '>='
		410
		411	expr = flag
		412	\| sattr
		413	\| aattr '[' <constant> ']'
		414	\| 'stat.' statattr
		415	\| special
		416	\| func '(' args ')'
		417	\| '{' perl code block '}'
		418
		419	func = <any function name>
		420	sattr = <any scalar object attribute>
		421	aattr = <any array object attribute>
		422	flag = <any object flag>
		423	statattr = <any stat attribute: exp, food, str, dex, hp, maxhp...>
		424	special = <any ()-less "function">
		425
		426	constant = <number> \| '"' <string> '"' \| <uppercase cf::XXX name>
		427	args = <depends on function>
		428
		429	TODO: contains, matches, query_name, selling_price, buying_price?
		430
203	=cut	431	=cut
204		432
		433	=head2 PERL FUNCTIONS
		434
		435	=over 4
		436
		437	=cut
205		438
206	package cf::match;	439	package cf::match;
207		440
208	use common::sense;	441	use common::sense;
209		442
210	use List::Util ();	443	use List::Util ();
211
212	# parser state
213	# $_ # string to be parsed
214	our $all; # find all, or just the first matching object
215		444
216	{	445	{
217	package cf::match::exec;	446	package cf::match::exec;
218		447
219	our @ctx; # root object(s)
220
221	use List::Util qw(first);	448	use List::Util qw(first);
222
223	sub env_chain {
224	my @res;
225	push @res, $_
226	while $_ = $_->env;
227	@res
228	}
229		449
230	package cf::match::parser;	450	package cf::match::parser;
231		451
232	use common::sense;	452	use common::sense;
233		453
234	sub ws {	454	sub ws {
235	/\G\s+/gc;	455	/\G\s+/gc;
236	}	456	}
237		457
		458	sub condition ();
		459	sub match ($$);
		460
238	our %func = (	461	our %func = (
239	has => sub {	462	has => sub {
240	'first { ' . &match . ' } $_->inv'	463	'first { ' . condition . ' } $_->inv'
241	},	464	},
242	count => sub {	465	count => sub {
243	local $all = 1;	466	'(scalar ' . (match 1, '$_') . ')'
244	'(scalar ' . &select . ')'	467	},
		468	dump => sub {
		469	'do {
		470	warn "cf::match::match dump:\n"
		471	. "self: " . eval { $self->name } . "\n"
		472	. $_->as_string;
		473	1
		474	}';
245	},	475	},
246	);	476	);
247		477
248	our %special = (	478	our %special = (
249	any => sub {	479	any => sub {
250	1	480	1
251	},	481	},
		482	none => sub {
		483	0
		484	},
		485	archname => sub {
		486	'$_->arch->archname'
		487	},
252	);	488	);
		489
		490	# resist_xxx
		491	for my $atnr (0 .. cf::NROFATTACKS - 1) {
		492	$special{"resist_" . cf::attacktype_name ($atnr)} = sub { "\$_->resist ($atnr)" };
		493	}
		494
		495	# body_xxx_info and _used
		496	for my $slot (0 .. cf::NUM_BODY_LOCATIONS - 1) {
		497	my $name = cf::object::slot_name $slot;
		498
		499	$special{"body_$name\_info"} = sub { "\$_->slot_info ($slot)" };
		500	$special{"body_$name\_used"} = sub { "\$_->slot_used ($slot)" };
		501	}
253		502
254	sub constant {	503	sub constant {
255	ws;	504	ws;
256		505
257	return $1 if /\G([\-\+0-9\.]+)/gc;	506	return $1 if /\G([\-\+0-9\.]+)/gc;
…		…
264	}	513	}
265		514
266	our $flag = $cf::REFLECT{object}{flags};	515	our $flag = $cf::REFLECT{object}{flags};
267	our $sattr = $cf::REFLECT{object}{scalars};	516	our $sattr = $cf::REFLECT{object}{scalars};
268	our $aattr = $cf::REFLECT{object}{arrays};	517	our $aattr = $cf::REFLECT{object}{arrays};
		518	our $lattr = $cf::REFLECT{living}{scalars};
269		519
270	sub expr {	520	sub expr {
271	# ws done by factor	521	# ws done by factor
272	my $res;	522	my $res;
273		523
…		…
276		526
277	my $expr = $1;	527	my $expr = $1;
278		528
279	$res .= $expr =~ /\{([^;]+)\}/ ? $1 : "do $expr";	529	$res .= $expr =~ /\{([^;]+)\}/ ? $1 : "do $expr";
280		530
		531	} elsif (/\Gstats\.([A-Za-z0-9_]+)/gc) {
		532
		533	if (exists $lattr->{$1}) {
		534	$res .= "\$_->stats->$1";
		535	} elsif (exists $lattr->{"\u$1"}) {
		536	$res .= "\$_->stats->\u$1";
		537	} else {
		538	die "living statistic name expected (str, pow, hp, sp...)\n";
		539	}
		540
281	} elsif (/\G([A-Za-z0-9_]+)/gc) {	541	} elsif (/\G([A-Za-z0-9_]+)/gc) {
282		542
283	if (my $func = $func{$1}) {	543	if (my $func = $func{$1}) {
284	/\G\s*\(/gc	544	/\G\s*\(/gc
285	or die "'(' expected after function name\n";	545	or die "'(' expected after function name\n";
…		…
313	} else {	573	} else {
314	$res .= constant;	574	$res .= constant;
315	}	575	}
316		576
317	} else {	577	} else {
		578	Carp::cluck;#d#
318	die "expr expected\n";	579	die "expr expected\n";
319	}	580	}
320		581
321	$res	582	$res
322	}	583	}
…		…
339	$res .= "!";	600	$res .= "!";
340	}	601	}
341		602
342	if (/\G\(/gc) {	603	if (/\G\(/gc) {
343	# ()	604	# ()
344	$res .= &match;	605
345	ws;	606	$res .= '(' . (match 0, '$_') . ')';
		607
346	/\G\)/gc or die "')' expected\n";	608	/\G\s*\)/gc or die "closing ')' expected\n";
347		609
348	} else {	610	} else {
349	my $expr = expr;	611	my $expr = expr;
350		612
351	$res .= $expr;	613	$res .= $expr;
…		…
362	}	624	}
363		625
364	"($res)"	626	"($res)"
365	}	627	}
366		628
367	sub match {	629	sub condition () {
368	my $res = factor;	630	my $res = factor;
369		631
370	while () {	632	while () {
371	ws;	633	ws;
		634
		635	# first check some stop-symbols, so we don't have to backtrack
372	if (/\G(?=also\b\|in\b\|\)\|$)/gc) {	636	if (/\G(?=also\b\|deep\b\|in\b\|of\b\|\)\|\z)/gc) {
373	# early stop => faster and requires no backtracking	637	pos = pos; # argh. the misop hits again. again. again. again. you die.
374	last;	638	last;
		639
375	} elsif (/\Gor\b/gc) {	640	} elsif (/\Gor\b/gc) {
376	$res .= " \|\| ";	641	$res .= " \|\| ";
		642
377	} else {	643	} else {
378	/\Gand\b/gc;	644	/\Gand\b/gc;
379	$res .= " && ";	645	$res .= " && ";
380	}	646	}
381	$res .= factor;	647	$res .= factor;
382	}	648	}
383		649
384	$res	650	$res
385	}	651	}
386		652
387	sub select {	653	sub match ($$) {
388	my $res;	654	my ($wantarray, $defctx) = @_;
389		655
390	my $also; # undef means first iteration	656	my $res = condition;
		657
		658	# if nothing follows, we have a simple condition, so
		659	# optimise a comon case.
		660	if ($defctx eq '$_' and /\G\s*(?=\)\|$)/gc) {
		661	return $wantarray
		662	? "$res ? \$_ : ()"
		663	: $res;
		664	}
		665
		666	$res = ($wantarray ? " grep { " : " first { ") . $res . "}";
		667
391	while () {	668	while () {
		669	ws;
		670
		671	my $also = /\Galso\s+/gc + 0;
		672	my $deep = /\Gdeep\s+/gc + 0;
		673
		674	if (/\Gin\s+/gc) {
		675	my $expand;
		676
392	if (/\G\s*(inv\|env\|map)\b/gc) {	677	if (/\G(inv\|env\|map\|arch\|head)\b/gc) {
393	if ($1 eq "inv") {	678	if ($1 eq "inv") {
394	$res .= " map+(${also}\$_->inv),";	679	$expand = "map \$_->inv,";
395	} elsif ($1 eq "env") {	680	} elsif ($1 eq "env") {
396	$res .= " map+(${also}env_chain), ";	681	$expand = "map \$_->env // (),";
		682	} elsif ($1 eq "head") {
		683	$expand = "map \$_->head,";
		684	$deep = 0; # infinite loop otherwise
		685	} elsif ($1 eq "arch") {
		686	$expand = "map \$_->arch,";
		687	$deep = 0; # infinite loop otherwise
397	} elsif ($1 eq "map") {	688	} elsif ($1 eq "map") {
398	$res .= " map+(${also}\$_->map->at (\$_->x, \$_->y)),";	689	$expand = "map \$_->map->at (\$_->x, \$_->y),";
		690	$deep = 0; # infinite loop otherwise
		691	}
		692	} else {
		693	$expand = "map \$_->inv, grep { " . condition . " }";
399	}	694	}
400	last unless /\G\s*in\b/gc;	695
		696	if ($also \|\| $deep) {
		697	$res .= " do {\n"
		698	. " my \@res;\n";
		699	$res .= " while (\@_) {\n" if $deep;
		700	$res .= " push \@res, \@_;\n" if $also;
		701	$res .= " \@_ = $expand \@_;\n";
		702	$res .= " }\n" if $deep;
		703	$res .= " (\@res, \@_)\n"
		704	. "}";
		705	} else {
		706	$res .= " $expand";
		707	}
401	} else {	708	} else {
402	$res .= " map+($also\$_->inv)," if defined $also;
403	$res .= $all ? " grep { " : " first {";
404	$res .= match;
405	$res .= "}";
406		709
407	$also = /\G\s*also\b/gc ? '$_, ' : '';	710	if (/\Gof\s+(self\|object\|source\|originator)\b/gc) {
408	last unless /\G\s*in\b/gc;	711	$also \|\| $deep
		712	and die "neither 'also' nor 'deep' can be used with 'of'\n";
		713
		714	if ($1 eq "self") {
		715	return "$res \$self // ()";
		716	} elsif ($1 eq "object") {
		717	return "$res \$object";
		718	} elsif ($1 eq "source") {
		719	return "$res \$source // ()";
		720	} elsif ($1 eq "originator") {
		721	return "$res \$originator // \$source // ()";
		722	}
		723	} else {
		724	return "$res $defctx";
		725	}
409	}	726	}
410	}	727	}
411
412	"$res \@ctx"
413	}	728	}
414
415	}	729	}
416		730
417	sub parse($;$) {	731	sub parse($$) { # wantarray, matchexpr
418	local $_ = shift;	732	my $res;
419	local $all = shift;
420		733
421	my $res = "package cf::match::exec;\n"	734	local $_ = $_[1];
422	. eval { cf::match::parser::select };	735
		736	eval {
		737	$res = cf::match::parser::match $_[0], "\$object";
		738
		739	/\G$/gc
		740	or die "unexpected trailing characters after match\n";
		741	};
423		742
424	if ($@) {	743	if ($@) {
425	my $ctx = 20;	744	my $ctx = 20;
426	my $str = substr $_, (List::Util::max 0, (pos) - $ctx), $ctx * 2;	745	my $str = substr $_, (List::Util::max 0, (pos) - $ctx), $ctx * 2;
427	substr $str, (List::Util::min $ctx, pos), 0, "<-- HERE -->";	746	substr $str, (List::Util::min $ctx, pos), 0, "<-- HERE -->";
…		…
431	}	750	}
432		751
433	$res	752	$res
434	}	753	}
435		754
436	my $perl = parse 'flag(SEE_IN_DARK) in inv', 0;	755	if (0) {#d#
437		756	die parse 1, 'type=PLAYER and body_arm_info=0';
438	warn $perl, "\n";#d#
439	$perl = eval "no warnings; no feature; sub { $perl }"; die if $@;
440	use B::Deparse;
441	warn B::Deparse->new->coderef2text ($perl);
442
443	exit 0;	757	exit 0;
		758	}
		759
		760	our %CACHE;
		761
		762	sub compile($$) {
		763	my ($wantarray, $match) = @_;
		764	my $expr = parse $wantarray, $match;
		765	# warn "MATCH DEBUG $match,$wantarray => $expr\n";#d#
		766	$expr = eval "
		767	package cf::match::exec;
		768	sub {
		769	my (\$object, \$self, \$source, \$originator) = \@_;
		770	$expr
		771	}
		772	";
		773	die if $@;
		774
		775	$expr
		776	}
		777
		778	=item cf::match::match $match, $object[, $self[, $source[, $originator]]]
		779
		780	Compiles (and caches) the C<$match> expression and matches it against
		781	the C<$object>. C<$self> should be the object initiating the match (or
		782	C<undef>), C<$source> should be the actor/source and C<$originator> the
		783	object that initiated the action (such as the player). C<$originator>
		784	defaults to C<$source> when not given.
		785
		786	In list context it finds and returns all matching objects, in scalar
		787	context only a true or false value.
		788
		789	=cut
		790
		791	sub match($$;$$$) {
		792	my $match = shift;
		793	my $wantarray = wantarray+0;
		794
		795	&{
		796	$CACHE{"$wantarray$match"} \|\|= compile $wantarray, $match
		797	}
		798	}
		799
		800	our $CACHE_CLEARER = AE::timer 3600, 3600, sub {
		801	%CACHE = ();
		802	};
		803
		804	#d# $::schmorp=cf::player::find "schmorp"&
		805	#d# cf::match::match '', $::schmorp->ob
		806
		807
		808	=back
		809
		810	=head1 AUTHOR
		811
		812	Marc Lehmann <schmorp@schmorp.de>
		813	http://home.schmorp.de/
		814
		815	=cut
444		816
445	1;	817	1;
446		818

Diff Legend

-–
+Removed lines
-+
+Added lines
-<
+Changed lines
->
+Changed lines

Comparing deliantra/server/lib/cf/match.pm (file contents): Revision 1.1 by root, Sat Oct 10 05:07:50 2009 UTC vs. Revision 1.33 by root, Tue Oct 12 20:15:48 2010 UTC

Diff Legend

Comparing deliantra/server/lib/cf/match.pm (file contents):
Revision 1.1 by root, Sat Oct 10 05:07:50 2009 UTC vs.
Revision 1.33 by root, Tue Oct 12 20:15:48 2010 UTC