File Coverage

blib/lib/Term/TermKey/Async.pm

Criterion	Covered	Total	%
statement	9	9	100.0
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	12	12	100.0

#  You may distribute under the terms of either the GNU General Public License
#  or the Artistic License (the same terms as Perl itself)
#
#  (C) Paul Evans, 2008-2013 -- [e-mail]

package Term::TermKey::Async;

use strict;
use warnings;
use base qw( IO::Async::Handle );

our $VERSION = '0.08';

use Carp;

use IO::Async::Timer::Countdown;
use Term::TermKey qw( RES_EOF RES_KEY RES_AGAIN );

=head1 NAME

C - terminal key input using C with
C

=head1 SYNOPSIS

 use Term::TermKey::Async qw( FORMAT_VIM KEYMOD_CTRL );
 use IO::Async::Loop;

 my $loop = IO::Async::Loop->new();

 my $tka = Term::TermKey::Async->new(
    term => \*STDIN,

    on_key => sub {
       my ( $self, $key ) = @_;

       print "Got key: ".$self->format_key( $key, FORMAT_VIM )."\n";

       $loop->loop_stop if $key->type_is_unicode and
                           $key->utf8 eq "C" and
                           $key->modifiers & KEYMOD_CTRL;
    },
 );

 $loop->add( $tka );

 $loop->loop_forever;

=head1 DESCRIPTION

This class implements an asynchronous perl wrapper around the C
library, which provides an abstract way to read keypress events in
terminal-based programs. It yields structures that describe keys, rather than
simply returning raw bytes as read from the TTY device.

This class is a subclass of C, allowing it to be put in an
C object and used alongside other objects in an C
program. It internally uses an instance of L to access the
underlying C library. For details on general operation, including the
representation of keypress events as objects, see the documentation on that
class.

Proxy methods exist for normal accessors of C, and the usual
behaviour of the C or other methods is instead replaced by the
C event.

=head1 EVENTS

The following events are invoked, either using subclass methods or CODE
references in parameters:

=head2 on_key $key

Invoked when a key press is received from the terminal. The C<$key> parameter
will contain an instance of C representing the keypress
event.

=cut

# Forward any requests for symbol imports on to Term::TermKey
sub import {
   shift; unshift @_, "Term::TermKey";
   my $import = $_[0]->can( "import" );
   goto &$import; # So as not to have to fiddle with Sub::UpLevel
}

=head1 CONSTRUCTOR

=cut

=head2 $tka = Term::TermKey::Async->new( %args )

This function returns a new instance of a C object. It
takes the following named arguments:

=over 8

=item term => IO or INT

Optional. File handle or POSIX file descriptor number for the file handle to
use as the connection to the terminal. If not supplied C will be used.

=back

=cut

sub new
{
   my $class = shift;
   my %args = @_;

   # TODO: Find a better algorithm to hunt my terminal
   my $term = delete $args{term} || \*STDIN;

   my $termkey = Term::TermKey->new( $term, delete $args{flags} || 0 );
   if( !defined $termkey ) {
      croak "Cannot construct a termkey instance\n";
   }

   my $self = $class->SUPER::new(
      read_handle => $term,
      %args,
   );

   $self->can_event( "on_key" ) or
      croak 'Expected either a on_key callback or an ->on_key method';

   $self->{termkey} = $termkey;

   $self->add_child( $self->{timer} = IO::Async::Timer::Countdown->new(
      notifier_name => "force_key",
      on_expire => $self->_capture_weakself( "_force_key" ),
   ) );

   return $self;
}

=head1 PARAMETERS

The following named parameters may be passed to C or C:

=over 8

=item flags => INT

C flags to pass to constructor or C.

=item on_key => CODE

CODE reference for the C event.

=back

=cut

sub configure
{
   my $self = shift;
   my %params = @_;

   if( exists $params{on_key} ) {
      $self->{on_key} = delete $params{on_key};
   }

   if( exists $params{flags} ) {
      $self->termkey->set_flags( delete $params{flags} );
   }

   $self->SUPER::configure( %params );
}

sub on_read_ready
{
   my $self = shift;

   my $timer = $self->{timer};
   $timer->stop;

   my $termkey = $self->{termkey};

   return unless $termkey->advisereadable == RES_AGAIN;

   my $key;

   my $ret;
   while( ( $ret = $termkey->getkey( $key ) ) == RES_KEY ) {
      $self->invoke_event( on_key => $key );
   }

   if( $ret == RES_AGAIN ) {
      $timer->configure( delay => $termkey->get_waittime / 1000 );
      $timer->start;
   }
   elsif( $ret == RES_EOF ) {
      $self->close;
   }
}

sub _force_key
{
   my $self = shift;

   my $termkey = $self->{termkey};

   my $key;
   if( $termkey->getkey_force( $key ) == RES_KEY ) {
      $self->invoke_event( on_key => $key );
   }
}

=head1 METHODS

=cut

=head2 $tk = $tka->termkey

Returns the C object being used to access the C
library. Normally should not be required; the proxy methods should be used
instead. See below.

=cut

sub termkey
{
   my $self = shift;
   return $self->{termkey};
}

=head2 $flags = $tka->get_flags

=head2 $tka->set_flags( $flags )

=head2 $canonflags = $tka->get_canonflags

=head2 $tka->set_canonflags( $canonflags )

=head2 $msec = $tka->get_waittime

=head2 $tka->set_waittime( $msec )

=head2 $str = $tka->get_keyname( $sym )

=head2 $sym = $tka->keyname2sym( $keyname )

=head2 ( $ev, $button, $line, $col ) = $tka->interpret_mouse( $key )

=head2 $str = $tka->format_key( $key, $format )

=head2 $key = $tka->parse_key( $str, $format )

=head2 $key = $tka->parse_key_at_pos( $str, $format )

=head2 $cmp = $tka->keycmp( $key1, $key2 )

These methods all proxy to the C object, and allow transparent
use of the C object as if it was a subclass.
Their arguments, behaviour and return value are therefore those provided by
that class. For more detail, see the L documentation.

=cut

# Proxy methods for normal Term::TermKey access
foreach my $method (qw(
   get_flags
   set_flags
   get_canonflags
   set_canonflags
   get_waittime
   set_waittime
   get_keyname
   keyname2sym
   interpret_mouse
   format_key
   parse_key
   parse_key_at_pos
   keycmp
)) {
   no strict 'refs';
   *{$method} = sub {
      my $self = shift;
      $self->termkey->$method( @_ );
   };
}

=head1 AUTHOR

Paul Evans

=cut

0x55AA;