package MCommandContext;
# Things I want accessible to commands

use MGlobals;
use MLoaders;

package MCommandInterpreter;

# Note: this package does NOT contain the scripting engine, since that
# is more tightly related to the object than the command interpreter.

# In fact, I may sometime decide to get rid of this class, since
# there is ALWAYS exactly one MCommandInterpreter to an MObject.

use strict;
use vars qw(%Commands %BCommands @ISA);
use MGlobals;
use AllocTracker;

#@ISA = qw(AllocTracker);

sub load_commands {
  my ($class) = @_;

  %Commands = ();
  %BCommands = ();
  # print "Loading commands...\n";
  local *CMDIR;
  opendir CMDIR, ":engine:commands" or die $!;
  while (defined (my $f = readdir CMDIR)) {
    next unless -d ":engine:commands:$f";
    local *CMDIR;
    opendir CMDIR, ":engine:commands:$f" or die $!;
    while (defined (my $c = readdir CMDIR)) {
      next unless $c =~ /^(.*)\.cp(b?)$/;
      my ($cmd, $bflag) = ($1, $2);
      my $path = ":engine:commands:$f:$c";
      open CMD, $path or die "$!: $path";
      local $/; 
      # print "  $f/$c\n";
      # we trust stuff from local commands dir
      (my $code) = <CMD> =~ /(\A.*\Z)/s;
      $Commands{$f}{$cmd} = eval <<"EOC";
package MCommandContext;
sub {
  my (\$self, \$args) = \@_;
# line 1 "$path"
$code
};
EOC
      die $@ if $@;
      $BCommands{$f}{$cmd} = $Commands{$f}{$cmd} if $bflag;
      close CMD;
    }
    closedir CMDIR;
  }
  closedir CMDIR;
  # print "done.\n";
}

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

sub new {
  my ($class, $context, $type) = @_;

  my $self = bless {
    context => $context,
    type => $type,
  }, $class;
  print "$self CREATED\n" if ::GC_DEBUG;
  #$self->ALLOC;

  return $self;
}

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

  return unless $line;
  $line =~ s/^\s*(\w+|\S)\s*//;
  my $cmd = lc $1;
  my $ex_tab = $self->{context}->container->exits
    if $self->{context}->container;
  my $cmd_tab = $self->get_cmdlist;
  my $bcmd_tab = $self->get_bcmdlist;
  my $rcmd;

  # Certain commands should be given priority in prefix searches;
  # e.g. "l" matches "look" not "load".

  if ($ex_tab and exists $ex_tab->{$cmd}) {
    $self->{context}->move_direction_cmd($cmd);

  } elsif ($ex_tab and ($rcmd) = grep(/^\Q$cmd/, sort keys %$ex_tab)) {
    $self->{context}->move_direction_cmd($rcmd);

  } elsif (exists $cmd_tab->{$cmd}) {
    $self->_do($cmd, $line);

  } elsif (($rcmd) = grep(/^\Q$cmd/, keys %$bcmd_tab)) {
    $self->_do($rcmd, $line);

  } elsif (($rcmd) = grep(/^\Q$cmd/, keys %$cmd_tab)) {
    $self->_do($rcmd, $line);

  } elsif ($self->{context}->connection and exists $self->{context}->connection->{aliases}{$cmd}) {
    my $alias = $self->{context}->connection->{aliases}{$cmd};
    my @args = split /\s+/, $line;
    foreach (split /;/, $alias) {
      my $a = $_;
      $a =~ s/\$0/$line/g;
      $a =~ s/\$([1-9])/$args[$1 - 1]/ge;
      $self->do($a);
    }

  } else {
    $self->{context}->send("Huh??");
  }      
}

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

  my $code = ${$self->get_cmdlist}{$cmd};
  eval {$code->($self->{context}, $args)};
  if ($@ and $@ !~ /silent abort/) {
    (my $lt = $@) =~ s#\n# / #g;
    syslog qq~ERROR/COMMANDS: death while running "$cmd $args" for @{[$self->{context}->name]}: $lt~;
    $self->{context}->send("&sb;&sf;[ Errors occurred while processing your command: ]\n$@\[ Please report this problem. ]&n");
  } 
}

sub get_cmdlist {
  my ($self) = @_;
  my %cmds = %{$Commands{'any'}};
  foreach (keys %Commands) {
    @cmds{keys %{$Commands{$_}}} = values %{$Commands{$_}}
      if $self->{type} =~ /\b\Q$_\E\b/;
  }
  my $cmdref = \%cmds;
  bless $cmdref, 'CmdTable';
  $cmdref->ALLOC;
  return $cmdref;
}

sub get_bcmdlist {
  my ($self) = @_;
  my %cmds = %{$BCommands{'any'}};
  foreach (keys %BCommands) {
    @cmds{keys %{$BCommands{$_}}} = values %{$BCommands{$_}}
      if $self->{type} =~ /\b\Q$_\E\b/;
  }
  my $cmdref = \%cmds;
  bless $cmdref, 'CmdTable';
  $cmdref->ALLOC;
  return $cmdref;
}

sub get_disp_cmdlist {
  my ($self) = @_;
  my %cmds;
  foreach my $cmd (keys %{$Commands{'any'}}) {
    $cmds{$cmd} = 'any';
  }
  foreach (keys %Commands) {
    next unless $self->{type} =~ /\b\Q$_\E\b/;
    foreach my $cmd (keys %{$Commands{$_}}) {
      $cmds{$cmd} = $_;
    }
  }
  my $cmdref = \%cmds;
  bless $cmdref, 'CmdTable';
  $cmdref->ALLOC;
  return $cmdref;
}

sub type {
  my ($self, $type) = @_;
  $self->{type} = $type if $type;
  $self->{type};
}

sub dispose {
  my ($self) = @_;
  %$self = ();
}

sub DESTROY {
  my ($self) = @_;
  print "$self DESTROYING\n" if ::GC_DEBUG;
  $self->dispose;
  print "$self DESTROYED\n" if ::GC_DEBUG;
  $self->SUPER::DESTROY;
  1;
}

{
package CmdTable;
use vars '@ISA';
@ISA = qw(AllocTracker);
}

1;
