=head1 NAME

cf::match - object matching language

=head1 DESCRIPTION

This module implements a simple object matching language. It can be asked
to find any ("check for a match"), or all ("find all objects") matching
objects.

=head1 MATCH EXAMPLES

Match the object if it has a slaying field of C<key1>:

   slaying = "key1"

Match the object if it has an object with name C<force> and 
slaying C<poison> in it's inventory:

   has (name = "force" and slaying = "poison")

Find all inventory objects with value >= 10, which are not invisible:

   value >= 10 and not invisible in inv

Find all potions with spell objects inside them in someones inventory:

   type=SPELL in type=POTION in inv

Find all potions inside someones inventory, or inside applied containers:

   type=POTION also in type=CONTAINER and applied in inv

=head1 MATCH EXPRESSIONS

=head2 STRUCTURE

The two main structures are the C<match>, which selects objects matching
various criteria, and the C<condition, which determines if an object
matches some desired properties:

   condition
   condition in set

A C<cond> receives a set of "context objects" that it is applied to. This
is initially just one object - for altars, it is the object dropped on it,
for pedestals, the object on top of it and so on.

This set of context objects can be modified in various ways, for example
by replacing it with the inventories of all objects, or all objects on the
same mapspace, and so on, by using the C<in> operator:

   condition in inv
   condition in inv in originator

Once the set of context objects has been established, each object is
matched against the C<cond> expression. Sometimes the server is only
interested in knowing whether I<anything> matches, and sometimes the
server is interested in I<all> objects that match.

=head2 OPERATORS

=over 4

=item and, or, not, ()

Conditions can be combined with C<and> or C<or> to build larger
expressions. C<not> negates the expression, and parentheses can be used to
group conditions.

Example: match applied weapons.

   type=WEAPON and applied

Example: match horns or rods.

   type=HORN or type=ROD

=item in ...

The in operator takes the context set and modifies it in various ways. As
a less technical description, think of the C<in> as being a I<look into>
or I<look at> operator - instead of looking at whatever was provided to
the match, the C<in> operator lets you look at other sets of objects, most
often the inventory.

=over 4

=item in object

Replaces all objects by the default object - this is the object passed to
the match to match against by default. All matches have an explicit C<in
ctx> appended.

This must be the last C<in> expression in a match.

=item in source

Replaces all objects by the source object - this object is sometimes
passed to matches and represents the object is the source of the action,
such as a rod or a potion when it is applied. Often, the I<source> is the
same as the I<originator>.

This must be the last C<in> expression in a match.

=item in originator

Replaces all objects by the originator object - one step farther removed
than the I<source>, the I<originator> is sometimes passed to matches and
represents the original initiator of an action, most commonly a player or
monster.

=item in self

Replaces all objects by the object initiating/asking for the match - this
is basically always the object thatt he match expression is attached to.

This must be the last C<in> expression in a match.

=item in inv

Replaces all objects by their inventory.

Example: find all spell objects inside the object to be matched.

   type=SPELL in inv

=item in env

Replaces all objects by their containing object, if they have one.

=item in map

Replaces all objects by the objects that are on the same mapspace as them.

=item in <cond>

Finds all context objects matching the condition, and then puts their
inventories into the context set.

Note that C<in inv> is simply a special case of an C<< in <cond> >> that
matches any object.

Example: find all spells inside potions inside the inventory of the context
object(s).

   type=SPELL in type=POTION in inv

=item also in ...

Instead of replacing the context set with something new, the new objects
are added to the existing set.

Example: check if the context object I<is> a spell, or I<contains> a spell.

   type=SPELL also in inv

=item repeatedly in ...

Repeats the operation as many times as possible. This can be used to
recursively look into objects.

=item also repeatedly in ...

C<also> and C<repeatedly> can be combined.

Example: check if there are any unpaid items in an inventory,
or in the inventories of the inventory objects, and so on.

   unpaid also repeatedly in inv

Example: check if a object is inside a player.

   type=PLAYER also repeatedly in env

=back

=back

=head2 EXPRESSIONS

Expressions used in conditions usually consist of simple boolean checks
(flag XYZ is set) or simple comparisons.

=over 4

=item flags

Flag names (without the leading C<FLAG_>) can be used as-is, in which case
their corresponding flag value is used.

=item scalar object attributes

Object attributes that consist of a single value (C<name>, C<title>,
C<value> and so on) can be specified by simply using their name, in which
acse their corresponding value is used.

=item array objects attributes

The C<resist> array can be accessed by specifying C<< resist [ ATNR_type ]
>>.

Example: match an acid resistance higher than 30.

   resist[ATNR_ACID] > 30

=item functions

Some additional functions with or without arguments in parentheses are
available.

=item { BLOCK }

You can specify perl code to execute by putting it inside curly
braces. The last expression evaluated inside will become the result.

The perlcode can access C<$_>, which rferes to the object currently being
matches, and the C<$object>, C<$self>, C<$source> and C<$originator>.

Example: check whether the slaying field consists of digits only.

   { $_->slaying =~ /^\d+$/ }

=item comparisons, <, <=, ==, =, !=, =>, >

You can compare expressions against constants via any of these
operators. If the constant is a string, then a string compare will be
done, otherwise a numerical comparison is used.

Example: match an object with name "schnops" that has a value >= 10.

   name="schnops" and value >= 10

=item uppercase constant names

Any uppercase word that exists as constant inside the C<cf::> namespace
(that is, any deliantra constant) can also be used as-is, but needs to be
specified in uppercase.

Example: match a type of POTION (using C<cf::POTION>).

   type=POTION

=back

=head2 FUNCTIONS

=over 4

=item any

This simply evaluates to true, and simply makes matching I<any> object a
bit easier to read.

=item has(condition)

True iff the object has a matching inventory object.

=item count(match)

Number of matching objects - the context object for the C<match> is the
currently tested object - you can override this with an C<in object> for
example.

=item match(match)

An independent match - semantics like C<count>, 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.

Note that logical operations are short-circuiting, so this only dumps
potions:

   type=POTION and dump

=back

=head2 GRAMMAR

This is the grammar that was used to implement the matching language
module. It is meant to be easily readable by humans, not to implement it
exactly as-is.

   # object matching and selecting

   match     = set
             | match also rep 'in' set
   also      = nothing | 'also'
   rep       = nothing | 'rep' | 'repeatedly'

   set       = 'inv' | 'env' | 'map'
             | 'object' | 'source' | 'originator' | 'self'

   empty     =

   # boolean matching condition

   condition = factor
             | factor 'and'? cond
             | factor 'or'   cond

   factor    = 'not' factor
             | '(' cond ')'
             | expr
             | expr operator constant

   operator  = '=' | '==' | '!=' | '<' | '<=' | '>' | '>='

   expr      = flag
             | sattr
             | aattr '[' <constant> ']'
             | special
             | func '(' args ')'
             | '{' perl code block '}'

   func      = <any function name>
   sattr     = <any scalar object attribute>
   aattr     = <any array object attribute>
   flag      = <any object flag>
   special   = <any ()-less "function">

   constant  = <number> | '"' <string> '"' | <uppercase cf::XXX name>
   args      = <depends on function>

   TODO: repeatedly, env, contains, possbly matches

=cut

=head2 PERL FUNCTIONS

=over 4

=cut

package cf::match;

use common::sense;

use List::Util ();

# parser state
#   $_    # string to be parsed
our $all; # find all, or just the first matching object

{
   package cf::match::exec;

   use List::Util qw(first);

   sub env_chain {
      my @res;
      push @res, $_
         while $_ = $_->env;
      @res
   }

   package cf::match::parser;

   use common::sense;

   sub ws {
      /\G\s+/gc;
   }

   our %func = (
      has => sub {
         'first { ' . &condition . ' } $_->inv'
      },
      count => sub {
         local $all = 1;
         '(scalar ' . &match ('$_') . ')'
      },
      match => sub {
         local $all = 0;
         '(scalar ' . &match ('$_') . ')'
      },
   );

   our %special = (
      any => sub {
         1
      },
      dump => sub {
         'do {
            warn "cf::match::match dump:\n"
               . "self: " . eval { $self->name } . "\n"
               . $_->as_string;
            1
         }';
      },
   );

   sub constant {
      ws;

      return $1       if /\G([\-\+0-9\.]+)/gc;
      return "cf::$1" if /\G([A-Z0-9_]+)/gc;

      #TODO better string parsing, also include ''
      return $1       if /\G("[^"]+")/gc;

      die "number, string or uppercase constant name expected\n";
   }

   our $flag  = $cf::REFLECT{object}{flags};
   our $sattr = $cf::REFLECT{object}{scalars};
   our $aattr = $cf::REFLECT{object}{arrays};

   sub expr {
      # ws done by factor
      my $res;

      if (/\G ( \{ (?: (?> [^{}]+ ) | (?-1) )* \} ) /gcx) {
         # perl

         my $expr = $1;

         $res .= $expr =~ /\{([^;]+)\}/ ? $1 : "do $expr";

      } elsif (/\G([A-Za-z0-9_]+)/gc) {

         if (my $func = $func{$1}) {
            /\G\s*\(/gc
               or die "'(' expected after function name\n";

            $res .= $func->();

            /\G\s*\)/gc
               or die "')' expected after function arguments\n";

         } elsif (my $func = $special{$1}) {
            $res .= $func->();

         } elsif (exists $flag->{lc $1}) {
            $res .= "\$_->flag (cf::FLAG_\U$1)";

         } elsif (exists $sattr->{$1}) {
            $res .= "\$_->$1";

         } elsif (exists $aattr->{$1}) {

            $res .= "\$_->$1";

            /\G\s*\[/gc
               or die "'[' expected after array name\n";

            $res .= "(" . constant . ")";

            /\G\s*\]/gc
               or die "']' expected after array index\n";

         } else {
            $res .= constant;
         }

      } else {
         die "expr expected\n";
      }

      $res
   }

   our %stringop = (
      "==" => "eq",
      "!=" => "ne",
      "<=" => "le",
      ">=" => "ge",
      "<"  => "lt",
      ">"  => "gt",
   );

   sub factor {
      ws;

      my $res;

      if (/\Gnot\b\s*/gc) {
         $res .= "!";
      }

      if (/\G\(/gc) {
         # ()
         $res .= &condition;
         ws;
         /\G\)/gc or die "')' expected\n";

      } else {
         my $expr = expr;

         $res .= $expr;

         if (/\G\s*([=!<>]=?)/gc) {
            my $op = $1;

            $op = "==" if $op eq "=";
            my $const = constant;
            $op = $stringop{$op} if $const =~ /^"/;

            $res .= " $op $const";
         }
      }

      "($res)"
   }

   sub condition {
      my $res = factor;

      while () {
         ws;
         if (/\G(?=also\b|in\b|\)|$)/gc) {
            # early stop => faster and requires no backtracking
            last;
         } elsif (/\Gor\b/gc) {
            $res .= " || ";
         } else {
            /\Gand\b/gc;
            $res .= " && ";
         }
         $res .= factor;
      }

      $res
   }

   sub match {
      my $default = shift;

      my $res;

      my $also; # undef means first iteration
      while () {
         if (/\G\s*(inv|env|map|object|subject|originator)\b/gc) {
            if ($1 eq "inv") {
               $res .= " map+(${also}\$_->inv),";
            } elsif ($1 eq "env") {
               $res .= " map+(${also}env_chain), "; # TODO
            } elsif ($1 eq "map") {
               $res .= " map+(${also}\$_->map->at (\$_->x, \$_->y)),";
            } elsif ($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";
            }
            last unless /\G\s*in\b/gc;
         } else {
            $res .= " map+($also\$_->inv)," if defined $also;
            $res .= $all ? " grep { " : " first {";
            $res .= condition;
            $res .= "}";

            $also = /\G\s*also\b/gc ? '$_, ' : '';
            last unless /\G\s*in\b/gc;
         }
      }

      "$res $default"
   }

}

sub parse($;$) {
   local $_   = shift;
   local $all = shift;

   my $res = cf::match::parser::match "\$object";

   if ($@) {
      my $ctx = 20;
      my $str = substr $_, (List::Util::max 0, (pos) - $ctx), $ctx * 2;
      substr $str, (List::Util::min $ctx, pos), 0, "<-- HERE -->";

      chomp $@;
      die "$@ ($str)\n";
   }

   $res
}

if (0) {
   die parse 'match(any in object)', 1;
   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<undef>), 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,$all => $expr\n";#d#
   $expr = eval "
      package cf::match::exec;
      sub {
         my (\$object, \$self, \$source, \$originator) = \@_;
         \$originator ||= \$source;
         $expr
      }
   ";
   die if $@;

   $expr
}

sub match($$;$$$) {
   my $match = shift;
   my $all = wantarray+0;

   &{
      $CACHE{"$all$match"} ||= compile $match, $all
   }
}

#d# $::schmorp=cf::player::find "schmorp"&
#d# cf::match::match '', $::schmorp->ob


=back

=head1 AUTHOR

 Marc Lehmann <schmorp@schmorp.de>
 http://home.schmorp.de/

=cut

1;