=head1 NAME RCU::Lirc - RCU interface to linux-infrared-remote-control =head1 SYNOPSIS use RCU::Lirc; =head1 DESCRIPTION See L. =over 4 =cut package RCU::Lirc; 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::Lirc $VERSION; } =item new progname Create an interface to lircd using the configuration for program "progname". =cut sub new { my $class = shift; my $prog = shift || "perl"; my $self = $class->SUPER::new(); my $fh = local *LIRC_FH; $self->{fh} = $fh; $self->{pid} = open $fh, "-|"; if ($self->{pid} == 0) { select STDOUT; $|=1; eval { $SIG{HUP} = sub { _exit }; lirc_init($prog) >= 0 or croak "unable to connect to lircd: $!"; lirc_readconfig();# == 0 or croak "unable to read lirc configuration for <$prog>: $!\n"; print "I\x00"; for(;;) { my ($raw, $cooked) = _get_code; print "=".Time::HiRes::time."\x01$raw\x01$cooked\x00"; } }; if ($@) { $@ =~ s/\x00/\x01/g; print "E$@\x00"; } #lirc_freeconfig; #lirc_deinit; POSIX::_exit(0); } elsif (!defined $self->{pid}) { die; } $self->get; # wait for I packet $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 .