File Coverage

blib/lib/Term/ReadLine/Event.pm

Criterion	Covered	Total	%
statement	17	108	15.7
branch	0	10	0.0
condition			n/a
subroutine	6	33	18.1
pod	7	7	100.0
total	30	158	18.9

package Term::ReadLine::Event;
$Term::ReadLine::Event::VERSION = '0.05';
use 5.006;
use strict;
use warnings;

use Term::ReadLine 1.09;
use Scalar::Util qw(blessed);

# ABSTRACT: Wrappers for Term::ReadLine's new event_loop model.


sub _new {
    my $class = shift;
    my $app   = shift;

    my $self = bless {@_}, $class;

    $self->{_term} = blessed $app ? $app :
       Term::ReadLine->new(ref $app ? @$app : $app);
    $self;
}


sub with_AnyEvent {
    my $self = _new(@_);

    $self->trl->event_loop(
                           sub {
                               my $data = shift;
                               $data->[0] = AE::cv();
                               $data->[0]->recv();
                           }, sub {
                               my $fh = shift;

                               # The data for AE are: the file event watcher (which
                               # cannot be garbage collected until we're done) and
                               # a placeholder for the condvar we're sharing between
                               # the AE::io callback created here and the wait
                               # callback above.
                               my $data = [];
                               $data->[1] = AE::io($fh, 0, sub { $data->[0]->send() });
                               $data;
                           }
                          );

    $self;
}


sub with_Coro {
    my $self = _new(@_);
    require Coro::Handle;

    $self->trl->event_loop(
                           sub {
                               # Tell Coro to wait until we have something to read,
                               # and then we can return.
                               shift->readable();
                           }, sub {
                               # in Coro, we just need to unblock the filehandle,
                               # and save the unblocked filehandle.
                               my $fh = shift;
                               Coro::Handle::unblock $fh;
                           }
                          );
    $self;
}


sub with_IO_Async {
    my $self = _new(@_);

    $self->trl->event_loop(
                           sub {
                               my $ready = shift;
                               $$ready = 0;
                               $self->{loop}->loop_once while !$$ready;
                           },
                           sub {
                               my $fh = shift;

                               # The data for IO::Async is just the ready flag.  To
                               # ensure we're referring to the same value, this is
                               # a SCALAR ref.
                               my $ready = \ do{my $dummy};

                               # Term::ReadLine::Gnu::XS relies on the fh being
                               # able to do fileno.
                               unless($fh->can('fileno')) {
                                   require IO::Handle;
                                   my $h = IO::Handle->new;
                                   $h->fdopen($fh, 'r') or die "could not fdopen - $!";
                                   $fh = $h
                               }

                               $self->{loop}->add(
                                                  $self->{watcher} =
                                                  IO::Async::Handle->new(
                                                                         read_handle => $fh,
                                                                         on_read_ready => sub { $$ready = 1 },
                                                                        )
                                                 );
                               $ready;
                           }
                          );

    $self->{_cleanup} = sub {
        my $s = shift;
        $s->{loop}->remove($s->{watcher});
    };

    $self;
}


sub with_POE
{
    my $self = _new(@_);

    my $waiting_for_input;

    POE::Session->create(
    inline_states => {

      # Initialize the session that will drive Term::ReadLine.
      # Tell Term::ReadLine to invoke a couple POE event handlers when
      # it's ready to wait for input, and when it needs to register an
      # I/O watcher.

      _start => sub {
        $self->trl->event_loop(
          $_[POE::Session->SESSION]->callback('term_readline_waitfunc'),
          $_[POE::Session->SESSION]->callback('term_readline_regfunc'),
        );
      },

      # This callback is invoked every time Term::ReadLine wants to
      # read something from its input file handle.  It blocks
      # Term::ReadLine until input is seen.
      #
      # It sets a flag indicating that input hasn't arrived yet.
      # It watches Term::ReadLine's input filehandle for input.
      # It runs while it's waiting for input.
      # It turns off the input watcher when it's no longer needed.
      #
      # POE::Kernel's run_while() dispatches other events (including
      # "term_readline_readable" below) until $waiting_for_input goes
      # to zero.

      term_readline_waitfunc => sub {
        my $input_handle = $_[POE::Session->ARG1][0];
        $waiting_for_input = 1;
        $_[POE::Session->KERNEL]->select_read($input_handle => 'term_readline_readable');
        $_[POE::Session->KERNEL]->run_while(\$waiting_for_input);
        $_[POE::Session->KERNEL]->select_read($input_handle => undef);
      },

      # This callback is invoked as Term::ReadLine is starting up for
      # the first time.  It saves the exposed input filehandle where
      # the "term_readline_waitfunc" callback can see it.

      term_readline_regfunc => sub {
        my $input_handle = $_[POE::Session->ARG1][0];
        return $input_handle;
      },

      # This callback is invoked when data is seen on Term::ReadLine's
      # input filehandle.  It clears the $waiting_for_input flag.
      # This causes run_while() to return in "term_readline_waitfunc".

      term_readline_readable => sub {
        $waiting_for_input = 0;
      },
    },
  );
    $self;
}


sub with_Reflex
{
    my $self = _new(@_);

    $self->trl->event_loop(
                           sub {
                               my $input_watcher = shift();
                               $input_watcher->next();
                           },
                           sub {
                               my $input_handle  = shift();
                               my $input_watcher = Reflex::Filehandle->new(
                                                                           handle => $input_handle,
                                                                           rd     => 1,
                                                                          );
                               return $input_watcher;
                           },
                          );


    $self;
}


sub with_Tk
{
    my $self = _new(@_);

    $self->trl->event_loop(
                           sub {
                               my $data = shift;
                               Tk::DoOneEvent(0) until $$data;
                               $$data = 0;
                           },
                           sub {
                               # save filehandle for unhooking later.
                               $self->{tkFH} = shift;
                               my $data;
                               $$data = 0;
                               Tk->fileevent($self->{tkFH}, 'readable', sub { $$data = 1 });
                               $data;
                           },
                          );

    $self->{_cleanup} = sub {
        my $s = shift;
        Tk->fileevent($s->{tkFH}, 'readable', "");
    };

    $self;
}


sub DESTROY
{
    my $self = shift;

    local $@;
    eval {
        $self->trl->event_loop(undef);

        $self->{_cleanup}->($self) if $self->{_cleanup};
    };
}


sub trl
{
    my $self = shift;
    $self->{_term};
}

our $AUTOLOAD;
sub AUTOLOAD
{
    (my $f = $AUTOLOAD) =~ s/.*:://;

    no strict 'refs';
    *{$f} = sub {
        shift->trl()->$f(@_);
    };

    goto &$f;
}


1; # End of Term::ReadLine::Event

__END__