File Coverage

blib/lib/POE/Wheel/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 POE::Wheel::TermKey;

use strict;
use warnings;
use base qw( POE::Wheel );

our $VERSION = '0.02';

use Carp;

use POE;
use Term::TermKey;

=head1 NAME

C - terminal key input using C with C

=head1 SYNOPSIS

 use Term::TermKey qw( FORMAT_VIM KEYMOD_CTRL );
 use POE qw(Wheel::TermKey);

 POE::Session->create(
    inline_states => {
       _start => sub {
          $_[HEAP]{termkey} = POE::Wheel::TermKey->new(
             InputEvent => 'got_key',
          );
       },
       got_key => sub {
          my $key     = $_[ARG0];
          my $termkey = $_[HEAP]{termkey};

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

          # Gotta exit somehow.
          delete $_[HEAP]{termkey} if $key->type_is_unicode and
                                      $key->utf8 eq "C" and
                                      $key->modifiers & KEYMOD_CTRL;
       },
    }
 );

 POE::Kernel->run;

=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 L, which internally uses an instance
of L to access the underlying C library. For details of on
general operation, including the representation of keypress events as objects,
see the documentation on C instead.

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

=cut

=head1 CONSTRUCTOR

=cut

=head2 $wheel = POE::Wheel::TermKey->new( %args )

Returns a new instance of a C object. It takes the
following named parameters:

=over 8

=item Term => IO or INT

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

=item Flags => INT

C flags to pass to the C constructor.

=item InputEvent => STRING

Name of the session event to emit when a key is received. The event will be
given a single argument, the C event object, as
C<$_[ARG0]>.

=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 = bless {
      inputevent => $args{InputEvent},
      id         => POE::Wheel::allocate_wheel_id,
      term       => $term,
      termkey    => $termkey,
   }, $class;

   $self->{states}{read}    = ref($self) . "($self->{id}) -> select read";
   $self->{states}{timeout} = ref($self) . "($self->{id}) -> timeout";
   my $state_timeout = $self->{states}{timeout};

   my $inputeventr = \$self->{inputevent};
   $poe_kernel->state( $self->{states}{read} => sub {
      my ( $kernel, $session ) = @_[KERNEL, SESSION];

      return unless $termkey->advisereadable == RES_AGAIN;

      $kernel->alarm( $state_timeout => undef );

      my $key;

      my $ret;
      while( ( $ret = $termkey->getkey( $key ) ) == RES_KEY ) {
         $kernel->call( $session, $$inputeventr, $key );
      }

      if( $ret == RES_AGAIN ) {
         $kernel->delay( $state_timeout => $termkey->get_waittime / 1000 );
      }
   } );
   $poe_kernel->state( $self->{states}{timeout} => sub {
      my ( $kernel, $session ) = @_[KERNEL, SESSION];

      if( $termkey->getkey_force( my $key ) == RES_KEY ) {
         $kernel->call( $session, $$inputeventr, $key );
      }
   } );

   $poe_kernel->select_read( $self->{term}, $self->{states}{read} );

   return $self;
}

sub DESTROY
{
   my $self = shift;

   $poe_kernel->select( $self->{term}, undef );

   $poe_kernel->state( $_ => undef ) for values %{ $self->{states} };

   POE::Wheel::free_wheel_id( $self->{id} );
}

=head1 METHODS

=cut

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

=head2 $wheel->set_flags( $flags )

=head2 $canonflags = $wheel->get_canonflags

=head2 $wheel->set_canonflags( $canonflags )

=head2 $msec = $wheel->get_waittime

=head2 $wheel->set_waittime( $msec )

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

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

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

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

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

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

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