]> dxcluster.org Git - dweather.git/blob - Serial.pm
start a real(ish) dweather webapp
[dweather.git] / Serial.pm
1 #
2 # Module to do serial handling on perl FileHandles
3 #
4
5 package Serial;
6
7 use POSIX qw(:termios_h);
8 use Fcntl;
9 use Scalar::Util qw(weaken);
10
11
12 @ISA = qw(IO::File);
13 $VERSION = 1.3;
14
15 use strict;
16
17 # Linux-specific Baud-Rates
18 use constant B57600 => 0010001;
19 use constant B115200 => 0010002;
20 use constant B230400 => 0010003;
21 use constant B460800 => 0010004;
22 use constant CRTSCTS => 020000000000;
23
24 sub new
25 {
26         my $pkg = shift;
27         my $class = ref $pkg || $pkg;
28         my $device = shift || "/dev/ttyS0";
29
30         my $self = $pkg->SUPER::new($device, O_RDWR|O_NOCTTY|O_EXCL|O_NDELAY) || return;
31
32         # get my attributes
33         $$self->{ORIGTERM} = POSIX::Termios->new();
34         my $term = POSIX::Termios->new();
35         $$self->{ORIGTERM}->getattr(fileno($self));
36         $term->getattr(fileno($self));
37         my ($speed) = grep {/^\d+$/} @_; 
38         my $baud;
39         {
40                 no strict 'refs';
41                 $baud = &{'POSIX::B' . $speed};
42         }
43         $term->setispeed($baud);
44         $term->setospeed($baud);
45
46         my $cflag = $term->getcflag(); my $lflag = $term->getlflag();
47         my $oflag = $term->getoflag(); my $iflag = $term->getiflag();
48
49         # set raw
50         ########################################################################
51         $iflag &= ~(IGNBRK|BRKINT|PARMRK|ISTRIP|INLCR|IGNCR|ICRNL|IXON);
52         $oflag &= ~OPOST;
53         $lflag &= ~(ECHO|ECHONL|ICANON|ISIG);
54         $cflag &= ~(CSIZE|PARENB|HUPCL);
55         #########################################################################
56         #
57
58         $cflag |= CLOCAL|CREAD;
59         $cflag |= (grep {/^cs7$/i} @_) ? CS7 : CS8;
60         if (my ($parity) = grep {/^(odd|even)$/i} $@) {
61                 $cflag |= PARENB;
62                 $cflag |= PARODD if $parity =~ /odd/i; 
63         }
64         $cflag |= CRTSCTS if grep /rtscts$/, $@;
65         $term->setcflag($cflag); $term->setlflag($lflag);
66         $term->setoflag($oflag); $term->setiflag($iflag);
67         $term->setattr(fileno($self), TCSANOW);
68         $$self->{TERM} = $term;
69         
70         return $self;
71 }
72
73 sub getattr
74 {
75         my $self = shift;
76         $$self->{TERM}->getattr;
77         return $$self->{TERM};
78 }
79
80 sub setattr
81 {
82         my $self = shift;
83         my $attr = shift || $$self->{TERM};
84         $attr->setattr(fileno($self), &POSIX::TCSANOW) if fileno($self);
85 }
86
87 sub close
88 {
89         my $self = shift;
90         $self->setattr(delete $$self->{ORIGTERM}) if fileno($self) && $$self->{ORIGTERM};
91         $self->SUPER::close;
92 }
93
94 sub DESTROY
95 {
96         my $self = shift;
97         if (exists $$self->{ORIGTERM}) {
98                 $self->close;
99         }
100 }
101
102 1;