ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/RCU/DevLirc/DevLirc.pm
Revision: 1.2
Committed: Sun Nov 6 18:27:31 2005 UTC (19 years, 1 month ago) by root
Branch: MAIN
CVS Tags: HEAD
Changes since 1.1: +9 -33 lines
Log Message:
*** empty log message ***

File Contents

# Content
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