package MConnection;
use strict;
use vars qw(
  %InputHandlers
  %EnterHandlers
  %PromptHandlers
);

# Each line of input is directed to one of these subroutines, depending on
# the 'state' of the connection.
%InputHandlers = (
'wait' => sub {},
'login' => sub {
  my ($self, $input) = @_;
  $input or return;
  my $name = ucfirst $input;
  $self->{login_name} = $name;
  #$self->send("pfilename = ".pfilename($name));
  if ($name !~ /^[A-Za-z ]{1,20}$/) {
    $self->send("Names must be entirely letters and less than 21 characters long.");
    return;
  } elsif ($name =~ /^guest$/i) {
    $self->{login_name} = 'guest'; # regularize case
    $self->setstate('select_proto');
  } elsif (!-e pfilename($name) ) {
    $self->setstate('confirm_name');
    return;
  }
  $self->read_pdata;
  if ($self->has_password) {
    $self->setstate('pass');
  } else {
    $self->setstate('menu', 'login');
  }
},
'pass' => sub {
  my ($self, $input) = @_;
  unless ($self->authenticate($input)) {
    $self->send('Incorrect password.');
    $self->id_log("bad login attempt.");
    $self->disconnect;
    return;
  }
  $self->setstate('menu', 'login');
},
'newpass_old' => sub {
  my ($self, $input) = @_;
  $input or do {$self->send("Cancelled."); $self->setstate('menu'); return};
  unless ($self->authenticate($input)) {
    $self->send('Incorrect password.');
    $self->setstate('menu');
    return;
  }
  $self->setstate('newpass_new');
},
'newpass_new' => sub {
  my ($self, $input) = @_;
  $input or do {$self->send("Cancelled."); $self->setstate('menu'); return};
  $self->{"new_password"} = $input;
  $self->setstate('newpass_new2');
},
'newpass_new2' => sub {
  my ($self, $input) = @_;
  $input or do {$self->send("Cancelled."); $self->setstate('menu'); return};
  if ($input eq $self->{"new_password"}) {
    $self->set_password($input);
    $self->send('Password set.');
    $self->setstate('menu', $self->{newplayer} ? 'login' : ());
  } else {
    $self->send("The two passwords did not match.");
    $self->setstate('newpass_new');
  }
},
'confirm_name' => sub {
  my ($self, $input) = @_;
  if ($input !~ /^y/i) {
    $self->setstate('login', 'badname');
    return;
  }
  $self->id_log("entering character creation.");
  $self->send("Creating new player.");
  $self->{newplayer} = 1;
  $self->setstate('select_proto');
},
'select_proto' => sub {
  my ($self, $input) = @_;
  $input ||= 'human';
  if (exists $self->{ok_proto}{$input}) {
    $self->{np_proto} = MIndex->get('proto')->find_reverse($self->{ok_proto}{$input});
    $self->setstate('select_gender');
    return;
  }
  $self->send("Invalid choice.");
},
'select_gender' => sub {
  my ($self, $input) = @_;
  if ($self->{ok_genders}->{lc $input}) {
    $self->{np_gender} = lc $input;
    $self->setstate('newpass_new');
    return;
  } 
  $self->send("Invalid choice.");
},
'delete_confirm' => sub {
  my ($self, $input) = @_;
  if ($input eq 'delete '.$self->{login_name}) {
    $self->id_log("deleting character.");
    $self->send("Deleting character.");
    my $pf = $self->pfilename;
    my $ob = $self->{object};
    $self->disconnect; undef $self;
    unlink($pf) or mudlog "ERROR/PLAYER: Couldn't unlink player data file: $!";
    $ob->dispose;
  } else {
    $self->setstate('menu');
  }
},
'menu' => sub {
  my ($self, $input) = @_;
  &{{
    0 => sub {$self->disconnect('normal')},
    1 => sub {$self->do_connect($self->{login_name})},
    p => sub {$self->setstate($self->has_password ? 'newpass_old' : 'newpass_new')},
    d => sub {$self->setstate('delete_confirm')},
  }->{lc $input} || sub {$self->send("That is not a valid choice.")}};
},
'command' => sub {
  my ($self, $input) = @_;
  my $obj = ($self->{'object'} or do {
    mudlog "ERROR: No object for connection #$self->{id}!";
    $self->send("Error: No object to send your command to!");
    return;
  });
  if ($input =~ /^!/) {
    $input = $self->{last_command} || '';
  }
  $obj->do($self->{last_command} = $input);
},
'paging' => sub {
  my ($self, $input) = @_;
  if ($input =~ /^\s*$/) {
    my $move_by = $self->_page_size - 1;
    if ($self->{page_pend} >= $#{$self->{page_lines}}) {
      $self->setstate('command');
    } else {
      $self->{page_pos} += $move_by;
      if ($self->{page_pos} > ($#{$self->{page_lines}} - $self->_page_size)) {
        $self->{page_pos}++;
        # if we're sending less than a full page, don't repeat the first line.
      }
      $self->_page_send;
    }
  } elsif ('back' =~ /^\E$input/i) {
    $self->{page_pos} = 0 if ($self->{page_pos} -= ($self->_page_size - 1)) < 0;
    $self->_page_send; 
  } elsif ('redisplay' =~ /^\E$input/i) {
    $self->_page_send;
  } elsif ('quit' =~ /^\E$input/i) {
    $self->setstate('command');
  } else {
    $InputHandlers{command}->($self, $input);
  }
},
);

%EnterHandlers = (
'select_proto' => sub {
  my ($self, $reason) = @_;
  my $pindex = MIndex->get('player_proto');
  $self->{ok_proto} = {map {my $o = $pindex->get($_); $o->name, $o}
                       $pindex->all};
  scalar keys %{$self->{ok_proto}} or $self->setstate('menu', 'login');
},
'select_gender' => sub {
  my ($self, $reason) = @_;
  $self->{ok_genders} = MIndex->get("proto.$self->{np_proto}")->allow_genders;
},
'menu' => sub {
  my ($self, $reason) = @_;
  
  return unless $reason and $reason eq 'login';
  $self->id_log("logged in.");
},
'login' => sub {
  my ($self, $reason) = @_;
  
  return if $reason and $reason eq 'badname';
  if ($::Config{splash}) {
    $self->send('');
    $self->send($::Config{splash});
    $self->send('');
  }
},
'paging' => sub {
  my ($self, $reason) = @_;
  $self->_page_send;
},
);

%PromptHandlers = (
  'wait' => sub {''},
  'login' => sub {"Please enter a character name or 'guest': "},
  'pass' => sub {'Password: '},
  'confirm_name' => sub {"There is no character named \"$_[0]->{login_name}\". Create a new character? [y/N]? "},
  'select_proto' => sub {"Would you like to be a: \n * " . join("\n * ", sort keys %{$_[0]->{ok_proto}}) . "\n?"},
  'select_gender'  => sub {'Select your gender ('  . join(', ', sort keys %{$_[0]->{ok_genders}}) . '): '},
  'newpass_old' => sub {'Enter your old password: '},
  'newpass_new' => sub {'Enter '.($_[0]->has_password?'new ':'a ')."password for $_[0]->{login_name}: "},
  'newpass_new2' => sub {'Confirm your '.($_[0]->has_password?'new ':'').'password: '},
  'delete_confirm' => sub {'Are you sure you want to delete '.$_[0]->{'object'}->nphr."?\nType \"delete ".$_[0]->{login_name}.'" to confirm: '},
  'menu' => sub {qq{
 0. Quit
 1. Enter the world
 P. Change password
 D. Delete this player

What do you want to do? }},
  'command' => sub {
    my $obj = $_[0]->{'object'};
    return '' unless $_[0]->{pdata}{prompts};
    return '> ' unless $obj;
    return join(' ', call_hooks('prompt_info', $obj)) . "> ";
  },
  'paging' => sub {
    my $siz = $_[0]->scr_width;
    "&:fy;["
    . ($siz > 27 ? $_[0]->{page_name}.($_[0]->{page_pos}+1).'-'.($_[0]->{page_pend}+1).'/' . (scalar @{$_[0]->{page_lines}}) . " - " : '') 
    . "RET "
    . ($_[0]->{page_pend} >= $#{$_[0]->{page_lines}} ? 'to exit' : 'for more') 
    . ($siz > 57 ? ', back, redisplay, quit' : '')
    . "]&:n; ";
  },
);


sub _is_noecho_state {
  $_[0] =~ /^(new)?pass/;
}

### Object methods - Player handling ##########################################################################################

sub do_connect {
  my ($self, $name) = @_;

  my $obj;
  
  if (not my $id = $self->{pdata}{'object'}) {
    $self->send("New player.");
    $obj = $self->make_new_player($name);
    
  } elsif (not $obj = MObjectDB->get($id)) {
    $self->send("Sorry, but your character is missing.");
    return;
  }

  $self->setstate('command');
  $self->link_to_object($obj);
  
  eval { $obj->nact("<self.is![ <self> has connected. ]>") };
  $obj->do('look');
  $self->id_log("connected to body.");
}

sub make_new_player {
  my ($self, $name) = @_;

  $self->id_log("New player: '$name'");
  my @priv;
  if (!-e rdir('data/players')) {
    rmkpath('data/players');
    mudlog "BOOTSTRAP: creating first player as full-privilege admin";
    @priv = map {("priv_$_", 1);} qw(watcher builder runner controller);
    # FIXME: priv fields defined in engine
  } 
  my $obj = MObject->new(
    name => $name,
    ($name eq 'guest' ? () : (article => '')),
    ($self->{np_proto} ? ('prototype' => $self->{np_proto}) : ()),
    ($self->{np_gender} ? ('gender' => $self->{np_gender}) : ()),
    @priv,
  );
  $obj->move_into(MIndex->get('room.start')); # DOCUMENT THIS
  $self->{pdata}{'object'} = $obj->id;
  $self->{pdata_ok} = 1;
  return $obj;
}

sub pfilename {
  my ($name) = @_;
  
  # the 'lc' is in there for those broken file systems that care about filename case.     :)
  (my $dname) = lc($name) =~ /(^\w+$)/ or die "bad name: $name";
  return rfile("data/players/$dname.plr");
}

sub authenticate {
  my ($self, $pass) = @_;

  my $realpass = $self->{pdata}{password} or return 1;
  return (my_crypt($pass, substr($realpass, 0, 2)) eq $realpass);
}

sub has_password {
  my ($self) = @_;

  return exists $self->{pdata}{password};
}

sub set_password {
  my ($self, $newpass) = @_;

  $self->{pdata}{password} = my_crypt($newpass, chr(rand 256) . chr(rand 256));
  $self->write_pdata();
}

sub my_crypt ($$) {
  my ($str, $salt) = @_;

  my $ret;
  eval {$ret = crypt $str, $salt};
  return $ret unless $@ =~ /paranoia/;
  return $str;
}

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

  my ($name, $cmds) = split /\s+/, $args, 2;
  my $atab = $self->{pdata}{aliases};
  if (defined $name) {
    if (defined $cmds) {
      $atab->{$name} = $cmds;
      $self->send("Set alias.");
    } else {
      delete $atab->{$name};
      $self->send("Deleted alias.");
    }
  } else {
    $self->send("Currently defined aliases:");
    foreach (keys %$atab) {
      $self->send(sprintf "%-16s -> %s", $_, $atab->{$_});
    }
  }
}

### Object methods - Pager ##########################################################################################

sub send_page {
  my ($self, $buf, %opt) = @_;
  my @lines = split /\n/, $self->format_wrap($buf);
  # $self->send("DEBUG: paging, ".(scalar @lines)." lines, psize is ".$self->_page_size);
  if (@lines >= $self->scr_height) {
    $self->{page_lines} = [@lines];
    $self->{page_pos} = $opt{start} || 0;
    $self->{page_name} = $opt{name} ? "$opt{name}, " : '';
    $self->setstate('paging');
  } else {
    $self->send(join "\n", @lines);
  }
}

sub _page_size {
  my ($self) = @_;

  return $self->scr_height - 1;
}

sub _page_send {
  my ($self) = @_;
  my $pp = $self->{page_pos};
  my $pe = $self->{page_pend} = $pp + $self->_page_size - 1;
  if ($pe > $#{$self->{page_lines}}) {
    $pe = $#{$self->{page_lines}};
    #$self->setstate('command');
  }
  $self->{page_pend} = $pe;
  $self->send(join "\n", @{$self->{page_lines}}[$pp..$pe]);
}


1;