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.16 by root, Mon Oct 12 19:36:43 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
66 condition in inv of originator 88 condition in inv of originator
67 89
68Once the final set of context objects has been established, each object 90Once the final set of context objects has been established, each object
69is matched against the C<condition>. 91is matched against the C<condition>.
70 92
93It is possible to chain modifiers from right-to-left, so this example
94would start with the originator, take it's inventory, find all inventory
95items which are potions, looks into their inventory, and then finds all
96spells.
97
98 type=SPELL in type=POTION in inv of originator
99
71Sometimes the server is only interested in knowing whether I<anything> 100Sometimes the server is only interested in knowing whether I<anything>
72matches, and sometimes the server is interested in I<all> objects that 101matches, and sometimes the server is interested in I<all> objects that
73match. 102match.
74 103
75=head2 OPERATORS 104=head2 OPERATORS
77=over 4 106=over 4
78 107
79=item and, or, not, () 108=item and, or, not, ()
80 109
81Conditions 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
82expressions. C<not> negates the expression, and parentheses can be used to 111expressions. C<not> negates the condition, and parentheses can be used to
83group 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)
84 124
85Example: match applied weapons. 125Example: match applied weapons.
86 126
87 applied type=WEAPON 127 applied type=WEAPON
88 128
89Example: match horns or rods. 129Example: match horns or rods.
90 130
91 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
92 136
93=item in ... 137=item in ...
94 138
95The 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
96a 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>
118 162
119=item in map 163=item in map
120 164
121Replaces 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.
122 166
167=item in head
168
169Replaces all objects by their head objects.
170
123=item in <condition> 171=item in <condition>
124 172
125Finds all context objects matching the condition, and then puts their 173Finds all context objects matching the condition, and then puts their
126inventories into the context set. 174inventories into the context set.
127 175
279=item any 327=item any
280 328
281This 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
282bit easier to read. 330bit easier to read.
283 331
332=item none
333
334This simply evaluates to false, and simply makes matching I<never> a bit
335easier to read.
336
284=item has(condition) 337=item has(condition)
285 338
286True iff the object has a matching inventory object. 339True iff the object has a matching inventory object.
287 340
288=item count(match) 341=item count(match)
289 342
290Number 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
291currently 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
292example. 345example.
293
294=item match(match)
295
296An independent match - semantics like C<count>, except it only matters
297whether the match finds any object (which is faster).
298 346
299=item dump() 347=item dump()
300 348
301Dumps 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.
302 350
317 365
318 match = chain 366 match = chain
319 | chain 'of' root 367 | chain 'of' root
320 root = 'object' | 'self' | 'source' | 'originator' 368 root = 'object' | 'self' | 'source' | 'originator'
321 chain = condition 369 chain = condition
322 | chain also deep 'in' set 370 | chain also deep 'in' modifier
323 also = nothing | 'also' 371 also = nothing | 'also'
324 deep = nothing | 'deep' 372 deep = nothing | 'deep'
325 set = 'inv' | 'env' | 'arch' | 'map' 373 modifier ='inv' | 'env' | 'arch' | 'map' | 'head'
326 374
327 empty = 375 nothing =
328 376
329 # boolean matching condition 377 # boolean matching condition
330 378
331 condition = factor 379 condition = factor
332 | factor 'and'? condition 380 | factor 'and'? condition
333 | factor 'or' condition 381 | factor 'or' condition
334 382
335 factor = 'not' factor 383 factor = 'not' factor
336 | '(' condition ')' 384 | '(' match ')'
337 | expr 385 | expr
338 | expr operator constant 386 | expr operator constant
339 387
340 operator = '=' | '==' | '!=' | '<' | '<=' | '>' | '>=' 388 operator = '=' | '==' | '!=' | '<' | '<=' | '>' | '>='
341 389
342 expr = flag 390 expr = flag
343 | sattr 391 | sattr
344 | aattr '[' <constant> ']' 392 | aattr '[' <constant> ']'
393 | 'stat.' statattr
345 | special 394 | special
346 | func '(' args ')' 395 | func '(' args ')'
347 | '{' perl code block '}' 396 | '{' perl code block '}'
348 397
349 func = <any function name> 398 func = <any function name>
350 sattr = <any scalar object attribute> 399 sattr = <any scalar object attribute>
351 aattr = <any array object attribute> 400 aattr = <any array object attribute>
352 flag = <any object flag> 401 flag = <any object flag>
402 statattr = <any stat attribute: exp, food, str, dex, hp, maxhp...>
353 special = <any ()-less "function"> 403 special = <any ()-less "function">
354 404
355 constant = <number> | '"' <string> '"' | <uppercase cf::XXX name> 405 constant = <number> | '"' <string> '"' | <uppercase cf::XXX name>
356 args = <depends on function> 406 args = <depends on function>
357 407
368package cf::match; 418package cf::match;
369 419
370use common::sense; 420use common::sense;
371 421
372use List::Util (); 422use List::Util ();
373
374# parser state
375# $_ # string to be parsed
376our $all; # find all, or just the first matching object
377 423
378{ 424{
379 package cf::match::exec; 425 package cf::match::exec;
380 426
381 use List::Util qw(first); 427 use List::Util qw(first);
386 432
387 sub ws { 433 sub ws {
388 /\G\s+/gc; 434 /\G\s+/gc;
389 } 435 }
390 436
437 sub condition ();
438 sub match ($$);
439
391 our %func = ( 440 our %func = (
392 has => sub { 441 has => sub {
393 'first { ' . &condition . ' } $_->inv' 442 'first { ' . condition . ' } $_->inv'
394 }, 443 },
395 count => sub { 444 count => sub {
396 local $all = 1;
397 '(scalar ' . &match ('$_') . ')' 445 '(scalar ' . (match 1, '$_') . ')'
398 },
399 match => sub {
400 local $all = 0;
401 '(scalar ' . &match ('$_') . ')'
402 }, 446 },
403 dump => sub { 447 dump => sub {
404 'do { 448 'do {
405 warn "cf::match::match dump:\n" 449 warn "cf::match::match dump:\n"
406 . "self: " . eval { $self->name } . "\n" 450 . "self: " . eval { $self->name } . "\n"
412 456
413 our %special = ( 457 our %special = (
414 any => sub { 458 any => sub {
415 1 459 1
416 }, 460 },
461 none => sub {
462 0
463 },
417 ); 464 );
418 465
419 sub constant { 466 sub constant {
420 ws; 467 ws;
421 468
428 die "number, string or uppercase constant name expected\n"; 475 die "number, string or uppercase constant name expected\n";
429 } 476 }
430 477
431 our $flag = $cf::REFLECT{object}{flags}; 478 our $flag = $cf::REFLECT{object}{flags};
432 our $sattr = $cf::REFLECT{object}{scalars}; 479 our $sattr = $cf::REFLECT{object}{scalars};
480 # quick hack to support archname, untested
481 $sattr->{archname} = "W";
433 our $aattr = $cf::REFLECT{object}{arrays}; 482 our $aattr = $cf::REFLECT{object}{arrays};
483 our $lattr = $cf::REFLECT{living}{scalars};
434 484
435 sub expr { 485 sub expr {
436 # ws done by factor 486 # ws done by factor
437 my $res; 487 my $res;
438 488
441 491
442 my $expr = $1; 492 my $expr = $1;
443 493
444 $res .= $expr =~ /\{([^;]+)\}/ ? $1 : "do $expr"; 494 $res .= $expr =~ /\{([^;]+)\}/ ? $1 : "do $expr";
445 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
446 } elsif (/\G([A-Za-z0-9_]+)/gc) { 506 } elsif (/\G([A-Za-z0-9_]+)/gc) {
447 507
448 if (my $func = $func{$1}) { 508 if (my $func = $func{$1}) {
449 /\G\s*\(/gc 509 /\G\s*\(/gc
450 or die "'(' expected after function name\n"; 510 or die "'(' expected after function name\n";
478 } else { 538 } else {
479 $res .= constant; 539 $res .= constant;
480 } 540 }
481 541
482 } else { 542 } else {
543 Carp::cluck;#d#
483 die "expr expected\n"; 544 die "expr expected\n";
484 } 545 }
485 546
486 $res 547 $res
487 } 548 }
504 $res .= "!"; 565 $res .= "!";
505 } 566 }
506 567
507 if (/\G\(/gc) { 568 if (/\G\(/gc) {
508 # () 569 # ()
509 $res .= &condition; 570
510 ws; 571 $res .= '(' . (match 0, '$_') . ')';
572
511 /\G\)/gc or die "')' expected\n"; 573 /\G\s*\)/gc or die "closing ')' expected\n";
512 574
513 } else { 575 } else {
514 my $expr = expr; 576 my $expr = expr;
515 577
516 $res .= $expr; 578 $res .= $expr;
527 } 589 }
528 590
529 "($res)" 591 "($res)"
530 } 592 }
531 593
532 sub condition { 594 sub condition () {
533 my $res = factor; 595 my $res = factor;
534 596
535 while () { 597 while () {
536 ws; 598 ws;
537 599
538 # 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
539 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) {
540 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.
541 last; 603 last;
542 604
543 } elsif (/\Gor\b/gc) { 605 } elsif (/\Gor\b/gc) {
544 $res .= " || "; 606 $res .= " || ";
551 } 613 }
552 614
553 $res 615 $res
554 } 616 }
555 617
556 sub match { 618 sub match ($$) {
557 my $default = shift; 619 my ($wantarray, $defctx) = @_;
558 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
559 my $res = ($all ? " grep { " : " first {") . condition . " }"; 631 $res = ($wantarray ? " grep { " : " first { ") . $res . "}";
560 632
561 while () { 633 while () {
562 ws; 634 ws;
563 635
564 my $also = /\Galso\s+/gc + 0; 636 my $also = /\Galso\s+/gc + 0;
565 my $deep = /\Gdeep\s+/gc + 0; 637 my $deep = /\Gdeep\s+/gc + 0;
566 638
567 if (/\Gin\s+/gc) { 639 if (/\Gin\s+/gc) {
568 my $expand; 640 my $expand;
569 641
570 if (/\G(inv|env|map|arch)\b/gc) { 642 if (/\G(inv|env|map|arch|head)\b/gc) {
571 if ($1 eq "inv") { 643 if ($1 eq "inv") {
572 $expand = "map \$_->inv,"; 644 $expand = "map \$_->inv,";
573 } elsif ($1 eq "env") { 645 } elsif ($1 eq "env") {
574 $expand = "map \$_->env // (),"; 646 $expand = "map \$_->env // (),";
647 } elsif ($1 eq "head") {
648 $expand = "map \$_->head,";
649 $deep = 0; # infinite loop otherwise
575 } elsif ($1 eq "arch") { 650 } elsif ($1 eq "arch") {
576 $expand = "map \$_->arch,"; 651 $expand = "map \$_->arch,";
652 $deep = 0; # infinite loop otherwise
577 } elsif ($1 eq "map") { 653 } elsif ($1 eq "map") {
578 $expand = "map \$_->map->at (\$_->x, \$_->y),"; 654 $expand = "map \$_->map->at (\$_->x, \$_->y),";
655 $deep = 0; # infinite loop otherwise
579 } 656 }
580 } else { 657 } else {
581 $expand = "map \$_->inv, grep { " . condition . " }"; 658 $expand = "map \$_->inv, grep { " . condition . " }";
582 } 659 }
583 660
591 $res .= " (\@res, \@_)\n" 668 $res .= " (\@res, \@_)\n"
592 . "}"; 669 . "}";
593 } else { 670 } else {
594 $res .= " $expand"; 671 $res .= " $expand";
595 } 672 }
673 } else {
674
596 } elsif (/\Gof\s+(self|object|source|originator)\b/gc) { 675 if (/\Gof\s+(self|object|source|originator)\b/gc) {
597 $also || $deep 676 $also || $deep
598 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";
599 678
600 if ($1 eq "self") { 679 if ($1 eq "self") {
601 return "$res \$self // ()"; 680 return "$res \$self // ()";
602 } elsif ($1 eq "object") { 681 } elsif ($1 eq "object") {
603 return "$res \$object"; 682 return "$res \$object";
604 } elsif ($1 eq "source") { 683 } elsif ($1 eq "source") {
605 return "$res \$source // ()"; 684 return "$res \$source // ()";
606 } elsif ($1 eq "originator") { 685 } elsif ($1 eq "originator") {
607 return "$res \$originator // \$source // ()"; 686 return "$res \$originator // \$source // ()";
687 }
688 } else {
689 return "$res $defctx";
608 } 690 }
609 } else {
610 return "$res $default";
611 } 691 }
612 } 692 }
613 } 693 }
614} 694}
615 695
616sub parse($;$) { 696sub parse($$) { # wantarray, matchexpr
617 local $_ = shift;
618 local $all = shift;
619
620 my $res; 697 my $res;
621 698
699 local $_ = $_[1];
700
622 eval { 701 eval {
623 $res = cf::match::parser::match "\$object"; 702 $res = cf::match::parser::match $_[0], "\$object";
624 703
625 /\G$/gc 704 /\G$/gc
626 or die "unexpected trailing characters after match\n"; 705 or die "unexpected trailing characters after match\n";
627 }; 706 };
628 707
637 716
638 $res 717 $res
639} 718}
640 719
641if (0) {#d# 720if (0) {#d#
642 die parse 'type=SPELL_EFFECT and match(name="bullet" in arch)', 1; 721 die parse 1, 'stats.pow';
643 exit 0; 722 exit 0;
644} 723}
645 724
646=item cf::match::match $match, $object[, $self[, $source[, $originator]]]
647
648Compiles (and caches) the C<$match> expression and matches it against
649the C<$object>. C<$self> should be the object initiating the match (or
650C<undef>), C<$source> should be the actor/source and C<$originator> the
651object that initiated the action (such as the player). C<$originator>
652defaults to C<$source> when not given.
653
654In list context it finds and returns all matching objects, in scalar
655context only a true or false value.
656
657=cut
658
659our %CACHE; 725our %CACHE;
660 726
661sub compile($$) { 727sub compile($$) {
662 my ($match, $all) = @_; 728 my ($wantarray, $match) = @_;
663 my $expr = parse $match, $all; 729 my $expr = parse $wantarray, $match;
664 warn "MATCH DEBUG $match,$all => $expr\n";#d# 730 warn "MATCH DEBUG $match,$wantarray => $expr\n";#d#
665 $expr = eval " 731 $expr = eval "
666 package cf::match::exec; 732 package cf::match::exec;
667 sub { 733 sub {
668 my (\$object, \$self, \$source, \$originator) = \@_; 734 my (\$object, \$self, \$source, \$originator) = \@_;
669 $expr 735 $expr
672 die if $@; 738 die if $@;
673 739
674 $expr 740 $expr
675} 741}
676 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
677sub match($$;$$$) { 756sub match($$;$$$) {
678 my $match = shift; 757 my $match = shift;
679 my $all = wantarray+0; 758 my $wantarray = wantarray+0;
680 759
681 &{ 760 &{
682 $CACHE{"$all$match"} ||= compile $match, $all 761 $CACHE{"$wantarray$match"} ||= compile $wantarray, $match
683 } 762 }
684} 763}
685 764
765our $CACHE_CLEARER = AE::timer 3600, 3600, sub {
766 %CACHE = ();
767};
768
686#d# $::schmorp=cf::player::find "schmorp"& 769#d# $::schmorp=cf::player::find "schmorp"&
687#d# cf::match::match '', $::schmorp->ob 770#d# cf::match::match '', $::schmorp->ob
688 771
689 772
690=back 773=back

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines