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(__PACKAGE__, $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 put { my $self = shift; print $stdout map { $_ =~ /\r?\n/? $_ : $_ . "\r\n" } @_; return; }; 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] || undef, $_[SELF_INPUT] ? undef : 'eot', $self->{POE}->[SELF_UNIQUE_ID] ); } sub _idle_state { } sub _read_state { $_[OBJECT]->rl_callback_read_char } sub DESTROY { my $self = shift; # Stop selecting on the handle. $poe_kernel->select($stdin); # Detach our tentacles from the parent session. if ($self->{POE}->[SELF_STATE_READ]) { $poe_kernel->state($self->{POE}->[SELF_STATE_READ]); $self->{POE}->[SELF_STATE_READ] = undef; } if ($self->{POE}->[SELF_STATE_IDLE]) { $poe_kernel->alarm($self->{POE}->[SELF_STATE_IDLE]); $poe_kernel->state($self->{POE}->[SELF_STATE_IDLE]); $self->{POE}->[SELF_STATE_IDLE] = undef; } # restore terminal state $self->rl_deprep_terminal(); POE::Wheel::free_wheel_id($self->{POE}->[SELF_UNIQUE_ID]); } 1;