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 =  $$self->{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         return $self;
  69 }
  70
  71 sub getattr
  72 {
  73         my $self = shift;
  74         $$self->{TERM}->getattr;
  75         return $$self->{TERM};
  76 }
  77
  78 sub setattr
  79 {
  80         my $self = shift;
  81         my $attr = shift || $$self->{TERM};
  82         $attr->setattr(fileno($self), &POSIX::TCSANOW);
  83 }
  84
  85 sub close
  86 {
  87         my $self = shift;
  88         $self->setattr(delete $$self->{ORIGTERM});
  89         $self->SUPER::close;
  90 }
  91
  92 sub DESTROY
  93 {
  94         my $self = shift;
  95         if (exists $$self->{ORIGTERM}) {
  96                 $self->close;
  97         }
  98 }
  99
 100 1;