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;