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.15 by root, Mon Oct 12 17:37:43 2009 UTC vs.
Revision 1.22 by root, Sat Oct 24 11:45:40 2009 UTC

66 condition in inv of originator 66 condition in inv of originator
67 67
68Once the final set of context objects has been established, each object 68Once the final set of context objects has been established, each object
69is matched against the C<condition>. 69is matched against the C<condition>.
70 70
71It is possible to chain modifiers from right-to-left, so this example
72would start with the originator, take it's inventory, find all inventory
73items which are potions, looks into their inventory, and then finds all
74spells.
75
76 type=SPELL in type=POTION in inv of originator
77
71Sometimes the server is only interested in knowing whether I<anything> 78Sometimes the server is only interested in knowing whether I<anything>
72matches, and sometimes the server is interested in I<all> objects that 79matches, and sometimes the server is interested in I<all> objects that
73match. 80match.
74 81
75=head2 OPERATORS 82=head2 OPERATORS
77=over 4 84=over 4
78 85
79=item and, or, not, () 86=item and, or, not, ()
80 87
81Conditions can be combined with C<and> or C<or> to build larger 88Conditions can be combined with C<and> or C<or> to build larger
82expressions. C<not> negates the expression, and parentheses can be used to 89expressions. C<not> negates the condition, and parentheses can be used to
83group conditions. 90override operator precedence and execute submatches.
91
92Not that C<not> only negates a condition and not the whole match
93expressions, thus
94
95 not applied in inv
96
97is true if there is I<any> non-object in the inventory. To negate a whole
98match, you have to use a sub-match. To check whether there is I<no>
99applied object in someones inventory, write this:
100
101 not (applied in inv)
84 102
85Example: match applied weapons. 103Example: match applied weapons.
86 104
87 applied type=WEAPON 105 applied type=WEAPON
88 106
118 136
119=item in map 137=item in map
120 138
121Replaces all objects by the objects that are on the same mapspace as them. 139Replaces all objects by the objects that are on the same mapspace as them.
122 140
141=item in head
142
143Replaces all objects by their head objects.
144
123=item in <condition> 145=item in <condition>
124 146
125Finds all context objects matching the condition, and then puts their 147Finds all context objects matching the condition, and then puts their
126inventories into the context set. 148inventories into the context set.
127 149
140 162
141Example: check if the context object I<is> a spell, or I<contains> a spell. 163Example: check if the context object I<is> a spell, or I<contains> a spell.
142 164
143 type=SPELL also in inv 165 type=SPELL also in inv
144 166
145=item deep in ... 167=item also deep in ...
146 168
147Repeats the operation as many times as possible. This can be used to 169Repeats the operation as many times as possible. This can be used to
148recursively look into objects. 170recursively look into objects.
149 171
150=item also deep in ... 172So for example, C<also deep in inv> means to take the inventory of all
173objects, taking their inventories, and so on, and adding all these objects
174to the context set.
151 175
152C<also> and C<deep> can be combined. 176Similarly, C<also deep in env> means to take the environment object, their
177environemnt object and so on.
153 178
154Example: check if there are any unpaid items in an inventory, 179Example: check if there are any unpaid items in an inventory,
155or in the inventories of the inventory objects, and so on. 180or in the inventories of the inventory objects, and so on.
156 181
157 unpaid also deep in inv 182 unpaid also deep in inv
276=item any 301=item any
277 302
278This simply evaluates to true, and simply makes matching I<any> object a 303This simply evaluates to true, and simply makes matching I<any> object a
279bit easier to read. 304bit easier to read.
280 305
306=item none
307
308This simply evaluates to false, and simply makes matching I<never> a bit
309easier to read.
310
281=item has(condition) 311=item has(condition)
282 312
283True iff the object has a matching inventory object. 313True iff the object has a matching inventory object.
284 314
285=item count(match) 315=item count(match)
286 316
287Number of matching objects - the context object for the C<match> is the 317Number of matching objects - the context object for the C<match> is the
288currently tested object - you can override this with an C<in object> for 318currently tested object - you can override this with an C<in object> for
289example. 319example.
290
291=item match(match)
292
293An independent match - semantics like C<count>, except it only matters
294whether the match finds any object (which is faster).
295 320
296=item dump() 321=item dump()
297 322
298Dumps the object to the server log when executed, and evaluates to true. 323Dumps the object to the server log when executed, and evaluates to true.
299 324
314 339
315 match = chain 340 match = chain
316 | chain 'of' root 341 | chain 'of' root
317 root = 'object' | 'self' | 'source' | 'originator' 342 root = 'object' | 'self' | 'source' | 'originator'
318 chain = condition 343 chain = condition
319 | chain also deep 'in' set 344 | chain also deep 'in' modifier
320 also = nothing | 'also' 345 also = nothing | 'also'
321 deep = nothing | 'deep' 346 deep = nothing | 'deep'
322 set = 'inv' | 'env' | 'arch' | 'map' 347 modifier ='inv' | 'env' | 'arch' | 'map' | 'head'
323 348
324 empty = 349 nothing =
325 350
326 # boolean matching condition 351 # boolean matching condition
327 352
328 condition = factor 353 condition = factor
329 | factor 'and'? condition 354 | factor 'and'? condition
330 | factor 'or' condition 355 | factor 'or' condition
331 356
332 factor = 'not' factor 357 factor = 'not' factor
333 | '(' condition ')' 358 | '(' match ')'
334 | expr 359 | expr
335 | expr operator constant 360 | expr operator constant
336 361
337 operator = '=' | '==' | '!=' | '<' | '<=' | '>' | '>=' 362 operator = '=' | '==' | '!=' | '<' | '<=' | '>' | '>='
338 363
339 expr = flag 364 expr = flag
340 | sattr 365 | sattr
341 | aattr '[' <constant> ']' 366 | aattr '[' <constant> ']'
367 | 'stat.' statattr
342 | special 368 | special
343 | func '(' args ')' 369 | func '(' args ')'
344 | '{' perl code block '}' 370 | '{' perl code block '}'
345 371
346 func = <any function name> 372 func = <any function name>
347 sattr = <any scalar object attribute> 373 sattr = <any scalar object attribute>
348 aattr = <any array object attribute> 374 aattr = <any array object attribute>
349 flag = <any object flag> 375 flag = <any object flag>
376 statattr = <any stat attribute: exp, food, str, dex, hp, maxhp...>
350 special = <any ()-less "function"> 377 special = <any ()-less "function">
351 378
352 constant = <number> | '"' <string> '"' | <uppercase cf::XXX name> 379 constant = <number> | '"' <string> '"' | <uppercase cf::XXX name>
353 args = <depends on function> 380 args = <depends on function>
354 381
365package cf::match; 392package cf::match;
366 393
367use common::sense; 394use common::sense;
368 395
369use List::Util (); 396use List::Util ();
370
371# parser state
372# $_ # string to be parsed
373our $all; # find all, or just the first matching object
374 397
375{ 398{
376 package cf::match::exec; 399 package cf::match::exec;
377 400
378 use List::Util qw(first); 401 use List::Util qw(first);
383 406
384 sub ws { 407 sub ws {
385 /\G\s+/gc; 408 /\G\s+/gc;
386 } 409 }
387 410
411 sub condition ();
412 sub match ($$);
413
388 our %func = ( 414 our %func = (
389 has => sub { 415 has => sub {
390 'first { ' . &condition . ' } $_->inv' 416 'first { ' . condition . ' } $_->inv'
391 }, 417 },
392 count => sub { 418 count => sub {
393 local $all = 1;
394 '(scalar ' . &match ('$_') . ')' 419 '(scalar ' . (match 1, '$_') . ')'
395 },
396 match => sub {
397 local $all = 0;
398 '(scalar ' . &match ('$_') . ')'
399 }, 420 },
400 dump => sub { 421 dump => sub {
401 'do { 422 'do {
402 warn "cf::match::match dump:\n" 423 warn "cf::match::match dump:\n"
403 . "self: " . eval { $self->name } . "\n" 424 . "self: " . eval { $self->name } . "\n"
409 430
410 our %special = ( 431 our %special = (
411 any => sub { 432 any => sub {
412 1 433 1
413 }, 434 },
435 none => sub {
436 0
437 },
414 ); 438 );
415 439
416 sub constant { 440 sub constant {
417 ws; 441 ws;
418 442
426 } 450 }
427 451
428 our $flag = $cf::REFLECT{object}{flags}; 452 our $flag = $cf::REFLECT{object}{flags};
429 our $sattr = $cf::REFLECT{object}{scalars}; 453 our $sattr = $cf::REFLECT{object}{scalars};
430 our $aattr = $cf::REFLECT{object}{arrays}; 454 our $aattr = $cf::REFLECT{object}{arrays};
455 our $lattr = $cf::REFLECT{living}{scalars};
431 456
432 sub expr { 457 sub expr {
433 # ws done by factor 458 # ws done by factor
434 my $res; 459 my $res;
435 460
438 463
439 my $expr = $1; 464 my $expr = $1;
440 465
441 $res .= $expr =~ /\{([^;]+)\}/ ? $1 : "do $expr"; 466 $res .= $expr =~ /\{([^;]+)\}/ ? $1 : "do $expr";
442 467
468 } elsif (/\Gstats\.([A-Za-z0-9_]+)/gc) {
469
470 if (exists $lattr->{$1}) {
471 $res .= "\$_->stats->$1";
472 } elsif (exists $lattr->{"\u$1"}) {
473 $res .= "\$_->stats->\u$1";
474 } else {
475 die "living statistic name expected (str, pow, hp, sp...)\n";
476 }
477
443 } elsif (/\G([A-Za-z0-9_]+)/gc) { 478 } elsif (/\G([A-Za-z0-9_]+)/gc) {
444 479
445 if (my $func = $func{$1}) { 480 if (my $func = $func{$1}) {
446 /\G\s*\(/gc 481 /\G\s*\(/gc
447 or die "'(' expected after function name\n"; 482 or die "'(' expected after function name\n";
475 } else { 510 } else {
476 $res .= constant; 511 $res .= constant;
477 } 512 }
478 513
479 } else { 514 } else {
515 Carp::cluck;#d#
480 die "expr expected\n"; 516 die "expr expected\n";
481 } 517 }
482 518
483 $res 519 $res
484 } 520 }
501 $res .= "!"; 537 $res .= "!";
502 } 538 }
503 539
504 if (/\G\(/gc) { 540 if (/\G\(/gc) {
505 # () 541 # ()
506 $res .= &condition; 542
507 ws; 543 $res .= '(' . (match 0, '$_') . ')';
544
508 /\G\)/gc or die "')' expected\n"; 545 /\G\s*\)/gc or die "closing ')' expected\n";
509 546
510 } else { 547 } else {
511 my $expr = expr; 548 my $expr = expr;
512 549
513 $res .= $expr; 550 $res .= $expr;
524 } 561 }
525 562
526 "($res)" 563 "($res)"
527 } 564 }
528 565
529 sub condition { 566 sub condition () {
530 my $res = factor; 567 my $res = factor;
531 568
532 while () { 569 while () {
533 ws; 570 ws;
534 571
535 # first check some stop-symbols, so we don't have to backtrack 572 # first check some stop-symbols, so we don't have to backtrack
536 if (/\G(?=also\b|deep\b|in\b|of\b\)|\z)/gc) { 573 if (/\G(?=also\b|deep\b|in\b|of\b|\)|\z)/gc) {
537 pos = pos; # argh. the misop hits again. again. again. again. you die. 574 pos = pos; # argh. the misop hits again. again. again. again. you die.
538 last; 575 last;
539 576
540 } elsif (/\Gor\b/gc) { 577 } elsif (/\Gor\b/gc) {
541 $res .= " || "; 578 $res .= " || ";
548 } 585 }
549 586
550 $res 587 $res
551 } 588 }
552 589
553 sub match { 590 sub match ($$) {
554 my $default = shift; 591 my ($wantarray, $defctx) = @_;
555 592
593 my $res = condition;
594
595 # if nothing follows, we have a simple condition, so
596 # optimise a comon case.
597 if ($defctx eq '$_' and /\G\s*(?=\)|$)/gc) {
598 return $wantarray
599 ? "$res ? \$_ : ()"
600 : $res;
601 }
602
556 my $res = ($all ? " grep { " : " first {") . condition . " }"; 603 $res = ($wantarray ? " grep { " : " first { ") . $res . "}";
557 604
558 while () { 605 while () {
559 ws; 606 ws;
560 607
561 my $also = /\Galso\s+/gc + 0; 608 my $also = /\Galso\s+/gc + 0;
562 my $deep = /\Gdeep\s+/gc + 0; 609 my $deep = /\Gdeep\s+/gc + 0;
563 610
564 if (/\Gin\s+/gc) { 611 if (/\Gin\s+/gc) {
565 my $expand; 612 my $expand;
566 613
567 if (/\G(inv|env|map|arch)\b/gc) { 614 if (/\G(inv|env|map|arch|head)\b/gc) {
568 if ($1 eq "inv") { 615 if ($1 eq "inv") {
569 $expand = "map \$_->inv,"; 616 $expand = "map \$_->inv,";
570 } elsif ($1 eq "env") { 617 } elsif ($1 eq "env") {
571 $expand = "map \$_->env // (),"; 618 $expand = "map \$_->env // (),";
619 } elsif ($1 eq "head") {
620 $expand = "map \$_->head,";
621 $deep = 0; # infinite loop otherwise
572 } elsif ($1 eq "arch") { 622 } elsif ($1 eq "arch") {
573 $expand = "map \$_->arch,"; 623 $expand = "map \$_->arch,";
624 $deep = 0; # infinite loop otherwise
574 } elsif ($1 eq "map") { 625 } elsif ($1 eq "map") {
575 $expand = "map \$_->map->at (\$_->x, \$_->y),"; 626 $expand = "map \$_->map->at (\$_->x, \$_->y),";
627 $deep = 0; # infinite loop otherwise
576 } 628 }
577 } else { 629 } else {
578 $expand = "map \$_->inv, grep { " . condition . " }"; 630 $expand = "map \$_->inv, grep { " . condition . " }";
579 } 631 }
580 632
588 $res .= " (\@res, \@_)\n" 640 $res .= " (\@res, \@_)\n"
589 . "}"; 641 . "}";
590 } else { 642 } else {
591 $res .= " $expand"; 643 $res .= " $expand";
592 } 644 }
645 } else {
646
593 } elsif (/\Gof\s+(self|object|source|originator)\b/gc) { 647 if (/\Gof\s+(self|object|source|originator)\b/gc) {
594 $also || $deep 648 $also || $deep
595 and die "neither 'also' nor 'deep' can be used with 'of'\n"; 649 and die "neither 'also' nor 'deep' can be used with 'of'\n";
596 650
597 if ($1 eq "self") { 651 if ($1 eq "self") {
598 return "$res \$self // ()"; 652 return "$res \$self // ()";
599 } elsif ($1 eq "object") { 653 } elsif ($1 eq "object") {
600 return "$res \$object"; 654 return "$res \$object";
601 } elsif ($1 eq "source") { 655 } elsif ($1 eq "source") {
602 return "$res \$source // ()"; 656 return "$res \$source // ()";
603 } elsif ($1 eq "originator") { 657 } elsif ($1 eq "originator") {
604 return "$res \$originator // \$source // ()"; 658 return "$res \$originator // \$source // ()";
659 }
660 } else {
661 return "$res $defctx";
605 } 662 }
606 } else {
607 return "$res $default";
608 } 663 }
609 } 664 }
610 } 665 }
611} 666}
612 667
613sub parse($;$) { 668sub parse($$) { # wantarray, matchexpr
614 local $_ = shift;
615 local $all = shift;
616
617 my $res; 669 my $res;
618 670
671 local $_ = $_[1];
672
619 eval { 673 eval {
620 $res = cf::match::parser::match "\$object"; 674 $res = cf::match::parser::match $_[0], "\$object";
621 675
622 /\G$/gc 676 /\G$/gc
623 or die "unexpected trailing characters after match\n"; 677 or die "unexpected trailing characters after match\n";
624 }; 678 };
625 679
634 688
635 $res 689 $res
636} 690}
637 691
638if (0) {#d# 692if (0) {#d#
639 die parse 'type=SPELL_EFFECT and match(name="bullet" in arch)', 1; 693 die parse 1, 'stats.pow';
640 exit 0; 694 exit 0;
641} 695}
642 696
643=item cf::match::match $match, $object[, $self[, $source[, $originator]]]
644
645Compiles (and caches) the C<$match> expression and matches it against
646the C<$object>. C<$self> should be the object initiating the match (or
647C<undef>), C<$source> should be the actor/source and C<$originator> the
648object that initiated the action (such as the player). C<$originator>
649defaults to C<$source> when not given.
650
651In list context it finds and returns all matching objects, in scalar
652context only a true or false value.
653
654=cut
655
656our %CACHE; 697our %CACHE;
657 698
658sub compile($$) { 699sub compile($$) {
659 my ($match, $all) = @_; 700 my ($wantarray, $match) = @_;
660 my $expr = parse $match, $all; 701 my $expr = parse $wantarray, $match;
661 warn "MATCH DEBUG $match,$all => $expr\n";#d# 702 warn "MATCH DEBUG $match,$wantarray => $expr\n";#d#
662 $expr = eval " 703 $expr = eval "
663 package cf::match::exec; 704 package cf::match::exec;
664 sub { 705 sub {
665 my (\$object, \$self, \$source, \$originator) = \@_; 706 my (\$object, \$self, \$source, \$originator) = \@_;
666 $expr 707 $expr
669 die if $@; 710 die if $@;
670 711
671 $expr 712 $expr
672} 713}
673 714
715=item cf::match::match $match, $object[, $self[, $source[, $originator]]]
716
717Compiles (and caches) the C<$match> expression and matches it against
718the C<$object>. C<$self> should be the object initiating the match (or
719C<undef>), C<$source> should be the actor/source and C<$originator> the
720object that initiated the action (such as the player). C<$originator>
721defaults to C<$source> when not given.
722
723In list context it finds and returns all matching objects, in scalar
724context only a true or false value.
725
726=cut
727
674sub match($$;$$$) { 728sub match($$;$$$) {
675 my $match = shift; 729 my $match = shift;
676 my $all = wantarray+0; 730 my $wantarray = wantarray+0;
677 731
678 &{ 732 &{
679 $CACHE{"$all$match"} ||= compile $match, $all 733 $CACHE{"$wantarray$match"} ||= compile $wantarray, $match
680 } 734 }
681} 735}
682 736
737our $CACHE_CLEARER = AE::timer 3600, 3600, sub {
738 %CACHE = ();
739};
740
683#d# $::schmorp=cf::player::find "schmorp"& 741#d# $::schmorp=cf::player::find "schmorp"&
684#d# cf::match::match '', $::schmorp->ob 742#d# cf::match::match '', $::schmorp->ob
685 743
686 744
687=back 745=back

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines