--- deliantra/server/lib/cf/match.pm 2009/10/12 19:39:30 1.17 +++ deliantra/server/lib/cf/match.pm 2010/03/20 20:26:18 1.25 @@ -1,3 +1,25 @@ +# +# This file is part of Deliantra, the Roguelike Realtime MMORPG. +# +# Copyright (©) 2009 Marc Alexander Lehmann / Robin Redeker / the Deliantra team +# +# Deliantra is free software: you can redistribute it and/or modify it under +# the terms of the Affero GNU General Public License as published by the +# Free Software Foundation, either version 3 of the License, or (at your +# option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the Affero GNU General Public License +# and the GNU General Public License along with this program. If not, see +# . +# +# The authors can be reached via e-mail to +# + =head1 NAME cf::match - object matching language @@ -68,6 +90,13 @@ Once the final set of context objects has been established, each object is matched against the C. +It is possible to chain modifiers from right-to-left, so this example +would start with the originator, take it's inventory, find all inventory +items which are potions, looks into their inventory, and then finds all +spells. + + type=SPELL in type=POTION in inv of originator + Sometimes the server is only interested in knowing whether I matches, and sometimes the server is interested in I objects that match. @@ -79,8 +108,19 @@ =item and, or, not, () Conditions can be combined with C or C to build larger -expressions. C negates the expression, and parentheses can be used to -group conditions. +expressions. C negates the condition, and parentheses can be used to +override operator precedence and execute submatches. + +Not that C only negates a condition and not the whole match +expressions, thus + + not applied in inv + +is true if there is I non-applied object in the inventory. To negate +a whole match, you have to use a sub-match: To check whether there is +I applied object in someones inventory, write this: + + not (applied in inv) Example: match applied weapons. @@ -90,6 +130,10 @@ type=HORN or type=ROD +Example: see if the originator is a player. + + type=PLAYER of originator + =item in ... The in operator takes the context set and modifies it in various ways. As @@ -120,6 +164,10 @@ Replaces all objects by the objects that are on the same mapspace as them. +=item in head + +Replaces all objects by their head objects. + =item in Finds all context objects matching the condition, and then puts their @@ -281,6 +329,11 @@ This simply evaluates to true, and simply makes matching I object a bit easier to read. +=item none + +This simply evaluates to false, and simply makes matching I a bit +easier to read. + =item has(condition) True iff the object has a matching inventory object. @@ -291,11 +344,6 @@ currently tested object - you can override this with an C for example. -=item match(match) - -An independent match - semantics like C, except 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. @@ -319,12 +367,12 @@ | chain 'of' root root = 'object' | 'self' | 'source' | 'originator' chain = condition - | chain also deep 'in' set + | chain also deep 'in' modifier also = nothing | 'also' deep = nothing | 'deep' - set = 'inv' | 'env' | 'arch' | 'map' + modifier ='inv' | 'env' | 'arch' | 'map' | 'head' - empty = + nothing = # boolean matching condition @@ -333,7 +381,7 @@ | factor 'or' condition factor = 'not' factor - | '(' condition ')' + | '(' match ')' | expr | expr operator constant @@ -342,6 +390,7 @@ expr = flag | sattr | aattr '[' ']' + | 'stat.' statattr | special | func '(' args ')' | '{' perl code block '}' @@ -350,6 +399,7 @@ sattr = aattr = flag = + statattr = special = constant = | '"' '"' | @@ -371,10 +421,6 @@ use List::Util (); -# parser state -# $_ # string to be parsed -our $all; # find all, or just the first matching object - { package cf::match::exec; @@ -388,17 +434,15 @@ /\G\s+/gc; } + sub condition (); + sub match ($$); + our %func = ( has => sub { - 'first { ' . &condition . ' } $_->inv' + 'first { ' . condition . ' } $_->inv' }, count => sub { - local $all = 1; - '(scalar ' . &match ('$_') . ')' - }, - match => sub { - local $all = 0; - '(scalar ' . &match ('$_') . ')' + '(scalar ' . (match 1, '$_') . ')' }, dump => sub { 'do { @@ -414,6 +458,9 @@ any => sub { 1 }, + none => sub { + 0 + }, ); sub constant { @@ -430,7 +477,10 @@ our $flag = $cf::REFLECT{object}{flags}; our $sattr = $cf::REFLECT{object}{scalars}; + # quick hack to support archname, untested + $sattr->{archname} = "W"; our $aattr = $cf::REFLECT{object}{arrays}; + our $lattr = $cf::REFLECT{living}{scalars}; sub expr { # ws done by factor @@ -443,6 +493,16 @@ $res .= $expr =~ /\{([^;]+)\}/ ? $1 : "do $expr"; + } elsif (/\Gstats\.([A-Za-z0-9_]+)/gc) { + + if (exists $lattr->{$1}) { + $res .= "\$_->stats->$1"; + } elsif (exists $lattr->{"\u$1"}) { + $res .= "\$_->stats->\u$1"; + } else { + die "living statistic name expected (str, pow, hp, sp...)\n"; + } + } elsif (/\G([A-Za-z0-9_]+)/gc) { if (my $func = $func{$1}) { @@ -480,6 +540,7 @@ } } else { + Carp::cluck;#d# die "expr expected\n"; } @@ -506,9 +567,10 @@ if (/\G\(/gc) { # () - $res .= &condition; - ws; - /\G\)/gc or die "')' expected\n"; + + $res .= '(' . (match 0, '$_') . ')'; + + /\G\s*\)/gc or die "closing ')' expected\n"; } else { my $expr = expr; @@ -529,14 +591,14 @@ "($res)" } - sub condition { + sub condition () { my $res = factor; while () { ws; # first check some stop-symbols, so we don't have to backtrack - if (/\G(?=also\b|deep\b|in\b|of\b\)|\z)/gc) { + if (/\G(?=also\b|deep\b|in\b|of\b|\)|\z)/gc) { pos = pos; # argh. the misop hits again. again. again. again. you die. last; @@ -553,10 +615,20 @@ $res } - sub match { - my $default = shift; + sub match ($$) { + my ($wantarray, $defctx) = @_; + + my $res = condition; + + # if nothing follows, we have a simple condition, so + # optimise a comon case. + if ($defctx eq '$_' and /\G\s*(?=\)|$)/gc) { + return $wantarray + ? "$res ? \$_ : ()" + : $res; + } - my $res = ($all ? " grep { " : " first {") . condition . " }"; + $res = ($wantarray ? " grep { " : " first { ") . $res . "}"; while () { ws; @@ -567,11 +639,14 @@ if (/\Gin\s+/gc) { my $expand; - if (/\G(inv|env|map|arch)\b/gc) { + if (/\G(inv|env|map|arch|head)\b/gc) { if ($1 eq "inv") { $expand = "map \$_->inv,"; } elsif ($1 eq "env") { $expand = "map \$_->env // (),"; + } elsif ($1 eq "head") { + $expand = "map \$_->head,"; + $deep = 0; # infinite loop otherwise } elsif ($1 eq "arch") { $expand = "map \$_->arch,"; $deep = 0; # infinite loop otherwise @@ -595,34 +670,36 @@ } else { $res .= " $expand"; } - } elsif (/\Gof\s+(self|object|source|originator)\b/gc) { - $also || $deep - and die "neither 'also' nor 'deep' can be used with 'of'\n"; - - if ($1 eq "self") { - return "$res \$self // ()"; - } elsif ($1 eq "object") { - return "$res \$object"; - } elsif ($1 eq "source") { - return "$res \$source // ()"; - } elsif ($1 eq "originator") { - return "$res \$originator // \$source // ()"; - } } else { - return "$res $default"; + + if (/\Gof\s+(self|object|source|originator)\b/gc) { + $also || $deep + and die "neither 'also' nor 'deep' can be used with 'of'\n"; + + if ($1 eq "self") { + return "$res \$self // ()"; + } elsif ($1 eq "object") { + return "$res \$object"; + } elsif ($1 eq "source") { + return "$res \$source // ()"; + } elsif ($1 eq "originator") { + return "$res \$originator // \$source // ()"; + } + } else { + return "$res $defctx"; + } } } } } -sub parse($;$) { - local $_ = shift; - local $all = shift; - +sub parse($$) { # wantarray, matchexpr my $res; + local $_ = $_[1]; + eval { - $res = cf::match::parser::match "\$object"; + $res = cf::match::parser::match $_[0], "\$object"; /\G$/gc or die "unexpected trailing characters after match\n"; @@ -641,29 +718,16 @@ } if (0) {#d# - die parse 'type=SPELL_EFFECT and match(name="bullet" in arch)', 1; + die parse 1, 'stats.pow'; exit 0; } -=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), 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 DEBUG $match,$all => $expr\n";#d# + my ($wantarray, $match) = @_; + my $expr = parse $wantarray, $match; + warn "MATCH DEBUG $match,$wantarray => $expr\n";#d# $expr = eval " package cf::match::exec; sub { @@ -676,15 +740,32 @@ $expr } +=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), 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 + sub match($$;$$$) { - my $match = shift; - my $all = wantarray+0; + my $match = shift; + my $wantarray = wantarray+0; &{ - $CACHE{"$all$match"} ||= compile $match, $all + $CACHE{"$wantarray$match"} ||= compile $wantarray, $match } } +our $CACHE_CLEARER = AE::timer 3600, 3600, sub { + %CACHE = (); +}; + #d# $::schmorp=cf::player::find "schmorp"& #d# cf::match::match '', $::schmorp->ob