#!/usr/bin/perl

use strict;
use warnings;

use POSIX;	# for TERMIOS calls
use Fcntl;	# for non-blocking IO


die("Usage: $0 /dev/ttyS1 address\n") unless $#ARGV == 1;
my $TTS = $ARGV[0];
my $addr = $ARGV[1];
my $timeout = 0.5;	# seconds

my $debug = 0;

sub checksum16 ($) {
# calculates the checksum 16 of the given string argument
	my @bytes = unpack("C*", $_[0]);
	my $sum = 0;
	foreach(@bytes) {
		$sum += $_;
		$sum %= 2**16;
	}
	return $sum;
}

sub mkmsg ($@) {
# makes a message with the items in the given array as questions
	my ($dst, @questions) = @_;

	my $src = 'FB';
 	$dst = sprintf('%02X', $dst);
	my $len = '00';
	my $cs = '0000';
	my $msg = "64:" . join(';', @questions);
	
	$len = length("{$src;$dst;$len|$msg|$cs}");
	$len = sprintf("%02X", $len);
	
	$cs = checksum16("$src;$dst;$len|$msg|");
	$cs = sprintf("%04X", $cs);
	return "{$src;$dst;$len|$msg|$cs}";
}

sub waitfor ($$) {
# waits until $_[0] becomes readable
# timeout after $_[1] seconds
	my ($H, $timeout) = @_;
	my $rin = '';
	vec($rin, fileno($H), 1) = 1;
	my $found = select($rin, undef, undef, $timeout);	# block until readable
	return $found;
}

sub tryread ($$$) {
# tries hard to read $_[1] bytes from $_[0]
# timeout is $_[3];
# returns the result
	my ($H, $len, $timeout) = @_;
	my $buf = '';
	while( length($buf) < $len ) {
		# wait for something to happen
		if( ! waitfor($H, $timeout) ) {
			print "Timeout\n";
			return undef;
		}
		my $rv = sysread($H, $buf, $len-length($buf), length($buf));	# read the remaining bytes and put it in buf at the correct place
		if( !defined($rv) ) {
			die "Error reading: $!";
		}
		#print "read $rv bytes: $buf\n";
	}
	return $buf;
}

print "Opening serial port $TTS\n";
my $serial;
sysopen( $serial, $TTS, O_NONBLOCK | O_RDWR )
	or die("Couldn't open serial port $TTS: $!");
select((select($serial), $| = 1)[0]);    # autoflush on

print "Setting 19200 8N1\n";
system("stty sane speed 19200 cs8 -parenb -cstopb -brkint -echo -icrnl -imaxbel -icanon -isig < $TTS > /dev/null 2> /dev/null");
# -brkint: don't interrupt on break
# -echo: don't echo everything back
# -icrnl: don't translate CR-NL things
# -imaxbel: don't complain on full input buffer
# -icanon -isig: disable special characters

print "Reading all pending bytes\n";
{
	my $size = 1;
	while( $size ) {
		my $dummy;
		$size = sysread( $serial, $dummy, 255);
		print "Read $size bytes\n" if $size;
	}
}

my @cmd = (
	{ 'descr' => 'Address',			'name' => 'ADR', 'convert' => sub { return hex($_[0]); } },
	{ 'descr' => 'Type',			'name' => 'TYP', 'convert' => sub { return "0x" . $_[0]; } },
	{ 'descr' => 'Software version',	'name' => 'SWV', 'convert' => sub { return sprintf("%1.1f", hex($_[0]) / 10 ); } },
	{ 'descr' => 'Date day',		'name' => 'DDY', 'convert' => sub { return hex($_[0]); } },
	{ 'descr' => 'Date month',		'name' => 'DMT', 'convert' => sub { return hex($_[0]); } },
	{ 'descr' => 'Date year',		'name' => 'DYR', 'convert' => sub { return hex($_[0]); } },
	{ 'descr' => 'Time hours',		'name' => 'THR', 'convert' => sub { return hex($_[0]); } },
	{ 'descr' => 'Time minutes',		'name' => 'TMI', 'convert' => sub { return hex($_[0]); } },
	{ 'descr' => 'Error 1, number',		'name' => 'E11', 'convert' => sub { return hex($_[0]); } },
	{ 'descr' => 'Error 1, day',		'name' => 'E1D', 'convert' => sub { return hex($_[0]); } },
	{ 'descr' => 'Error 1, month',		'name' => 'E1M', 'convert' => sub { return hex($_[0]); } },
	{ 'descr' => 'Error 1, hour',		'name' => 'E1h', 'convert' => sub { return hex($_[0]); } },
	{ 'descr' => 'Error 1, minute',		'name' => 'E1m', 'convert' => sub { return hex($_[0]); } },
	{ 'descr' => 'Error 2, number',		'name' => 'E21', 'convert' => sub { return hex($_[0]); } },
	{ 'descr' => 'Error 2, day',		'name' => 'E2D', 'convert' => sub { return hex($_[0]); } },
	{ 'descr' => 'Error 2, month',		'name' => 'E2M', 'convert' => sub { return hex($_[0]); } },
	{ 'descr' => 'Error 2, hour',		'name' => 'E2h', 'convert' => sub { return hex($_[0]); } },
	{ 'descr' => 'Error 2, minute',		'name' => 'E2m', 'convert' => sub { return hex($_[0]); } },
	{ 'descr' => 'Error 3, number',		'name' => 'E31', 'convert' => sub { return hex($_[0]); } },
	{ 'descr' => 'Error 3, day',		'name' => 'E3D', 'convert' => sub { return hex($_[0]); } },
	{ 'descr' => 'Error 3, month',		'name' => 'E3M', 'convert' => sub { return hex($_[0]); } },
	{ 'descr' => 'Error 3, hour',		'name' => 'E3h', 'convert' => sub { return hex($_[0]); } },
	{ 'descr' => 'Error 3, minute',		'name' => 'E3m', 'convert' => sub { return hex($_[0]); } },
	{ 'descr' => 'Operating hours',		'name' => 'KHR', 'convert' => sub { return hex($_[0]); } },
	{ 'descr' => 'Energy today [Wh]',	'name' => 'KDY', 'convert' => sub { return (hex($_[0]) * 100); } },
	{ 'descr' => 'Energy yesterday [Wh]',	'name' => 'KLD', 'convert' => sub { return (hex($_[0]) * 100); } },
	{ 'descr' => 'Energy this month [kWh]',	'name' => 'KMT', 'convert' => sub { return hex($_[0]); } },
	{ 'descr' => 'Energy last monh [kWh]',	'name' => 'KLM', 'convert' => sub { return hex($_[0]); } },
	{ 'descr' => 'Energy this year [kWh]',	'name' => 'KYR', 'convert' => sub { return hex($_[0]); } },
	{ 'descr' => 'Energy last year [kWh]',	'name' => 'KLY', 'convert' => sub { return hex($_[0]); } },
	{ 'descr' => 'Energy total [kWh]',	'name' => 'KT0', 'convert' => sub { return hex($_[0]); } },
	{ 'descr' => 'Language',		'name' => 'LAN', 'convert' => sub { return hex($_[0]); } },
	{ 'descr' => 'DC voltage [mV]',		'name' => 'UDC', 'convert' => sub { return (hex($_[0]) * 100); } },
	{ 'descr' => 'AC voltage [mV]',		'name' => 'UL1', 'convert' => sub { return (hex($_[0]) * 100); } },
	{ 'descr' => 'DC current [mA]',		'name' => 'IDC', 'convert' => sub { return (hex($_[0]) * 10); } },
	{ 'descr' => 'AC current [mA]',		'name' => 'IL1', 'convert' => sub { return (hex($_[0]) * 10); } },
	{ 'descr' => 'AC power [mW]',		'name' => 'PAC', 'convert' => sub { return (hex($_[0]) * 500); } },
	{ 'descr' => 'Power installed [mW]',	'name' => 'PIN', 'convert' => sub { return (hex($_[0]) * 500); } },
	{ 'descr' => 'AC power [%]',		'name' => 'PRL', 'convert' => sub { return hex($_[0]); } },
	{ 'descr' => '??? Start ups ???',	'name' => 'CAC', 'convert' => sub { return hex($_[0]); } },
	{ 'descr' => '???',			'name' => 'FRD', 'convert' => sub { return "0x" . $_[0]; } },
	{ 'descr' => '???',			'name' => 'SCD', 'convert' => sub { return "0x" . $_[0]; } },
	{ 'descr' => '???',			'name' => 'SE1', 'convert' => sub { return "0x" . $_[0]; } },
	{ 'descr' => '???',			'name' => 'SE2', 'convert' => sub { return "0x" . $_[0]; } },
	{ 'descr' => '???',			'name' => 'SPR', 'convert' => sub { return "0x" . $_[0]; } },
);

for my $cmd (@cmd) {
	my $msg = mkmsg($addr, $cmd->{name});
	print $cmd->{descr} . " (" . $cmd->{name} . "): ";
	print STDERR "Writing \"$msg\" to serial\n" if $debug;
	my $rv = syswrite($serial, $msg);
	die("Write error: $!") unless $rv;
	die("Write incomplete") unless $rv == length($msg);

	# Reading first 9 bytes
	print STDERR "Reading response header from serial\n" if $debug;
	$msg = tryread($serial, 9, $timeout);
	next if !defined $msg;
	print STDERR "Header received: \"$msg\"\n" if $debug;

	die("invalid response") unless $msg =~ m/{([0-9A-F]{2});FB;([0-9A-F]{2})/;
	die("wrong source address: $1 != $addr") unless hex($1) == $addr;
	my $len = hex($2);

	print STDERR "Length is $len, reading rest\n" if $debug;
	$len -= 9;	# header is already in
	$msg = tryread($serial, $len, $timeout);
	print STDERR "Read \"$msg\"\n" if $debug;

	die("invalid response") unless $msg =~ m/^\|64:(\w{3})=([0-9A-F]+)\|([0-9A-F]{4})}$/;
	# TODO: check checksum
	die("wrong response") unless $1 eq $cmd->{'name'};
	print $cmd->{convert}($2) . "\n";
}