=head1 NAME

RCU::DevLirc - RCU interface to the /dev/lirc device.

=head1 SYNOPSIS

   use RCU::DevLirc;

=head1 DESCRIPTION

See L<RCU>.

=over 4

=cut

package RCU::DevLirc;

use DynaLoader;
use Carp;
use POSIX ();
use Time::HiRes ();
use Errno ();
use Fcntl;

use RCU;

use base qw(RCU::Interface DynaLoader);

BEGIN {
   $VERSION = 0.01;
   bootstrap RCU::DevLirc $VERSION;
}

=item new

Create an interface to /dev/lirc.

=cut

sub new {
   my $class = shift;
   my $self = $class->SUPER::new();
   my $fh = local *LIRC_FH;

   $self->{fh} = $fh;

   open $fh, "+<", "/dev/lirc"
      or die "/dev/lirc: $!";

   $self
}

sub fd {
   fileno $_[0]->{fh};
}

sub _get {
   my $self = shift;
   my $fh = $self->{fh};
   local $/ = "\x00";
   $! = 0;
   my $code = <$fh>;
   if ("=" eq substr $code, 0, 1) {
      split /\x01/, substr $code, 1, -1;
   } elsif ($code =~ s/^E//) {
      die substr $code, 0, -1;
   } elsif ($code =~ /^I/) {
      # NOP
      ();
   } elsif ($! != Errno::EAGAIN) {
      delete $self->{fh}; # to make event stop
      croak "lirc communication error ($!)";
   } else {
      ();
   }
}

sub get {
   fcntl $_[0]->{fh}, F_SETFL, 0;
   goto &_get;
}

sub poll {
   fcntl $_[0]->{fh}, F_SETFL, O_NONBLOCK;
   goto &_get;
}

1;

=back

=head1 AUTHOR

This perl extension was written by Marc Lehmann <schmorp@schmorp.de>.