package MObject;

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

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

sub CommandAliases {
  my ($class, %aliases) = @_;
  $MLoaders::ModuleEvalContext or die;
  if ($MLoaders::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;
  
  if ( $line =~ s/^\(// ) {
       $line =~ s/\)$//;
    my $res;
    foreach ($self->cmd_split($line)) {
      $res = $self->do($_);
    }
    return $res;
  }
  
  if ($self->{commands_paused} and not ($line =~ s/^FORCE:// and $self->nonplayer)) {
    if ($opts{result_callback}) {
      $line = {cmd => $line, callback => $opts{result_callback}};
    }
    if ($opts{insert_at_head}) {
      unshift @{$self->{command_queue}}, $line;
    } else {
      push @{$self->{command_queue}}, $line;
    }
    return 1;
  }
  
  my ($cmd, $args) = $self->cmd_parse($line);

  if (my $rcmd = $self->cmd_match($cmd)) {
    my $res = $self->cmd_execute($rcmd, $args);
    $opts{result_callback}->($res) if $opts{result_callback};

  } 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("I don't understand '$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);
  ($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} || []}) {
    next if $self->$r();
    return;
  }
  return 1;
}

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

  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 $result;
  my $then = Mac::Events::TickCount() if CMD_PROFILE;
  eval {$result = $code->($self, $args)};
  if (CMD_PROFILE and !$@) {
    my $now = Mac::Events::TickCount();
    mudlog "CMD PROFILE: $cmd for @{[$self->name]} took @{[($now - $then)]} ticks";
  }
  if ($@) {
    if ($@ =~ /silent abort/) {
      return 0;
    } elsif ($@ =~ /^(?:# )?CFAIL:(.*?) at .+ line \d+.$/) {
      $self->send($1);
      return 0;
    } else {
      (my $lt = $@) =~ s#\n# / #g;
      mudlog qq~ERROR/COMMANDS: death while running "$cmd $args" for @{[$self->name]}: $lt~;
      $self->send("&sb;&fw;[ Errors occurred while processing your command: ]\n$@&n&n");
      return 0;
    }
  }
  return $result;
}

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 pause_commands {
  my ($self, $ptime) = @_;
  
  $self->{commands_paused}++;
  my $hook = sub {
    my %data = @_;
    MObject->by_id($data{owner})->resume_commands;
  };
  MScheduler->add_task(
    name => 'Resume Interpreter', 
    'time' => $ptime,
    owner => $self->id,
    hook => $hook,
    abort => $hook,
  ) if defined $ptime;
}

sub resume_commands {
  my ($self) = @_;
  --$self->{commands_paused};
  while ($self->{commands_paused} == 0 and my $cmd = shift @{$self->{command_queue}}) {
    if (not ref $cmd) {
      $self->do($cmd);
    } else {
      my $res = $self->do($cmd->{cmd});
      $cmd->{callback}->($res) if $cmd->{callback};
    }
  }
  $self->connection->force_prompt if $self->{commands_paused} == 0 and $self->{connection};
}

# for use in command 'requires' lists
sub nonplayer {
  my ($self) = @_;
  return $self->immortal or !$self->ispc;
}

sub commands_for_display {
  my ($self) = @_;
#  return map { s/^(.)/&fc;$1&n;/ if ($Commands{$_}{basic}); $_; } sort grep {&{sub{
  return sort grep {&{sub{
    foreach my $r (@{$Commands{$_}->{requires} || []}) {
      next if $self->$r();
      return 0;
    }
    1;
  }}} keys %Commands;
}

1;
