#!/usr/bin/perl


use warnings;
use strict;
use Data::Dump qw(dump);

sub checkcrc ($);
sub crc ($);

use Device::SerialPort;
my $device = "/dev/ttyUSB0";            #Port
my $timeout=1;
my $endtime=time+$timeout;

my $port = Device::SerialPort->new($device) || die $!;
$port->databits(8);
$port->baudrate(9600);
$port->parity("n");
$port->stopbits(1);
$port->handshake("none");
$port->write_settings;

$port->purge_all();
$port->read_char_time(0.1);     # don't wait for each character
$port->read_const_time(0.1); # 1 second per unfulfilled "read" call

 
use POSIX qw(strftime);
my $now =strftime "%Y-%m-%d_%H:%M:%S", localtime;
#print ($now,"\n");     
 
 
 
# read hardware version: DD A5 05 00 FF FB 77
#$port->write("\xdd\xa5\x05\x00\xff\xfb\x77");
# read cell voltages
#$port->write("\xdd\xa5\x04\x00\xff\xfc\x77");
#select(undef, undef, undef, 1.5); # 1.5 Sekunden warten
# read status
#$port->write("\xdd\xa5\x03\x00\xff\xfd\x77");

my $command=3;
my $senddata="";
my $cstring="\xdd\xa5".chr($command);
if (@ARGV > 0) {
	$command=$ARGV[0];
	if (eval($command) > 0) {
		$command=eval($command);
		$cstring="\xdd\xa5".chr($command);
		if ($ARGV[1] !~ /^$/) {
			$senddata=eval('"'.$ARGV[1].'"');
			print STDERR "data length ",length($senddata),"\n";
		}
	} elsif ($command =~ /-m/) { # write mosfet
		$command=0xe1;
		$senddata=pack("n",(eval($ARGV[1])));
		$cstring="\xdd\x5a".chr($command);
	} elsif ($command =~ /-w/) { # write general
		$command=eval($ARGV[1]);
		$senddata=(eval('"'.$ARGV[2].'"'));
		$cstring="\xdd\x5a".chr($command);
	} elsif ($command =~ /-h/) { # help
		print << "EOF"
$0:
	n	["arg"] 	send read command (with arg e. g. \"\\x00\\x00\")
	-m n	write mosfets: 
		-m 0 all on (-> MOSFET Control: 0x03), 
		-m 1 discharge (charge off -> MOSFET Control: 0x02), 
		-m 2 charge (discharge off -> MOSFET Control: 0x01, CAVE: out if in!), 
		-m 3 all off (-> MOSFET Control: 0x00)
	-w n ["arg"] send write command (with arg e. g. \"\\x12\\x34\")
	-h help
EOF
;
		exit(0);
	}
}
$cstring.=pack("C",length($senddata)).$senddata;
$cstring.=pack("n",crc(substr($cstring,2,-1)))."\x77";
print STDERR hexdump(\$cstring),"\n";
$port->write($cstring);

my ($count,$data);
my $sum=0;
my $alldata="";

sub crc ($);
sub checkcrc ($);

$data="";
($count,$data)=$port->read(4);
while ($sum < 4 && time < $endtime) {
	($count,$data)=$port->read(1);
	$alldata.=$data;
	if ($count) {print $data};
	$sum+=$count;
}
my $commstart=ord(substr($alldata,0,1));
my $commresp=ord(substr($alldata,1,1));
my $status=ord(substr($alldata,2,1));
my $length=ord(substr($alldata,3,1));
print STDERR "commresp=$commresp, status=$status, length=$length\n";
print STDERR hexdump(\$alldata),"\n";
if ($commstart != 0xdd || $commresp != $command || $status != 0) {
	print STDERR "comms error: packet does not start with \\xdd\?\\x00\n";
	printf STDERR "0: %02x, ",ord(substr($alldata,0,1));
	printf STDERR "1: %02x, ",ord(substr($alldata,1,1));
	printf STDERR "2: %02x\n",ord(substr($alldata,2,1));
  exit 1;
}
# include status and length?
$alldata=substr($alldata,2,2);
$sum=0;
while ($sum <= $length && time < $endtime) {
	($count,$data)=$port->read($length);
	$alldata.=$data;
	if ($count) {print $data};
	$sum+=$count;
}
if (checkcrc($alldata)) {
	print STDERR "\ncrc ok\n";
}

print hexdump(\$alldata);

if (time >= $endtime) {
	exit(1);
}

# 00 1f 19 21 00 00 00 00 07 d0 00 00 25 7e 00 00  ...!........%~..
# 00 00 00 03 20 64 00 14 04 0b 9c 0b ad 0b fa 0b  .... d..........
# f7 fa                                            ..

my %fields=('status' => [
		['voltage V',2,0.01],
		['current A',2,0.01],
		['Residual Capacity Ah',2,0.01],
		['Nominal Capacity Ah',2,0.01],
		['Cycle Times',2,1],
		['Manufacturing Date',2,1],
		['Balanced state',4,1],
		['Protection state/SWlock (12)',2,1],
		['RSOC remaining percentage',1,1],
		['SW Version',1,1],
		['MOSFET Control',1,1],
		['Number of Cells',1,1],
		['Number of NTCs',1,1],
	]);
if ($command == 3) {
	my $offset=2; # offset from start
	for my $field (@{$fields{'status'}}) {
		my ($field,$count,$scale)=@$field;
		my $val=0;
		for my $i (1..$count) {
			$val*=256;
			$val+=ord(substr($alldata,$offset,1));
			$offset++;
		}
		if ($field =~ /Date/) {
			printf "$field: %04x = %02i/%02i/%04i\n",$val,$val>>5&0x0f,$val&0x1f,($val>>9)+2000;
		} else {
			my $nibbles=2*$count;
			printf "$field: 0x%0${nibbles}x (%0.1f)\n",$val,$val*$scale;
		}
	}
	# last value is number of NTCs:
	my $ntcs=ord(substr($alldata,$offset-1,1));
	for my $i (1..$ntcs) {
		my $thisntc=unpack("n",substr($alldata,$offset,2))/10-273.1;
		printf "ntc %i: %0.1f °C\n",$i,$thisntc;
		$offset += 2;
	}
		
}

# bats:
# 00 28 0c 02 0b 73 0b f0 0d fb 01 61 0f 93 0c ec  .(...s.....a....
# 0c 8e 0c ae 0c 6f 0c ff 0d 4a 0d 21 0d 4b 0d 26  .....o...J.!.K.&
# 0d 30 0d 34 0d 20 0d a5 0d 97 f5 62 77           .0.4. .....bw

if ($command == 4) {
	my $offset=2; # offset from start
	my $numbat=$length/2;
	for my $thisbat (0..($numbat-1)) {
		my $thisv=unpack("n",substr($alldata,$offset,2))/1000;
		printf "battery %i: %0.3f\n",$thisbat,$thisv;
		$offset+=2;
	}
}
	

# (data + length + command code) checksum, 
# then Complement, 
# then add 1, high bit first, low bit last
sub crc ($) {
	my ($string) = @_;
	my $crc=0;
	my $command=ord(substr($string,0,1));
	my $length=ord(substr($string,1,1));
	$crc=$command+$length;
	for my $i (1..$length) {
		$crc+=ord(substr($string,1+$i,1));
	}
  $crc=($crc ^ 0xffff);
  $crc=$crc&0xffff;
  $crc=$crc+1;
	return $crc;
}

sub checkcrc ($) {
	my ($string) = @_;
	my $crc=0;
	my $command=ord(substr($string,0,1));
	my $length=ord(substr($string,1,1));
	$crc=crc($string);
			
	printf "%i %i %04x\n",$command,$length, $crc;
	if (length($string)>=($length+5)) {
		my $crcin=ord(substr($string,$length+2))*256+ord(substr($string,$length+3));
		printf "crcin: %04x\n", $crcin;
		return 1 if ($crcin == $crc);
	}
	return 0;
}

# from https://www.perlmonks.org/?node_id=132401
sub hexdump {
    my $str = ref $_[0] ? ${$_[0]} : $_[0];

    return "[ZERO-LENGTH STRING]\n" unless length $str;

    # split input up into 16-byte chunks:
    my @chunks = $str =~ /([\0-\377]{1,16})/g;
    # format and print:
    my @print;
    for (@chunks) {
        my $hex = unpack "H*", $_;
        tr/ -~/./c;                   # mask non-print chars
        $hex =~ s/(..)(?!$)/$1 /g;      # insert spaces in hex
        # make sure our hex output has the correct length
        $hex .= ' ' x ( length($hex) < 48 ? 48 - length($hex) : 0 );
        push @print, "$hex $_\n";
    }
    wantarray ? @print : join '', @print;
}