#!/usr/bin/perl -w # # Copyright (c) 2015 Sulev-Madis Silber # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # 2. Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # # THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF # SUCH DAMAGE. # use strict; use warnings FATAL => 'all'; use Data::Dumper; use Device::SerialPort; $| = 1; my ($device) = @ARGV; die 'no device' unless $device; my $serialport; sub serial_connected () { return defined $serialport ? 1 : undef; } sub serial_open () { $serialport = new Device::SerialPort($device) || die(sprintf "can't open serial port %s: %s", $device, $!); $serialport->baudrate(9600); $serialport->databits(8); $serialport->parity('none'); $serialport->stopbits(1); $serialport->handshake('none'); if (0) { $serialport->read_interval(100); $serialport->read_char_time(50); $serialport->read_const_time(1000); $serialport->write_char_time(5); $serialport->write_const_time(1000); } if (0) { $serialport->{C_IFLAG} &= ~(BRKINT|ICRNL|IGNCR|INLCR|INPCK|ISTRIP|IXON|IXOFF|PARMRK); $serialport->{C_IFLAG} |= IGNBRK|IGNPAR; $serialport->{C_OFLAG} &= ~(OPOST); $serialport->{C_CFLAG} &= ~(CSIZE|HUPCL|PARENB); $serialport->{C_CFLAG} |= (CLOCAL|CS8|CREAD); $serialport->{C_LFLAG} &= ~(ECHO|ECHOE|ECHOK|ECHONL|ICANON|IEXTEN|ISIG); $serialport->{C_VMIN} = 0; $serialport->{C_VTIME} = 3; } $serialport->write_settings; $serialport->purge_all; } sub serial_close () { if (serial_connected) { $serialport->close || warn "close failed\n"; undef $serialport; } } sub purge_all () { return undef unless serial_connected; $serialport->purge_all; } sub serial_write ($) { my ($string) = @_; return undef unless serial_connected; purge_all; my $count = $serialport->write($string); if (0) { select undef, undef, undef, (11 * 1000 / 10 ** 6); } unless ($count) { warn "write failed\n"; return undef; } unless ($count == length $string) { warn "write incomplete\n"; return undef; } $serialport->write_drain; return 1; } sub serial_read ($) { my ($bytes) = @_; return undef unless serial_connected; $serialport->read_char_time(10); while (my ($count, $string) = $serialport->read($bytes)) { warn "read incomplete\n" unless $count == $bytes; return $string; } } sub clean_exit () { serial_close; exit; } $SIG{$_} = \&clean_exit foreach qw(HUP INT TERM); serial_open; $0 = sprintf "serial %s", $device; print STDERR "READY\n"; while () { if (/^\s*write\s+(.+)\s*$/i) { serial_write $1; } elsif (/^\s*read\s+(\d+)\s*$/i) { printf "read %s %s\n", $device, serial_read $1; } } clean_exit;