package MObject;

use strict;
use vars qw(%Commands %BCommands %CmdAliases %CmdAliasesRev @ISA);
use constant CMD_PROFILE => 0;
use MModules;

sub Commands {
  @_ % 2 or croak "Odd number of arguments to MObject::CommandInterpreter::Commmands; expecting hash";
  my ($class, %cmds) = @_;
  $MModules::ModuleEvalContext or croak "MObject::Commands called outside of module eval context";
  if ($MModules::ModuleEvalContext eq 'unload') {
    foreach (keys %cmds) {delete $Commands{$_}; delete $BCommands{$_}}
  } elsif ($MModules::ModuleEvalContext eq 'load') {
    foreach (keys %cmds) {
      exists $Commands{$_} and die "Module attempted to redefine command $_";
      $Commands{$_} = $cmds{$_};
      $BCommands{$_} = $cmds{$_} if $cmds{$_}{basic};
    }
  } else {
    croak "Unknown module eval context";
  }
}

sub CommandAliases {
  my ($class, %aliases) = @_;
  $MModules::ModuleEvalContext or die;
  if ($MModules::ModuleEvalContext eq 'unload') {
    while (my ($cmd, $alst) = each %aliases) {
      delete $CmdAliasesRev{$cmd};
      foreach (@$alst) {
        delete $CmdAliases{$_};
      }
    }
  } else {
    foreach my $targ (keys %aliases) {
      my $alst = $aliases{$targ};
      $CmdAliasesRev{$targ} = [@$alst];
      foreach (@$alst) {
        exists $CmdAliases{$_} and die "Module attempted to redefine command alias $_";
        $CmdAliases{$_} = $targ;
      }
    }
  }
}

### Methods ############################################################

sub do {
  my ($self, $line, %opts) = @_;

  return unless $line;
  MScheduler::mon_set("Executing $line for ".$self->nphr); #FIXME
  
                                            #  ick ugh ack erk urk FIXME glark yuck eww urg  #
  if ( ($line =~ s/^\(// and my $psub=1) or ($line =~ /;/ and $line !~ /^('|say|shout|emote)/) ) {
       $line =~ s/\)$// if $psub;
    my $res = 1;
    my @parts = $self->cmd_split($line);
    if (@parts > 1) {
      foreach (@parts) {
        $res &&= $self->do($_);
      }
      return $res;
    }
  }
  
  my ($cmd, $args) = $self->cmd_parse($line);

  if (my $rcmd = $self->cmd_match($cmd)) {
    return $self->cmd_execute($rcmd, $args);

  } elsif ($self->connection and my $alias = $self->connection->pref('aliases')->{$cmd}) { 
    my @args = split /\s+/, $args;
    $alias =~ s/\$0/$args/g;
    $alias =~ s/\$([1-9])/            $args[$1 - 1] || ''    /ge;
    $alias =~ s/\$\*([1-9])/join ' ', @args[$1 - 1 .. $#args]/ge;
    $self->send("[$alias]");
    $self->do($alias);
    return 1;
    
  } else {
    $self->send("No such command: '$cmd'.");
    mudlog "KEYWORD: command '$cmd'";
    return 0;
  }      
}

sub cmd_split {
  my ($self, $line) = @_;

  my @segs = split /;/, $line;
  #$self->send("DEBUG: segments are ".join('<>', @segs));
  my ($pcount, @cmds, $res) = (0);    
  foreach (@segs) {
    if ($pcount > 0) {
      $cmds[-1] .= ";$_";
    } else {
      push @cmds, $_;
    }
    $pcount += tr/(//;
    $pcount -= tr/)//;
  }
  if ($pcount < -1) {
    $self->send("Too many right parentheses.");
    return;
  }
  #$self->send("DEBUG: commands are ".join('<>', @cmds));

  return @cmds;
}
  
sub cmd_parse {
  my ($self, $line) = @_;

  $line =~ s/^\s*(@?\w+|\S)\s*//;
  return wantarray ? ($1, $line) : $1;
}

sub cmd_match {
  my ($self, $cmd) = @_;

  $cmd = lc $cmd;
  my ($t, $rcmd);
  exists $Commands{$cmd} and $rcmd = $cmd;                return $rcmd if $rcmd and $self->cmd_allowed($rcmd);
  exists $CmdAliases{$cmd} and $rcmd = $CmdAliases{$cmd}; return $rcmd if $rcmd and $self->cmd_allowed($rcmd);
  ($rcmd) = grep(/^\Q$cmd/, keys %BCommands);             return $rcmd if $rcmd and $self->cmd_allowed($rcmd);
  ($rcmd) = grep(/^\Q$cmd/, keys %Commands );             return $rcmd if $rcmd and $self->cmd_allowed($rcmd);
  ($rcmd) = MSocials->cmatch($cmd);                       return $rcmd if $rcmd;
  ($t) = grep(/^\Q$cmd/, keys %CmdAliases) and $rcmd = $CmdAliases{$t}; return $rcmd if $rcmd and $self->cmd_allowed($rcmd);
  return;
}

sub cmd_allowed {
  my ($self, $cmd) = @_;

  foreach my $r (@{($Commands{$cmd} || return)->{requires} || []}) {
    my $m = "priv_$r";
    next if $self->get_val($m);
    return;
  }
  return 1;
}

sub cmd_execute {
  my ($self, $cmd, $args) = @_;

  if ($cmd =~ /^SOC:(.*)$/) {
    eval {MSocials->do($self, $1, $args)};
    if ($@) {
      if ($@ =~ /^(?:# )?CFAIL:(.*?)( at .+ line \d+\.|\.\nFile '.*'; Line \d+)$/) {
        $self->send($1);
        return 0;
      } else {
        mudlog qq~ERROR/COMMANDS: death while running "$cmd $args" for @{[$self->name]}: \n$@~;
        $self->send("&:sb;&:fw;[ Errors occurred while processing your command: ]\n$@&:n");
        return 0;
      }
    }
    return 1;
  }
  if (!$self->cmd_allowed($cmd)) {
    $self->send("You are not allowed to '$cmd'.");
    return;
  }
  my $cmdrec = $Commands{$cmd};
  $cmdrec or confess "cmd_execute called with bad command name!";
  my $code = $cmdrec->{code};
  my $then = Mac::Events::TickCount() if CMD_PROFILE;
  
  eval {
    if (ref $code) {
      $code->($self, $args);
    } elsif ($code eq 'GenericVerb') {
    
       my @pieces = split /\s*\b(@{[join '|', $::Config{prepositions}]})\b\s*/oi, $args;
       my $direct_obj = shift @pieces;
       my %objs = map {lc} @pieces;
       %objs = map {$_, $self->object_find($objs{$_})} keys %objs;
       
       foreach my $obj ($self->object_find(  $direct_obj, %{$cmdrec->{findopt} || {}}  )) {
         $obj->do_verb($self, $cmd, %objs);
       }

    } else {
      mudlog "ERROR/COMMANDS: Bad code for command '$cmd'";
    }
  };
  
  if (CMD_PROFILE and !$@) {
    my $now = Mac::Events::TickCount();
    mudlog "CMD PROFILE: $cmd for @{[$self->name]} took @{[($now - $then)]} ticks";
  }
  if ($@) {
    if ($@ =~ /^(?:# )?CFAIL:(.*?)( at .+ line \d+\.|\.\nFile '.*'; Line \d+)$/) {
      $self->send($1);
      return 0;
    } else {
      mudlog qq~ERROR/COMMANDS: death while running "$cmd $args" for @{[$self->name]}: \n$@~;
      $self->send("&:sb;&:fw;[ Errors occurred while processing your command: ]\n$@&:n");
      return 0;
    }
  }
  return 1;
}

sub cmdi_exists {
  my ($self, $cmd) = @_;
  return exists $Commands{$cmd};
}

sub cmdi_help {
  my ($self, $cmd) = @_;
  return unless $Commands{$cmd};
  return $Commands{$cmd}{help};
}

sub cmdi_requires {
  my ($self, $cmd) = @_;
  return unless $Commands{$cmd};
  return @{$Commands{$cmd}{requires}} if $Commands{$cmd}{requires};
  return;
}

sub cmdi_aliases {
  my ($self, $cmd) = @_;
  return unless $CmdAliasesRev{$cmd};
  return @{$CmdAliasesRev{$cmd}};
}

sub commands_for_display {
  my ($self) = @_;
  return sort grep { $self->cmd_allowed($_) } keys %Commands;
}

1;
