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 use AnyEvent;
  13 use base qw(AnyEvent::Handle);
  14
  15
  16 # Linux-specific Baud-Rates (for reference really)
  17 use constant B57600 => 0010001;
  18 use constant B115200 => 0010002;
  19 use constant B230400 => 0010003;
  20 use constant B460800 => 0010004;
  21 use constant CRTSCTS => 020000000000;
  22
  23 #
  24 # my $h = DWeather::Serial->new("/dev/ttyXXX", 19200 [,cs7] [,odd] [,rtscts]);
  25 #
  26 # all parameters are optional
  27 #
  28 # you are expected to add AE callbacks as required, all this module
  29 # does is create the AE::Handle and associates an IO::File handle with it
  30 #
  31 # default is /dev/ttyS0, 9600 8N1 no handshaking
  32 #
  33 # the tty is set to raw mode.
  34 #
  35 # returns a subclassed AE::Handle
  36 #
  37 sub new
  38 {
  39         my $pkg = shift;
  40         my $class = ref $pkg || $pkg;
  41         my $device = shift || "/dev/ttyS0";
  42
  43         my $fh = IO::File->new($device, O_RDWR|O_NOCTTY|O_EXCL|O_NDELAY) || return;
  44         my $self = $class->new(fh => $fh);
  45
  46         # get my attributes
  47         $self->{ORIGTERM} = POSIX::Termios->new();
  48         my $term =  $self->{TERM} = POSIX::Termios->new();
  49         $self->{ORIGTERM} = $self->{ORIGTERM}->getattr(fileno($fh));
  50         $term->getattr(fileno($fh));
  51         my ($speed) = grep {/^\d+$/} @_;
  52         $speed ||= 9600;
  53         my $baud;
  54         {
  55                 no strict 'refs';
  56                 $baud = &{'POSIX::B' . $speed};
  57         }
  58         $term->setispeed($baud);
  59         $term->setospeed($baud);
  60
  61         my $cflag = $term->getcflag(); my $lflag = $term->getlflag();
  62         my $oflag = $term->getoflag(); my $iflag = $term->getiflag();
  63
  64         # set raw
  65         ########################################################################
  66         $iflag &= ~(IGNBRK|BRKINT|PARMRK|ISTRIP|INLCR|IGNCR|ICRNL|IXON);
  67         $oflag &= ~OPOST;
  68         $lflag &= ~(ECHO|ECHONL|ICANON|ISIG);
  69         $cflag &= ~(CSIZE|PARENB|HUPCL);
  70         #########################################################################
  71         #
  72
  73         $cflag |= CLOCAL|CREAD;
  74         $cflag |= (grep {/^cs7$/i} @_) ? CS7 : CS8;
  75         if (my ($parity) = grep {/^(odd|even)$/i} $@) {
  76                 $cflag |= PARENB;
  77                 $cflag |= PARODD if $parity =~ /odd/i;
  78         }
  79         $cflag |= CRTSCTS if grep /rtscts$/, $@;
  80         $term->setcflag($cflag); $term->setlflag($lflag);
  81         $term->setoflag($oflag); $term->setiflag($iflag);
  82         $term->setattr(fileno($fh), TCSANOW);
  83         $self->{device} = $device;
  84         $self->{speed} = $speed;
  85         return $self;
  86 }
  87
  88 sub getattr
  89 {
  90         my $self = shift;
  91         $self->{TERM}->getattr(fileno($self->fh));
  92         return $self->{TERM};
  93 }
  94
  95 sub setattr
  96 {
  97         my $self = shift;
  98         my $attr = shift || $self->{TERM};
  99         $attr->setattr(fileno($self->fh), &POSIX::TCSANOW);
 100 }
 101
 102 sub DESTROY
 103 {
 104         my $self = shift;
 105         $self->setattr($self->{ORIGTERM});
 106 }
 107
 108 1;