5 use Data::Dump qw(dump);
6 my $debug = $ENV{DEBUG} || 0;
10 use Device::SerialPort qw(:STAT);
12 my $port = Device::SerialPort->new('/dev/ttyUSB0');
13 die "can't open serial port" unless $port;
14 $port->baudrate(9600);
16 $port->parity('none');
18 $port->handshake('none');
20 $port->read_char_time(500);
21 $port->read_const_time(1000);
25 return $port->read( $len );
30 return $port->write( $bytes );
35 # TODO: implement remote serial port
36 # remserial -x 2 -p 23000 -s "9600 raw" /dev/ttyUSB0
40 my $sock = IO::Socket::INET->new(
41 PeerAddr => '192.168.1.148',
45 die "can't connect" unless $sock;
50 $sock->read( $buffer, $len );
51 warn "## read $len ",as_hex($buffer) if $debug;
57 return $sock->print( $bytes );
63 foreach my $str ( @_ ) {
64 my $hex = uc unpack( 'H*', $str );
65 $hex =~ s/(..)/$1 /g if length( $str ) > 2;
69 return join(' | ', @out);
74 $bytes .= pack('C', hex('0x' . $_)) foreach split(/\s+/,join(' ',@_));
81 for my $i ( 0 .. length($data) - 2 ) {
83 $crc = ( $crc << 1 ) ^ 25;
88 my $byte = ord(substr($data,$i,1));
90 # warn "## ", as_hex(chr($byte)), " crc = ", $crc, " ", as_hex(chr($crc));
92 # ignore checksum errors for FF, we will calulate them!
93 if ( chr($crc) ne substr($data,-1,1) && substr($data,-1,1) ne "\xFF" ) {
94 warn "CRC error for ",as_hex($data), " calulated ", as_hex(chr($crc));
97 return substr($data,0,-1) . chr($crc);
101 my ($bytes,$desc) = @_;
104 warn ">> ",as_hex( $bytes );
106 write_serial( $bytes );
108 my $data = read_serial(1);
109 warn "<< len: ",ord($data) if $debug;
111 goto retry if ord($data) == 0;
113 $data .= read_serial(ord($data) - 1);
115 warn "<< ",as_hex($data);
118 while ( $o < length($data) - 2 ) {
119 my $n = unpack('n', substr($data,$o,2));
120 $n = -( 0xffff - $n ) if $n & 0x8000;
121 warn "## $o = ",$n, "\t",$n / 16,"\n";
125 while ( $o < length($data) - 1 ) {
126 my $n = unpack('c', substr($data,$o,1));
127 warn "## $o = ", $n, "\n";
135 my ($hex,$desc) = @_;
136 v_bytes( hex2bytes( $hex ), $desc );
140 v '07 02 00 00 00 04 C4', "hardware version";
142 v '07 0A 00 00 00 04 44', 'software version';
144 v '07 00 01 00 06 0E EA', 'temperatures';
146 v '07 00 00 00 26 0A A6', 'last errros';
149 #v '07 00 00 00 26 00 AC', 'last errros (with invalid length)';
151 foreach my $reg ( @ARGV ) {
152 warn "# send user $reg\n";
154 crc( hex2bytes( "07 00 00 00 $reg 01 FF" ) )