File Coverage

blib/lib/AnyEvent/TermKey.pm

Criterion	Covered	Total	%
statement	13	15	86.6
branch			n/a
condition			n/a
subroutine	5	5	100.0
pod			n/a
total	18	20	90.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, 2011 -- [e-mail]

package AnyEvent::TermKey;

use strict;
use warnings;

our $VERSION = '0.02';

use Carp;

use AnyEvent;
use Term::TermKey qw( RES_KEY RES_AGAIN );

=head1 NAME

C - terminal key input using C with C

=head1 SYNOPSIS

 use AnyEvent::TermKey qw( FORMAT_VIM KEYMOD_CTRL );
 use AnyEvent;

 my $cv = AnyEvent->condvar;

 my $aetk = AnyEvent::TermKey->new(
    term => \*STDIN,

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

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

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

 $cv->recv;

=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.

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.

=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 $aetk = AnyEvent::TermKey->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.

=item on_key => CODE

CODE reference to the key-event handling callback. Will be passed an instance
of a C structure:

 $on_key->( $key )

=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 $on_key = $args{on_key};

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

   my $timeout;
   my $iowatch = AnyEvent->io(
      fh => $term,
      poll => "r",
      cb => sub {
         undef $timeout;

         return unless $termkey->advisereadable == RES_AGAIN;

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

         if( $ret == RES_AGAIN ) {
            $timeout = AnyEvent->timer(
               after => $termkey->get_waittime / 1000,
               cb => sub {
                  if( $termkey->getkey_force( my $key ) == RES_KEY ) {
                     $on_key->( $key );
                  }
               },
            );
         }
      },
   );

   return bless {
      termkey => $termkey,
      iowatch => $iowatch,
      on_key  => $args{on_key},
   }, $class;
}

=head1 METHODS

=cut

=head2 $tk = $aetk->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 = $aetk->get_flags

=head2 $aetk->set_flags( $flags )

=head2 $canonflags = $aetk->get_canonflags

=head2 $aetk->set_canonflags( $canonflags )

=head2 $msec = $aetk->get_waittime

=head2 $aetk->set_waittime( $msec )

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

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

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

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

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

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

=head2 $cmp = $aetk->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;