#!/usr/bin/perl
use warnings;
use strict;

use Data::Dump qw(dump);
my $debug = $ENV{DEBUG} || 0;

=for serial_port

use Device::SerialPort qw(:STAT);

my $port = Device::SerialPort->new('/dev/ttyUSB0');
die "can't open serial port" unless $port;
$port->baudrate(9600);
$port->databits(8);
$port->parity('none');
$port->stopbits(1);
$port->handshake('none');

$port->read_char_time(500);
$port->read_const_time(1000);

sub read_serial {
	my $len = shift;
	return $port->read( $len );
}

sub write_serial {
	my $bytes = shift;
	return $port->write( $bytes );
}

=cut

# TODO: implement remote serial port
# remserial -x 2 -p 23000 -s "9600 raw" /dev/ttyUSB0

use IO::Socket::INET;

my $sock = IO::Socket::INET->new(
	PeerAddr => '192.168.1.148',
	PeerPort => '23000',
	Proto    => 'tcp'
);
die "can't connect" unless $sock;

sub read_serial {
	my $len = shift;
	my $buffer;
	eval {
		local $SIG{ALRM} = sub { die "read timeout" };
		alarm 3;

		warn "## read_serial $len" if $debug;
		$sock->read( $buffer, $len );
		warn "## read $len ",as_hex($buffer) if $debug;
	};
	alarm 0;
	warn "ERROR: $@" if $@;
	return $buffer;
}

sub write_serial {
	my $bytes = shift;
	return $sock->print( $bytes );
}


sub as_hex {
	my @out;
	foreach my $str ( @_ ) {
		my $hex = uc unpack( 'H*', $str );
		$hex =~ s/(..)/$1 /g if length( $str ) > 2;
		$hex =~ s/\s+$//;
		push @out, $hex;
	}
	return join(' | ', @out);
}

sub hex2bytes {
	my $bytes;
	$bytes .= pack('C', hex('0x' . $_)) foreach split(/\s+/,join(' ',@_));
	return $bytes;
}

sub crc {
	my $data = shift;
	my $crc = 0;
	for my $i ( 0 .. length($data) - 2 ) {
		if ( $crc & 0x80 ) {
			$crc = ( $crc << 1 ) ^ 25;
		} else {
			$crc = $crc << 1;
		}
		$crc = $crc & 0xff;
		my $byte = ord(substr($data,$i,1));
		$crc = $crc ^ $byte;
#		warn "## ", as_hex(chr($byte)), " crc = ", $crc, " ", as_hex(chr($crc));
	}
	# ignore checksum errors for FF, we will calulate them!
	if ( chr($crc) ne substr($data,-1,1) && substr($data,-1,1) ne "\xFF" ) {
		warn "CRC error for ",as_hex($data), " calulated ", as_hex(chr($crc));
	}

	return substr($data,0,-1) . chr($crc);
}

sub v_bytes {
	my ($bytes,$desc) = @_;
	warn "# $desc\n";
retry:
	warn ">> ",as_hex( $bytes );
	crc( $bytes );
	write_serial( $bytes );

	my $data = read_serial(1);
	warn "<< len: ",ord($data) if $debug;

	goto retry if ord($data) == 0;

	$data .= read_serial(ord($data) - 1);
	crc($data);
	warn "<< ",as_hex($data);

	my $o = 2;
	while ( $o < length($data) - 2 ) {
		my $n = unpack('n', substr($data,$o,2));
		$n = -( 0xffff - $n ) if $n & 0x8000;
		warn "## $o = ",$n, "\t",$n / 16,"\n";
		$o += 2;
	}

	while ( $o < length($data) - 1 ) {
		my $n = unpack('c', substr($data,$o,1));
		warn "## $o = ", $n, "\n";
		$o += 1;
	}

	return $data;
}

sub v {
	my ($hex,$desc) = @_;
	v_bytes( hex2bytes( $hex ), $desc );
}

if ( ! @ARGV ) {
	v '07 02 00 00 00 04 C4', "hardware version";

	v '07 0A 00 00 00 04 44', 'software version';

	v '07 00 01 00 06 0E EA', 'temperatures';

	v '07 00 00 00 26 0A A6', 'last errros';
}

#v '07 00 00 00 26 00 AC', 'last errros (with invalid length)';

foreach my $reg ( @ARGV ) {
	warn "# send user $reg\n";
	v_bytes(
		crc( hex2bytes( "07 00 00 00 $reg 01 FF" ) )
	,"user: $reg");
}
