view release on metacpan or  search on metacpan

lib/Linux/Input.pm  view on Meta::CPAN

package Linux::Input;

$VERSION = '1.03';

use base 'Class::Data::Inheritable';
use strict;
use warnings;

use Config;
use IO::File;
use IO::Select;

# class data
Linux::Input->mk_classdata('event_bytes');
Linux::Input->event_bytes(
  ($Config{longsize} * 2) +   # input_event.time (struct timeval)
  ($Config{i16size} * 2) +    # input_event.type, input_event.code
  ($Config{i32size})          # input_event.value
);
Linux::Input->mk_classdata('timeout');
Linux::Input->timeout(0.01);

# instaniate a new input device
sub new {
  my $class    = shift;
  my $filename = shift;
  my $self     = { };
  bless ($self => $class);

  $self->{fh} = IO::File->new("< $filename");
  die($!) unless ($self->{fh});

  return $self;
}

# get filehandle of device
sub fh {
  my $self = shift;
  return $self->{fh};
}

# $self's IO::Select object
sub selector {
  my $self = shift;
  unless ($self->{__io_select}) {
    $self->{__io_select} = IO::Select->new($self->fh());
  }
  return $self->{__io_select};
}

# poll for all pending events
sub poll {
  my $self     = shift;
  my $timeout  = shift || ref($self)->timeout();
  my $selector = $self->selector();
  my @ev;

  my $struct_len = Linux::Input->event_bytes();
  while (my ($fh) = $selector->can_read($timeout)) {
    my $buffer;
    my $len = sysread($fh, $buffer, $struct_len);
    my ($sec, $usec, $type, $code, $value) =
      unpack('L!L!S!S!i!', $buffer);
    my $event = {
      tv_sec  => $sec,
      tv_usec => $usec,
      type    => $type,
      code    => $code,
      value   => $value,
    };
    push @ev, $event if (defined($type));
  }
  return @ev;
}

1;

__END__

=head1 NAME

Linux::Input - Linux input event interface

=head1 SYNOPSIS

Example: 1 joystick using event API

  my $js1 = Linux::Input->new('/dev/input/event3');