ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/server/lib/cf/match.pm
(Generate patch)

Comparing deliantra/server/lib/cf/match.pm (file contents):
Revision 1.19 by root, Tue Oct 13 15:58:19 2009 UTC vs.
Revision 1.25 by root, Sat Mar 20 20:26:18 2010 UTC

1#
2# This file is part of Deliantra, the Roguelike Realtime MMORPG.
3#
4# Copyright (©) 2009 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
3cf::match - object matching language 25cf::match - object matching language
4 26
5=head1 DESCRIPTION 27=head1 DESCRIPTION
84=over 4 106=over 4
85 107
86=item and, or, not, () 108=item and, or, not, ()
87 109
88Conditions can be combined with C<and> or C<or> to build larger 110Conditions can be combined with C<and> or C<or> to build larger
89expressions. C<not> negates the expression, and parentheses can be used to 111expressions. C<not> negates the condition, and parentheses can be used to
90group conditions. 112override operator precedence and execute submatches.
113
114Not that C<not> only negates a condition and not the whole match
115expressions, thus
116
117 not applied in inv
118
119is true if there is I<any> non-applied object in the inventory. To negate
120a whole match, you have to use a sub-match: To check whether there is
121I<no> applied object in someones inventory, write this:
122
123 not (applied in inv)
91 124
92Example: match applied weapons. 125Example: match applied weapons.
93 126
94 applied type=WEAPON 127 applied type=WEAPON
95 128
96Example: match horns or rods. 129Example: match horns or rods.
97 130
98 type=HORN or type=ROD 131 type=HORN or type=ROD
132
133Example: see if the originator is a player.
134
135 type=PLAYER of originator
99 136
100=item in ... 137=item in ...
101 138
102The in operator takes the context set and modifies it in various ways. As 139The in operator takes the context set and modifies it in various ways. As
103a less technical description, think of the C<in> as being a I<look into> 140a less technical description, think of the C<in> as being a I<look into>
125 162
126=item in map 163=item in map
127 164
128Replaces all objects by the objects that are on the same mapspace as them. 165Replaces all objects by the objects that are on the same mapspace as them.
129 166
167=item in head
168
169Replaces all objects by their head objects.
170
130=item in <condition> 171=item in <condition>
131 172
132Finds all context objects matching the condition, and then puts their 173Finds all context objects matching the condition, and then puts their
133inventories into the context set. 174inventories into the context set.
134 175
286=item any 327=item any
287 328
288This simply evaluates to true, and simply makes matching I<any> object a 329This simply evaluates to true, and simply makes matching I<any> object a
289bit easier to read. 330bit easier to read.
290 331
332=item none
333
334This simply evaluates to false, and simply makes matching I<never> a bit
335easier to read.
336
291=item has(condition) 337=item has(condition)
292 338
293True iff the object has a matching inventory object. 339True iff the object has a matching inventory object.
294 340
295=item count(match) 341=item count(match)
296 342
297Number of matching objects - the context object for the C<match> is the 343Number of matching objects - the context object for the C<match> is the
298currently tested object - you can override this with an C<in object> for 344currently tested object - you can override this with an C<in object> for
299example. 345example.
300
301=item match(match)
302
303An independent match - semantics like C<count>, except it only matters
304whether the match finds any object (which is faster).
305 346
306=item dump() 347=item dump()
307 348
308Dumps the object to the server log when executed, and evaluates to true. 349Dumps the object to the server log when executed, and evaluates to true.
309 350
324 365
325 match = chain 366 match = chain
326 | chain 'of' root 367 | chain 'of' root
327 root = 'object' | 'self' | 'source' | 'originator' 368 root = 'object' | 'self' | 'source' | 'originator'
328 chain = condition 369 chain = condition
329 | chain also deep 'in' set 370 | chain also deep 'in' modifier
330 also = nothing | 'also' 371 also = nothing | 'also'
331 deep = nothing | 'deep' 372 deep = nothing | 'deep'
332 set = 'inv' | 'env' | 'arch' | 'map' 373 modifier ='inv' | 'env' | 'arch' | 'map' | 'head'
333 374
334 empty = 375 nothing =
335 376
336 # boolean matching condition 377 # boolean matching condition
337 378
338 condition = factor 379 condition = factor
339 | factor 'and'? condition 380 | factor 'and'? condition
340 | factor 'or' condition 381 | factor 'or' condition
341 382
342 factor = 'not' factor 383 factor = 'not' factor
343 | '(' condition ')' 384 | '(' match ')'
344 | expr 385 | expr
345 | expr operator constant 386 | expr operator constant
346 387
347 operator = '=' | '==' | '!=' | '<' | '<=' | '>' | '>=' 388 operator = '=' | '==' | '!=' | '<' | '<=' | '>' | '>='
348 389
349 expr = flag 390 expr = flag
350 | sattr 391 | sattr
351 | aattr '[' <constant> ']' 392 | aattr '[' <constant> ']'
393 | 'stat.' statattr
352 | special 394 | special
353 | func '(' args ')' 395 | func '(' args ')'
354 | '{' perl code block '}' 396 | '{' perl code block '}'
355 397
356 func = <any function name> 398 func = <any function name>
357 sattr = <any scalar object attribute> 399 sattr = <any scalar object attribute>
358 aattr = <any array object attribute> 400 aattr = <any array object attribute>
359 flag = <any object flag> 401 flag = <any object flag>
402 statattr = <any stat attribute: exp, food, str, dex, hp, maxhp...>
360 special = <any ()-less "function"> 403 special = <any ()-less "function">
361 404
362 constant = <number> | '"' <string> '"' | <uppercase cf::XXX name> 405 constant = <number> | '"' <string> '"' | <uppercase cf::XXX name>
363 args = <depends on function> 406 args = <depends on function>
364 407
375package cf::match; 418package cf::match;
376 419
377use common::sense; 420use common::sense;
378 421
379use List::Util (); 422use List::Util ();
380
381# parser state
382# $_ # string to be parsed
383our $all; # find all, or just the first matching object
384 423
385{ 424{
386 package cf::match::exec; 425 package cf::match::exec;
387 426
388 use List::Util qw(first); 427 use List::Util qw(first);
393 432
394 sub ws { 433 sub ws {
395 /\G\s+/gc; 434 /\G\s+/gc;
396 } 435 }
397 436
437 sub condition ();
438 sub match ($$);
439
398 our %func = ( 440 our %func = (
399 has => sub { 441 has => sub {
400 'first { ' . &condition . ' } $_->inv' 442 'first { ' . condition . ' } $_->inv'
401 }, 443 },
402 count => sub { 444 count => sub {
403 local $all = 1;
404 '(scalar ' . &match ('$_') . ')' 445 '(scalar ' . (match 1, '$_') . ')'
405 },
406 match => sub {
407 local $all = 0;
408 '(scalar ' . &match ('$_') . ')'
409 }, 446 },
410 dump => sub { 447 dump => sub {
411 'do { 448 'do {
412 warn "cf::match::match dump:\n" 449 warn "cf::match::match dump:\n"
413 . "self: " . eval { $self->name } . "\n" 450 . "self: " . eval { $self->name } . "\n"
419 456
420 our %special = ( 457 our %special = (
421 any => sub { 458 any => sub {
422 1 459 1
423 }, 460 },
461 none => sub {
462 0
463 },
424 ); 464 );
425 465
426 sub constant { 466 sub constant {
427 ws; 467 ws;
428 468
435 die "number, string or uppercase constant name expected\n"; 475 die "number, string or uppercase constant name expected\n";
436 } 476 }
437 477
438 our $flag = $cf::REFLECT{object}{flags}; 478 our $flag = $cf::REFLECT{object}{flags};
439 our $sattr = $cf::REFLECT{object}{scalars}; 479 our $sattr = $cf::REFLECT{object}{scalars};
480 # quick hack to support archname, untested
481 $sattr->{archname} = "W";
440 our $aattr = $cf::REFLECT{object}{arrays}; 482 our $aattr = $cf::REFLECT{object}{arrays};
483 our $lattr = $cf::REFLECT{living}{scalars};
441 484
442 sub expr { 485 sub expr {
443 # ws done by factor 486 # ws done by factor
444 my $res; 487 my $res;
445 488
448 491
449 my $expr = $1; 492 my $expr = $1;
450 493
451 $res .= $expr =~ /\{([^;]+)\}/ ? $1 : "do $expr"; 494 $res .= $expr =~ /\{([^;]+)\}/ ? $1 : "do $expr";
452 495
496 } elsif (/\Gstats\.([A-Za-z0-9_]+)/gc) {
497
498 if (exists $lattr->{$1}) {
499 $res .= "\$_->stats->$1";
500 } elsif (exists $lattr->{"\u$1"}) {
501 $res .= "\$_->stats->\u$1";
502 } else {
503 die "living statistic name expected (str, pow, hp, sp...)\n";
504 }
505
453 } elsif (/\G([A-Za-z0-9_]+)/gc) { 506 } elsif (/\G([A-Za-z0-9_]+)/gc) {
454 507
455 if (my $func = $func{$1}) { 508 if (my $func = $func{$1}) {
456 /\G\s*\(/gc 509 /\G\s*\(/gc
457 or die "'(' expected after function name\n"; 510 or die "'(' expected after function name\n";
485 } else { 538 } else {
486 $res .= constant; 539 $res .= constant;
487 } 540 }
488 541
489 } else { 542 } else {
543 Carp::cluck;#d#
490 die "expr expected\n"; 544 die "expr expected\n";
491 } 545 }
492 546
493 $res 547 $res
494 } 548 }
511 $res .= "!"; 565 $res .= "!";
512 } 566 }
513 567
514 if (/\G\(/gc) { 568 if (/\G\(/gc) {
515 # () 569 # ()
516 $res .= &condition; 570
517 ws; 571 $res .= '(' . (match 0, '$_') . ')';
572
518 /\G\)/gc or die "')' expected\n"; 573 /\G\s*\)/gc or die "closing ')' expected\n";
519 574
520 } else { 575 } else {
521 my $expr = expr; 576 my $expr = expr;
522 577
523 $res .= $expr; 578 $res .= $expr;
534 } 589 }
535 590
536 "($res)" 591 "($res)"
537 } 592 }
538 593
539 sub condition { 594 sub condition () {
540 my $res = factor; 595 my $res = factor;
541 596
542 while () { 597 while () {
543 ws; 598 ws;
544 599
545 # first check some stop-symbols, so we don't have to backtrack 600 # first check some stop-symbols, so we don't have to backtrack
546 if (/\G(?=also\b|deep\b|in\b|of\b\)|\z)/gc) { 601 if (/\G(?=also\b|deep\b|in\b|of\b|\)|\z)/gc) {
547 pos = pos; # argh. the misop hits again. again. again. again. you die. 602 pos = pos; # argh. the misop hits again. again. again. again. you die.
548 last; 603 last;
549 604
550 } elsif (/\Gor\b/gc) { 605 } elsif (/\Gor\b/gc) {
551 $res .= " || "; 606 $res .= " || ";
558 } 613 }
559 614
560 $res 615 $res
561 } 616 }
562 617
563 sub match { 618 sub match ($$) {
564 my $default = shift; 619 my ($wantarray, $defctx) = @_;
565 620
621 my $res = condition;
622
623 # if nothing follows, we have a simple condition, so
624 # optimise a comon case.
625 if ($defctx eq '$_' and /\G\s*(?=\)|$)/gc) {
626 return $wantarray
627 ? "$res ? \$_ : ()"
628 : $res;
629 }
630
566 my $res = ($all ? " grep { " : " first {") . condition . " }"; 631 $res = ($wantarray ? " grep { " : " first { ") . $res . "}";
567 632
568 while () { 633 while () {
569 ws; 634 ws;
570 635
571 my $also = /\Galso\s+/gc + 0; 636 my $also = /\Galso\s+/gc + 0;
572 my $deep = /\Gdeep\s+/gc + 0; 637 my $deep = /\Gdeep\s+/gc + 0;
573 638
574 if (/\Gin\s+/gc) { 639 if (/\Gin\s+/gc) {
575 my $expand; 640 my $expand;
576 641
577 if (/\G(inv|env|map|arch)\b/gc) { 642 if (/\G(inv|env|map|arch|head)\b/gc) {
578 if ($1 eq "inv") { 643 if ($1 eq "inv") {
579 $expand = "map \$_->inv,"; 644 $expand = "map \$_->inv,";
580 } elsif ($1 eq "env") { 645 } elsif ($1 eq "env") {
581 $expand = "map \$_->env // (),"; 646 $expand = "map \$_->env // (),";
647 } elsif ($1 eq "head") {
648 $expand = "map \$_->head,";
649 $deep = 0; # infinite loop otherwise
582 } elsif ($1 eq "arch") { 650 } elsif ($1 eq "arch") {
583 $expand = "map \$_->arch,"; 651 $expand = "map \$_->arch,";
584 $deep = 0; # infinite loop otherwise 652 $deep = 0; # infinite loop otherwise
585 } elsif ($1 eq "map") { 653 } elsif ($1 eq "map") {
586 $expand = "map \$_->map->at (\$_->x, \$_->y),"; 654 $expand = "map \$_->map->at (\$_->x, \$_->y),";
600 $res .= " (\@res, \@_)\n" 668 $res .= " (\@res, \@_)\n"
601 . "}"; 669 . "}";
602 } else { 670 } else {
603 $res .= " $expand"; 671 $res .= " $expand";
604 } 672 }
673 } else {
674
605 } elsif (/\Gof\s+(self|object|source|originator)\b/gc) { 675 if (/\Gof\s+(self|object|source|originator)\b/gc) {
606 $also || $deep 676 $also || $deep
607 and die "neither 'also' nor 'deep' can be used with 'of'\n"; 677 and die "neither 'also' nor 'deep' can be used with 'of'\n";
608 678
609 if ($1 eq "self") { 679 if ($1 eq "self") {
610 return "$res \$self // ()"; 680 return "$res \$self // ()";
611 } elsif ($1 eq "object") { 681 } elsif ($1 eq "object") {
612 return "$res \$object"; 682 return "$res \$object";
613 } elsif ($1 eq "source") { 683 } elsif ($1 eq "source") {
614 return "$res \$source // ()"; 684 return "$res \$source // ()";
615 } elsif ($1 eq "originator") { 685 } elsif ($1 eq "originator") {
616 return "$res \$originator // \$source // ()"; 686 return "$res \$originator // \$source // ()";
687 }
688 } else {
689 return "$res $defctx";
617 } 690 }
618 } else {
619 return "$res $default";
620 } 691 }
621 } 692 }
622 } 693 }
623} 694}
624 695
625sub parse($;$) { 696sub parse($$) { # wantarray, matchexpr
626 local $_ = shift;
627 local $all = shift;
628
629 my $res; 697 my $res;
630 698
699 local $_ = $_[1];
700
631 eval { 701 eval {
632 $res = cf::match::parser::match "\$object"; 702 $res = cf::match::parser::match $_[0], "\$object";
633 703
634 /\G$/gc 704 /\G$/gc
635 or die "unexpected trailing characters after match\n"; 705 or die "unexpected trailing characters after match\n";
636 }; 706 };
637 707
646 716
647 $res 717 $res
648} 718}
649 719
650if (0) {#d# 720if (0) {#d#
651 die parse 'type=SPELL_EFFECT and match(name="bullet" in arch)', 1; 721 die parse 1, 'stats.pow';
652 exit 0; 722 exit 0;
653} 723}
654 724
655=item cf::match::match $match, $object[, $self[, $source[, $originator]]]
656
657Compiles (and caches) the C<$match> expression and matches it against
658the C<$object>. C<$self> should be the object initiating the match (or
659C<undef>), C<$source> should be the actor/source and C<$originator> the
660object that initiated the action (such as the player). C<$originator>
661defaults to C<$source> when not given.
662
663In list context it finds and returns all matching objects, in scalar
664context only a true or false value.
665
666=cut
667
668our %CACHE; 725our %CACHE;
669 726
670sub compile($$) { 727sub compile($$) {
671 my ($match, $all) = @_; 728 my ($wantarray, $match) = @_;
672 my $expr = parse $match, $all; 729 my $expr = parse $wantarray, $match;
673 warn "MATCH DEBUG $match,$all => $expr\n";#d# 730 warn "MATCH DEBUG $match,$wantarray => $expr\n";#d#
674 $expr = eval " 731 $expr = eval "
675 package cf::match::exec; 732 package cf::match::exec;
676 sub { 733 sub {
677 my (\$object, \$self, \$source, \$originator) = \@_; 734 my (\$object, \$self, \$source, \$originator) = \@_;
678 $expr 735 $expr
681 die if $@; 738 die if $@;
682 739
683 $expr 740 $expr
684} 741}
685 742
743=item cf::match::match $match, $object[, $self[, $source[, $originator]]]
744
745Compiles (and caches) the C<$match> expression and matches it against
746the C<$object>. C<$self> should be the object initiating the match (or
747C<undef>), C<$source> should be the actor/source and C<$originator> the
748object that initiated the action (such as the player). C<$originator>
749defaults to C<$source> when not given.
750
751In list context it finds and returns all matching objects, in scalar
752context only a true or false value.
753
754=cut
755
686sub match($$;$$$) { 756sub match($$;$$$) {
687 my $match = shift; 757 my $match = shift;
688 my $all = wantarray+0; 758 my $wantarray = wantarray+0;
689 759
690 &{ 760 &{
691 $CACHE{"$all$match"} ||= compile $match, $all 761 $CACHE{"$wantarray$match"} ||= compile $wantarray, $match
692 } 762 }
693} 763}
694 764
695our $CACHE_CLEARER = AE::timer 3600, 3600, sub { 765our $CACHE_CLEARER = AE::timer 3600, 3600, sub {
696 %CACHE = (); 766 %CACHE = ();

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines