1 |
=head1 NAME |
2 |
|
3 |
RCU::DevLirc - RCU interface to the /dev/lirc device. |
4 |
|
5 |
=head1 SYNOPSIS |
6 |
|
7 |
use RCU::DevLirc; |
8 |
|
9 |
=head1 DESCRIPTION |
10 |
|
11 |
See L<RCU>. |
12 |
|
13 |
=over 4 |
14 |
|
15 |
=cut |
16 |
|
17 |
package RCU::DevLirc; |
18 |
|
19 |
use DynaLoader; |
20 |
use Carp; |
21 |
use POSIX (); |
22 |
use Time::HiRes (); |
23 |
use Errno (); |
24 |
use Fcntl; |
25 |
|
26 |
use RCU; |
27 |
|
28 |
use base qw(RCU::Interface DynaLoader); |
29 |
|
30 |
BEGIN { |
31 |
$VERSION = 0.01; |
32 |
bootstrap RCU::DevLirc $VERSION; |
33 |
} |
34 |
|
35 |
=item new |
36 |
|
37 |
Create an interface to /dev/lirc. |
38 |
|
39 |
=cut |
40 |
|
41 |
sub new { |
42 |
my $class = shift; |
43 |
my $self = $class->SUPER::new(); |
44 |
my $fh = local *LIRC_FH; |
45 |
|
46 |
$self->{fh} = $fh; |
47 |
|
48 |
open $fh, "+<", "/dev/lirc" |
49 |
or die "/dev/lirc: $!"; |
50 |
|
51 |
$self |
52 |
} |
53 |
|
54 |
sub fd { |
55 |
fileno $_[0]->{fh}; |
56 |
} |
57 |
|
58 |
sub _get { |
59 |
my $self = shift; |
60 |
my $fh = $self->{fh}; |
61 |
local $/ = "\x00"; |
62 |
$! = 0; |
63 |
my $code = <$fh>; |
64 |
if ("=" eq substr $code, 0, 1) { |
65 |
split /\x01/, substr $code, 1, -1; |
66 |
} elsif ($code =~ s/^E//) { |
67 |
die substr $code, 0, -1; |
68 |
} elsif ($code =~ /^I/) { |
69 |
# NOP |
70 |
(); |
71 |
} elsif ($! != Errno::EAGAIN) { |
72 |
delete $self->{fh}; # to make event stop |
73 |
croak "lirc communication error ($!)"; |
74 |
} else { |
75 |
(); |
76 |
} |
77 |
} |
78 |
|
79 |
sub get { |
80 |
fcntl $_[0]->{fh}, F_SETFL, 0; |
81 |
goto &_get; |
82 |
} |
83 |
|
84 |
sub poll { |
85 |
fcntl $_[0]->{fh}, F_SETFL, O_NONBLOCK; |
86 |
goto &_get; |
87 |
} |
88 |
|
89 |
1; |
90 |
|
91 |
=back |
92 |
|
93 |
=head1 AUTHOR |
94 |
|
95 |
This perl extension was written by Marc Lehmann <schmorp@schmorp.de>. |
96 |
|
97 |
|
98 |
|
99 |
|
100 |
|