DWeather/lib/DWeather/Serial.pm

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