RFC: POE::Wheel::ReadLine::Gnu

[Georg Moritz]

Hello Listeners and Listers,

I've just finished the first working version of $Subjec - a rewrite
of POE::Wheel::ReadLine which uses the GNU readline library:

http://perlmonks.org/?node_id=667205

I'll check for compatibility with POE::Wheel::ReadLine, and run its tests
against the new module.

cheers,
0--gg-

-- 
_($_=" "x(1<<5)."?\n".q·/)Oo.  G°\        /
                              /\_¯/(q    /
----------------------------  \__(m.====·.(_("always off the crowd"))."·
");sub _{s,/,($e="'Itrs `mnsgdq Gdbj O`qkdq")=~y/"-y/#-z/;$e,e && print}
package POE::Wheel::ReadLine::Gnu;
use Carp   qw( croak carp );
use Symbol qw( gensym );
use POE    qw( Wheel );

use Term::ReadLine;
our @ISA = qw(Term::ReadLine);

# Private STDIN and STDOUT.
my $stdin  = gensym();
open($stdin, "<&STDIN") or die "Can't open private STDIN: $!";

my $stdout = gensym;
open($stdout, ">&STDOUT") or die "Can't open private STDOUT: $!";

# Offsets into $self->{POE}.
# OBJECT ($self) is 0
sub SELF_INPUT          () { 1 }
sub SELF_EVENT_INPUT    () { 2 }
sub SELF_READING_LINE   () { 3 }
sub SELF_STATE_READ     () { 4 }
sub SELF_STATE_IDLE     () { 5 }
sub SELF_UNIQUE_ID      () { 6 }
sub SELF_APP            () { 7 }

#------------------------------------------------------------------------------

sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my %params = @_;
    croak "$class requires a working Kernel" unless defined $poe_kernel;

    my $input_event = delete $params{InputEvent};
    croak "$class requires an InputEvent parameter" unless defined $input_event;

    my $put_mode = delete $params{PutMode};
    $put_mode = 'idle' unless defined $put_mode;
    croak "$class PutMode must be either 'immediate', 'idle', or 'after'"
        unless $put_mode =~ /^(immediate|idle|after)$/;

    my $idle_time = delete $params{IdleTime};
    $idle_time = 2 unless defined $idle_time;

    my $app = delete $params{appname};
    $app ||= 'poe-readline';

    if (scalar keys %params) {
        carp(
            "unknown parameters in $class constructor call: ",
            join(', ', keys %params)
        );
    }
    my $self = $proto->SUPER::new();# $stdin, $stdout);

    $self->{POE} = [
        undef,                                  # OBJECT
        undef,                                  # SELF_INPUT
        $input_event,                           # SELF_EVENT_INPUT
        0,                                      # SELF_READING_LINE
        undef,                                  # SELF_STATE_READ
        undef,                                  # SELF_STATE_IDLE
        &POE::Wheel::allocate_wheel_id(),       # SELF_UNIQUE_ID
        $app,                                   # SELF_APP

    ];
    bless $self, $class; 
    # set unbuffered IO
    select((select($stdout), $| = 1)[0]);
    # Set up the event handlers.  Idle goes first.
    $self->{POE}->[SELF_STATE_IDLE] = (
        ref($self) . "(" . $self->{POE}->[SELF_UNIQUE_ID] . ") -> input timeout"
    );
    $poe_kernel->state($self->{POE}->[SELF_STATE_IDLE], $self, '_idle_state');
    $self->{POE}->[SELF_STATE_READ] = (
        ref($self) . "(" . $self->{POE}->[SELF_UNIQUE_ID] . ") -> select read"
    );
    $poe_kernel->state($self->{POE}->[SELF_STATE_READ], $self, '_read_state');
    rl_callback_handler_install($self,$prompt,sub { $self->got_line(@_) } );

    return $self;
}

sub get {
    my ($self,$prompt,$preput) = @_;
    return if $self->{POE}->[SELF_READING_LINE];
    $self->{POE}->[SELF_READING_LINE] = 1;
    my $Attribs = $self->Attribs;
    # ornament support (now prompt only)
    $prompt = ${$Attribs{term_set}}[0] . $prompt . ${$Attribs{term_set}}[1];
    $Attribs{completion_entry_function} = $Attribs{_trp_completion_function}
        if (!defined $Attribs{completion_entry_function}
            && defined $Attribs{completion_function});
    $self->rl_set_prompt($prompt);
    $self->rl_insert_text($preput) if defined $preput;
    $self->rl_redisplay();
    $poe_kernel->select_read($stdin, $self->{POE}->[SELF_STATE_READ]);
}

sub got_line {
    my $self = $_[OBJECT];
    $self->{POE}->[SELF_READING_LINE] = 0;
    $poe_kernel->select_read($stdin);
    $self->rl_set_prompt('');
    $poe_kernel->yield( $self->{POE}->[SELF_EVENT_INPUT],$_[SELF_INPUT]);
}
sub _idle_state { }
sub _read_state { $_[OBJECT]->rl_callback_read_char }

sub DESTROY {
    my $self = shift;
    $self->rl_deprep_terminal();
}
1;