###################################################################

package KoLBot::Chatbot::Rule;
 
# Copyright (c) 2004 Alan W. Mahoney. All rights reserved. 
# This program is free software.  You may modify and/or 
# distribute it under the same terms as Perl itself.  
# This copyright notice must remain attached to the file.  
#

# This needs some work to make it more flexible, but I haven't had
# any real needs to extend it with my applications.  The following
# would be the most useful.  Then more flexible substitutions, etc.

# Flag for custom function: return 0/1 or return based on function
# Flag for whether rule "matches" if rate limited

use warnings;
use strict;

use POSIX qw( floor );

use KoLBot::KMail;
use KoLBot::ChatMessage;

use KoLBot::Chatbot::Action;

BEGIN 
{
  use Exporter ();
  our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS, $ID);

  $VERSION     = 0.5;
  $ID          = '$Id: Rule.pm 173 2006-10-30 17:29:34Z alan $';

  @ISA         = qw(Exporter);
  @EXPORT      = qw();
  %EXPORT_TAGS = ( );

  @EXPORT_OK   = qw();
}

our @EXPORT_OK;


##########################################
## element access
##########################################

for my $field (qw( iuser
		   ichannel
		   imessage
		   itype
		   iuserid

		   lqueue
		   gqueue
		   name
		   log
		   done

		   actions_pre
		   actions
		   actions_rl

		   )) {
  no strict "refs";
  *$field = sub {
    my $self = shift;
    $self->{$field} = shift if @_;
    return $self->{$field};
  }
}

##########################################
## Constructor helper
##########################################

sub make_c {
  my $pat = shift;
  eval 'sub { shift =~ /$pat/io }';
}

##########################################
## Constructor:
##########################################

# Needs to be called with a full config hashref.  See examples.

sub new {
  my $invocant = shift;
  my $class = ref($invocant) || $invocant;
  my $rule = { iuser    => '.*',
	       ichannel => '.*',
	       imessage => '.*',
	       itype    => 'private',
	       iuserid  => '.*',

	       done     => 1,
	       log      => 1,
	       name     => '',

	       actions_pre => [], # Before checking rate limiter
	       actions  => [],	  # If not rate limited
	       actions_rl  => [], # If rate limited

	       @_ };

  # backwards compatibility
  if(@{$rule->{actions}} < 1) {
    $rule->{actions} = [
			new KoLBot::Chatbot::Action(%$rule),
			];
  }
  ($rule->{log}) and
    unshift @{$rule->{actions_pre}},
    new KoLBot::Chatbot::Action(action => 'log');

  if(@{$rule->{actions_rl}} < 1) {
    $rule->{actions_rl} = [
		     new KoLBot::Chatbot::Action(action => 'print',
						 omessage => 'rate_limited',),
			];
  }

  # my $rm = $rule->{imessage};
  # make closure for matching
  # $rule->{imessage_closure} = eval 'sub { return (shift =~ /$rm/io); }';
  if($rule->{imessage} eq '.*') {
    $rule->{imessage_closure} = sub { return 1;};
  } else {
    $rule->{imessage_closure} = make_c($rule->{imessage});
  }

  if($rule->{iuser} eq '.*') {
    $rule->{iuser_closure} = sub { return 1;};
  } else {
    $rule->{iuser_closure} = make_c($rule->{iuser});
  }

  bless $rule, $class;
}

##########################################
## The rest
##########################################

sub process {
  my $rule = shift;
  my $params = { @_ };

  my $message = $params->{message};
  my $bot     = $params->{bot};
  my $ltr     = $params->{limiter};

#  $message->{type} =~ /$rule->{itype}/i or return 0;
  # Currently tested for in Chatbot.pm, assigned to queue

#  $message->{user} =~ /$rule->{iuser}/i or return 0;
  $rule->{iuser_closure}->($message->{user}) or return 0;
#  $message->{user_id} =~ /$rule->{iuserid}/i or return 0;

#  $message->{channel} =~ /$rule->{ichannel}/i or return 0;
  # currently tested in chatbot.pm, assigned to queue

  my $m = [];
  @$m = $rule->{imessage_closure}->($message->{message}) or return 0;

#   $message->{message} =~ /$rule->{imessage}/i or return 0;
#   $m->[0] = $1;
#   $m->[1] = $2;

  my $user_id = $message->{user_id};

  my $r;
  if(@{$rule->{actions_pre}}>0) {
    for my $action (@{$rule->{actions_pre}}) {
      # Seems we're passing everything
      # where does $r go?
      $r = $action->do($bot,$message,$m,$message->{user},
		       $rule,$user_id);
    }
  }

  my $nrl = 1;
  # Possibly rate limit it
  my $time = time();

  if(defined($rule->{gqueue})) {
    $nrl = $ltr->check(queue => $rule->{gqueue},
		       user  => 0,
		       time  => $time);
  }

  if($nrl && defined($rule->{lqueue})) {
    $nrl = $ltr->check(queue => $rule->{lqueue},
		       user  => $user_id,
		       time  => $time);
  }
  
#  my $u = $message->{user};
#  my $user_id = $message->{user_id};

  if($nrl) {
    # it is ok
#     if(@{$rule->actions} < 1) {
#       # AWM: temporary backwards compatibility
#       my $action = new KoLBot::Chatbot::Action(%$rule);
#       # Seems we're passing everything
#       $r = $action->do($bot,$message,$m,$u,$rule,$user_id); 
#       return $r if defined($r);
#       return $rule->done;
#     }

    for my $action (@{$rule->{actions}}) {
      # Seems we're passing everything
      $r = $action->do($bot,$message,$m,$message->{user},$rule,
		       $user_id);	
# AWM
      return $r if (defined($r));
    }
    return $r if (defined($r));
  } else {
    if(@{$rule->{actions_rl}}>0) {
      for my $action (@{$rule->{actions_rl}}) {
	# Seems we're passing everything
	$r = $action->do($bot,$message,$m,$message->{user},$rule,
			 $user_id);
      }
      return $r if (defined($r));
    }
  }
  return $rule->{done};
}

END {} ;

1;

