=head1 NAME

AnyEvent::ReadLine - simple but versatile readline implementation

=head1 SYNOPSIS

 use AnyEvent::ReadLine;

=head1 DESCRIPTION

This module implements some kind of readline interface - something that
allows you to read a (command-) line entered by the user, and allows the
user to comfortably (hopefully) edit it.

Basically, this module implements something like perl's C<readline>
function, except potentially with user editing.

There are a multitude of readline modules and -implementations available
for Perl. The difference of this module to others is that it takes pipes,
network sockets and other generic file handles into account, in addition
to traditional tty interfaces.

=over 4

=cut

package AnyEvent::ReadLine;

use common::sense;
use Scalar::Util ();
use Errno ();
use Term::Terminfo ();
use AnyEvent;

our $VERSION = '0.0';

=item $rl = new AnyEvent::ReadLine key => value...

Creates a new AnyEvent::ReadLine object.

The key value pairs that are understood are the following:

=over 4

=item fh => $fh

The file handle used to read user input from.

=item ofh => $fh

The file handle used to write feedback to - defaults to C<fh>.

=item mode => "none"|"termios"|"telnet"

Governs how the terminal is driven. Defaults to C<termios> when
C<fh> is connected to a tty, C<none> otherwise.

=item term => $terminfo

The terminfo name of the attached terminal - in termios mode, defaults
to C<$ENV{TERM}>, otherwise the default is C<ansi> which works in most
situations.

=item prompt => $prompt

The prompt string to use (default: C<< > >>). C<$prompt> can also be
a code reference that returns the prompt, and will be called on every
redisplay.

=item timeout => $seconds

After how many seconds a key sequence is considered complete. To
differentiate between, say, the escape key and typical arrow key sequences
a timeout needs to be used. The default is 0.02 in termios mode, and 0.1
in all others.

=item encoding => $encoding

The encoding of the terminal. Only "utf-8" and "iso-8859-1" are supported
at the moment, because Perl apparently has no incremental decoding
facilities (Encode can't do it, perlio can't do it).

The default is utf-8, until I can find out how to detect if a filehandle
is in utf-8 mode without resorting to undocumented functionality.

=item width => $width

=item height => $height

The width and height of the screen - these will be updated to the true
widht and height if possible.

=item on_read => $cb->($rl, $string)

Called each time the user is finished entering a line. The string is in
unicode format.

=item on_eof => $cb->($rl)

Called when an EOF is detected on the input file handle. Must eventually
destroy the object.

=item on_error => $cb->($rl, "$!")

Called on any unhandled error that occured. Second argument is a string
describing the saituation, C<$!> contains the actual error.

=item on_change => $cb->($rl, $string, $pos)

When specified, C<ofh> is ignored - each time the presentation changes,
this callback is called with the string to display (including any prompt)
and the position of the cursor inside the string.

The string is in unicode (and thus C<$pos> is a character position) - to
output it, you normally must encode it first.

=item on_key_XXX => $cb->($rl, $key)

Each time a key XXX in the keymap is entered, this callback will be
invoked if it exists. It may want to invoke the original C<key_XXX>
method.

=back

=cut

sub new {
   my $class = shift;

   my $self = bless {
      prompt => "> ",
      @_,
      raw    => 0,
   }, $class;

   $self->{ofh}  ||= $self->{fh};
   $self->{mode} ||= -t $self->{fh} ? "termios" : "none";

   $self->{timeout} ||= $self->{mode} eq "termios" ? 0.02 : 0.1;
   $self->{encoding} ||= "utf-8";

   $self->set_term ((delete $self->{term}) || ($self->{mode} eq "termios" && $ENV{TERM}) || "ansi");

   {
      Scalar::Util::weaken (my $self = $self);

      $self->{tcb} = sub {
         delete $self->{tw};
         $self->feed;
      };

      $self->{rcb} = sub {
         my $len = sysread $self->{fh}, $self->{rbuf}, 1, length $self->{rbuf};
         if ($len) {
            $self->{tw} = AE::timer $self->{timeout}, 0, $self->{tcb};
         } elsif (defined $len) {
            $self->{on_eof}
               ? $self->{on_eof}($self)
               : $self->{on_error}($self, 0, "unexpected end of file");
         } elsif ($! != Errno::EAGAIN && $! != Errno::EINTR) {
            $self->{on_error}($self, $!, "$!");
         }
      };

      $self->{wcb} = sub {
         my $len = syswrite $self->{ofh}, $self->{wbuf};
         substr $self->{wbuf}, 0, $len, "";
         delete $self->{ww} unless length $self->{wbuf};
         # todo error handling
      };
   }

   $self->enable;

   $self
}

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

   $self->disable;
}

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

   my %keymap;

   for (0..31) {
      $keymap{chr $_      } = "ctrl$_";
      $keymap{chr $_ + 128} = "hctrl$_";
   }

   $keymap{"\x03"} = "intr";
   $keymap{"\x04"} = "eof";
   $keymap{"\x08"} = "backspace"; # common
   $keymap{"\x0a"} = "enter";
   $keymap{"\x0c"} = "redraw";
   $keymap{"\x0d"} = "enter";
   $keymap{"\x15"} = "kill";
   $keymap{"\x17"} = "werase";
   $keymap{"\x1a"} = "susp";
   $keymap{"\x1b"} = "esc";
   $keymap{"\x1c"} = "quit";
   $keymap{"\x7f"} = "backspace"; # correct

   if (my $ti =  $self->{ti}) {
#      for my $func (qw(up down left right enter backspace dc)) {
#         $keymap{$ti->str_by_varname ("key_$func")} = $func;
#      }
      # we bind all keys that have known sequences, to avoid
      # inserting their raw codes when we don't understand them
      for my $key (grep s/^key_//, $ti->str_varnames) {
         my $str = $ti->str_by_varname ("key_$key");
         $key =~ y/a-z0-9_//cd; # increase security - these are used for method calls
         $keymap{$str} = $key;
      }
   }

   if ($self->{mode} eq "termios") {
      require POSIX;

      my $tio = POSIX::Termios->new;
      if ($tio->getattr (fileno $self->{fh})) {
         $keymap{chr $tio->getcc (&POSIX::VINTR )} = "intr";
         $keymap{chr $tio->getcc (&POSIX::VSUSP )} = "susp";
         $keymap{chr $tio->getcc (&POSIX::VEOF  )} = "eof";
         $keymap{chr $tio->getcc (&POSIX::VEOL  )} = "enter";
         $keymap{chr $tio->getcc (&POSIX::VKILL )} = "kill";
         $keymap{chr $tio->getcc (&POSIX::VERASE)} = "backspace";
         $keymap{chr $tio->getcc (&POSIX::VQUIT )} = "quit";
      }
   }

   # delete some garbage the above might create
   delete $keymap{""};
   delete $keymap{"\0"};

   # keymap MUST be nonempty (which must be the case by now)

   $self->{keymap} = \%keymap;
   delete $self->{ckm};
}

sub set_term {
   my ($self, $term) = @_;

   return if $self->{term} eq $term;

   $self->{term} = $term;
   $self->{ti} = new Term::Terminfo $term;

   $self->default_keymap;
}

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

   return if $self->{raw};

   if ($self->{mode} eq "termios") {
      require POSIX;

      $self->{tio} = POSIX::Termios->new;
      $self->{tio}->getattr (fileno $self->{fh})
         or return;

      my $tio = POSIX::Termios->new;
      $tio->getattr (fileno $self->{fh})
         or return;

      $tio->setiflag ($tio->getiflag
         & ~&POSIX::BRKINT
         & ~&POSIX::IGNBRK
         & ~&POSIX::ISTRIP
      );
      $tio->setlflag ($tio->getlflag
         & ~&POSIX::ECHO
         & ~&POSIX::ECHONL
         & ~&POSIX::ICANON
#         & ~&POSIX::ISIG #d#
      );

      $tio->setattr (fileno $self->{fh});
   }

   $self->line_draw unless $self->{on_change};

   $self->{rw} = AE::io $self->{fh}, 0, $self->{rcb};

   $self->{raw} = 1;
}

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

   return unless $self->{raw};

   $self->line_erase unless $self->{on_change};

   delete $self->{rw};

   if ($self->{mode} eq "termios") {
      (delete $self->{tio})->setattr (fileno $self->{fh});
   }

   $self->{raw} = 0;
}

sub strwidth {
   scalar (my @dummy = $_[0] =~ /\p{Print}/g)
   - scalar (my @dummy = $_[0] =~ /\p{Mark}/g)
   + scalar (my @dummy = $_[0] =~ /\p{East_Asian_Width=Wide}/g)
}

sub write {
   my ($self, $data) = @_;

   $self->{wbuf} .= $data;

   $self->{ww} ||= AE::io $self->{ofh}, 1, $self->{wcb};
}

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

   $self->write (
      ("\x08" x $self->{bpos})
    . (" "    x $self->{blen})
    . ("\x08" x $self->{blen})
   );

   $self->{bpos} = 0;
   $self->{blen} = 0;
}

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

   my $prompt = $self->{prompt};
   $prompt = $prompt->($self) if ref $prompt;

   my $l = $prompt . substr $self->{lbuf}, 0, $self->{pos};
   my $r =           substr $self->{lbuf}, $self->{pos};

   for ($l, $r) {
      s/(\P{Print})/sprintf "\\x{%x}", ord $1/ge;
   }

   my $wl = strwidth $l;
   my $wr = strwidth $r;

   $self->{blen} = $wl + $wr + 6; # erase a bit more, to feel better
   $self->{bpos} = $wl;

   my $buf = $prompt . $self->{lbuf};

   utf8::encode $buf if $self->{encoding} eq "utf-8";

   $self->write ($buf . ("\x08" x $wr));
}

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

   if ($self->{on_change}) {
      $self->{on_change}($self, $self->{lbuf}, $self->{pos});
   } else {
      $self->line_erase;
      $self->line_draw;
   }
}

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

   return if $self->{on_change};

   $self->disable;
   $self->write ("$msg\x0d\x0a");
   $self->enable;
}

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

   # TODO: telnet

   # decode the input bytes into unicode

   if ($self->{encoding} eq "utf-8") {
      while ($self->{rbuf} =~ s/^([\x00-\x7f]|[\x80-\xff]+)//) {
         my $c = $1;
         utf8::decode $c; # if fails, we use $c as-is
         $self->{input} .= $c;
      }
   } else {
      $self->{input} .= delete $self->{rbuf};
   }

   # compile keymap, if not done yet

   $self->{ckm} ||= do {
      # compile keymap
      my $re = join "|", map quotemeta, reverse sort keys %{ $self->{keymap} };
      qr<^($re)>
   };

   # now try to match input sequences

   for ($self->{input}) {
      while () {
         if (s/$self->{ckm}//) {
            if (my $key = $self->{keymap}{$1}) {
               ($self->{"on_$key"}
                || (UNIVERSAL::can $self, "key_$key")
                || sub { $self->msg ("$_[1]: unsupported key") }
               )->($self, $key);
            }
         } elsif (s/^(.)//) {
            substr $self->{lbuf}, $self->{pos}, 0, $1;
            $self->{pos} += length $1; # always 1

            $self->refresh;
         } else {
            last;
         }
      }
   }
}

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

my $rl = new AnyEvent::ReadLine
   fh  => \*STDIN,
   ofh => \*STDOUT,
   term => "ansi",
   prompt => sub { AE::time . "> " },
   on_eof => sub { die "eof" },
   on_error => sub { die "<@_>" },
;

my $t = AE::timer 5, 0, sub { $rl->disable; exit };
$rl->enable;

AE::cv->recv;

1;

=back

=head1 AUTHOR AND CONTACT

 Marc Lehmann <schmorp@schmorp.de>
 http://software.schmorp.de/pkg/AnyEvent-Readline.html

=cut