mirror of
https://github.com/fhem/fhem-mirror.git
synced 2024-11-22 09:49:50 +00:00
cc6d5982e0
git-svn-id: https://svn.fhem.de/fhem/trunk@529 2b470e98-0d58-463d-a4d8-8e2adae1ed80
475 lines
10 KiB
Perl
Executable File
475 lines
10 KiB
Perl
Executable File
#!/usr/bin/perl
|
|
|
|
use strict;
|
|
use warnings;
|
|
use Device::SerialPort;
|
|
|
|
sub b($$);
|
|
sub w($$);
|
|
sub docrc($$);
|
|
sub checkcrc($$);
|
|
sub getData($);
|
|
sub makemsg($);
|
|
sub maketime($);
|
|
|
|
my %cmd = (
|
|
"getVersion" => 1,
|
|
"getTime" => 1,
|
|
"getDevStatus" => 1,
|
|
"getDevPage" => 1,
|
|
"getDevData" => 1,
|
|
"setPrice" => 1,
|
|
"setAlarm" => 1,
|
|
"setRperKW" => 1,
|
|
"get62" => 1,
|
|
"setTime" => 1,
|
|
"reset" => 1,
|
|
);
|
|
|
|
|
|
if(@ARGV < 2) {
|
|
printf("Usage: perl em1010.pl serial-device command args\n");
|
|
exit(1);
|
|
}
|
|
my $ser = $ARGV[0];
|
|
|
|
my $fd;
|
|
|
|
#####################
|
|
# Open serial port
|
|
my $serport = new Device::SerialPort ($ser);
|
|
die "Can't open $ser: $!\n" if(!$serport);
|
|
$serport->reset_error();
|
|
$serport->baudrate(38400);
|
|
$serport->databits(8);
|
|
$serport->parity('none');
|
|
$serport->stopbits(1);
|
|
$serport->handshake('none');
|
|
|
|
my $cmd = $ARGV[1];
|
|
if(!defined($cmd{$cmd})) {
|
|
printf("Unknown command $cmd, use one of " . join(" ",sort keys %cmd) . "\n");
|
|
exit(0);
|
|
}
|
|
|
|
###########################
|
|
no strict "refs";
|
|
&{$cmd }();
|
|
use strict "refs";
|
|
exit(0);
|
|
|
|
#########################
|
|
sub
|
|
maketime($)
|
|
{
|
|
my @l = localtime(shift);
|
|
return sprintf("%04d-%02d-%02d_%02d:%02d:00",
|
|
1900+$l[5],$l[4]+1,$l[3],$l[2],$l[1]-$l[1]%5);
|
|
}
|
|
|
|
#########################
|
|
sub
|
|
b($$)
|
|
{
|
|
my ($t,$p) = @_;
|
|
return ord(substr($t,$p,1));
|
|
}
|
|
|
|
#########################
|
|
sub
|
|
w($$)
|
|
{
|
|
my ($t,$p) = @_;
|
|
return b($t,$p+1)*256 + b($t,$p);
|
|
}
|
|
|
|
#########################
|
|
sub
|
|
dw($$)
|
|
{
|
|
my ($t,$p) = @_;
|
|
return w($t,$p+2)*65536 + w($t,$p);
|
|
}
|
|
|
|
#########################
|
|
sub
|
|
docrc($$)
|
|
{
|
|
my ($in, $val) = @_;
|
|
my ($crc, $bits) = (0, 8);
|
|
my $k = (($in >> 8) ^ $val) << 8;
|
|
while($bits--) {
|
|
if(($crc ^ $k) & 0x8000) {
|
|
$crc = ($crc << 1) ^ 0x8005;
|
|
} else {
|
|
$crc <<= 1;
|
|
}
|
|
$k <<= 1;
|
|
}
|
|
return (($in << 8) ^ $crc) & 0xffff;
|
|
}
|
|
|
|
#########################
|
|
sub
|
|
checkcrc($$)
|
|
{
|
|
my ($otxt, $len) = @_;
|
|
my $crc = 0x8c27;
|
|
for(my $l = 2; $l < $len+4; $l++) {
|
|
my $b = ord(substr($otxt,$l,1));
|
|
$crc = docrc($crc, 0x10) if($b==0x02 || $b==0x03 || $b==0x10);
|
|
$crc = docrc($crc, $b);
|
|
}
|
|
return ($crc == w($otxt, $len+4));
|
|
}
|
|
|
|
#########################
|
|
sub
|
|
esc($)
|
|
{
|
|
my ($b) = @_;
|
|
|
|
my $out = "";
|
|
$out .= chr(0x10) if($b==0x02 || $b==0x03 || $b==0x10);
|
|
$out .= chr($b);
|
|
}
|
|
|
|
#########################
|
|
sub
|
|
makemsg($)
|
|
{
|
|
my ($data) = @_;
|
|
my $len = length($data);
|
|
$data = chr($len&0xff) . chr(int($len/256)) . $data;
|
|
|
|
my $out = pack('H*', "0200");
|
|
my $crc = 0x8c27;
|
|
for(my $l = 0; $l < $len+2; $l++) {
|
|
my $b = ord(substr($data,$l,1));
|
|
$crc = docrc($crc, 0x10) if($b==0x02 || $b==0x03 || $b==0x10);
|
|
$crc = docrc($crc, $b);
|
|
$out .= esc($b);
|
|
}
|
|
$out .= esc($crc&0xff);
|
|
$out .= esc($crc/256);
|
|
$out .= chr(0x03);
|
|
return $out;
|
|
}
|
|
|
|
|
|
#########################
|
|
sub
|
|
getData($)
|
|
{
|
|
my ($d) = @_;
|
|
$d = makemsg(pack('H*', $d));
|
|
#print "Sending: " . unpack('H*', $d) . "\n";
|
|
|
|
for(my $rep = 0; $rep < 3; $rep++) {
|
|
|
|
#printf "write (try nr $rep)\n";
|
|
$serport->write($d);
|
|
|
|
my $retval = "";
|
|
my $esc = 0;
|
|
my $started = 0;
|
|
my $complete = 0;
|
|
for(;;) {
|
|
my ($rout, $rin) = ('', '');
|
|
vec($rin, $serport->FILENO, 1) = 1;
|
|
my $nfound = select($rout=$rin, undef, undef, 1.0);
|
|
|
|
die("Select error $nfound / $!\n") if($nfound < 0);
|
|
last if($nfound == 0);
|
|
|
|
my $buf = $serport->input();
|
|
die "EOF on $ser\n" if(!defined($buf) || length($buf) == 0);
|
|
|
|
for(my $i = 0; $i < length($buf); $i++) {
|
|
my $b = ord(substr($buf,$i,1));
|
|
|
|
if(!$started && $b != 0x02) { next; }
|
|
$started = 1;
|
|
if($esc) { $retval .= chr($b); $esc = 0; next; }
|
|
if($b == 0x10) { $esc = 1; next; }
|
|
$retval .= chr($b);
|
|
if($b == 0x03) { $complete = 1; last; }
|
|
}
|
|
if($complete) {
|
|
my $l = length($retval);
|
|
if($l < 8) { printf("Msg too short\n"); last; }
|
|
if(b($retval,1) != 0) { printf("Bad second byte\n"); last; }
|
|
if(w($retval,2) != $l-7) { printf("Length mismatch\n"); last; }
|
|
if(!checkcrc($retval,$l-7)) { printf("Bad CRC\n"); last; }
|
|
return substr($retval, 4, $l-7);
|
|
}
|
|
}
|
|
}
|
|
|
|
printf "Timeout reading the answer\n";
|
|
exit(1);
|
|
}
|
|
#########################
|
|
sub
|
|
hexdump($)
|
|
{
|
|
my ($d) = @_;
|
|
for(my $i = 0; $i < length($d); $i += 16) {
|
|
my $h = unpack("H*", substr($d, $i, 16));
|
|
$h =~ s/(....)/$1 /g;
|
|
printf "RAW %-40s\n", $h;
|
|
}
|
|
}
|
|
|
|
#########################
|
|
sub
|
|
getVersion()
|
|
{
|
|
my $d = getData("76");
|
|
printf "%d.%d\n", b($d,0), b($d,1);
|
|
}
|
|
|
|
#########################
|
|
sub
|
|
getTime()
|
|
{
|
|
my $d = getData("74");
|
|
printf("%4d-%02d-%02d %02d:%02d:%02d\n",
|
|
b($d,5)+2006, b($d,4), b($d,3),
|
|
b($d,0), b($d,1), b($d,2));
|
|
}
|
|
|
|
#########################
|
|
sub
|
|
getDevStatus()
|
|
{
|
|
die "Usage: getDevStatus devicenumber (1-12)\n" if(@ARGV != 3);
|
|
my $d = getData(sprintf("7a%02x",$ARGV[2]-1));
|
|
|
|
if($d eq ((pack('H*',"00") x 45) . pack('H*',"FF") x 6)) {
|
|
printf(" No device no. $ARGV[2] present\n");
|
|
return;
|
|
}
|
|
my $pulses=w($d,13);
|
|
my $pulses_max=w($d,15);
|
|
my $ec=w($d,49) / 10;
|
|
my $cur_energy=0;
|
|
my $cur_power=0;
|
|
my $cur_power_max=0;
|
|
my $sum_h_energy=0;
|
|
my $sum_d_energy=0;
|
|
my $sum_w_energy=0;
|
|
my $total_energy=0;
|
|
my $iec=0;
|
|
|
|
printf(" Readings (off 2): %d\n", w($d,2));
|
|
printf(" Nr devs (off 6): %d\n", b($d,6));
|
|
printf(" puls/5min (off 13): %d\n", $pulses);
|
|
printf(" puls.max/5min (off 15): %d\n", $pulses_max);
|
|
#printf(" Startblk (off 18): %d\n", b($d,18)+13);
|
|
#for (my $lauf = 19; $lauf < 45; $lauf += 2) {
|
|
# printf(" t wert (off $lauf): %d\n", w($d,$lauf));
|
|
#}
|
|
# The data must interpreted depending on the sensor type.
|
|
# Currently we use the EC value to quess the sensor type.
|
|
if ($ec eq 0) {
|
|
# Sensor 5..
|
|
$iec = 1000;
|
|
$cur_power = $pulses / 100;
|
|
$cur_power_max = $pulses_max / 100;
|
|
} else {
|
|
# Sensor 1..4
|
|
$iec = $ec;
|
|
$cur_energy = $pulses / $ec; # ec = U/kWh
|
|
$cur_power = $cur_energy / 5 * 60; # 5minute interval scaled to 1h
|
|
printf(" cur.energy(off ): %.3f kWh\n", $cur_energy);
|
|
}
|
|
$sum_h_energy= dw($d,33) / $iec; # 33= pulses this hour
|
|
$sum_d_energy= dw($d,37) / $iec; # 37= pulses today
|
|
$sum_w_energy= dw($d,41) / $iec; # 41= pulses this week
|
|
$total_energy= dw($d, 7) / $iec; # 7= pulses total
|
|
printf(" cur.power ( ): %.3f kW\n", $cur_power);
|
|
printf(" cur.power max ( ): %.3f kW\n", $cur_power_max);
|
|
printf(" energy h (off 33): %.3f kWh (h)\n", $sum_h_energy);
|
|
printf(" energy d (off 37): %.3f kWh (d)\n", $sum_d_energy);
|
|
printf(" energy w (off 41): %.3f kWh (w)\n", $sum_w_energy);
|
|
printf(" total energy (off 7): %.3f kWh (total)\n", $total_energy);
|
|
printf(" Alarm PA (off 45): %d W\n", w($d,45));
|
|
printf(" Price CF (off 47): %0.2f EUR/kWh\n", w($d,47)/10000);
|
|
printf(" R/kW EC (off 49): %d\n", $ec);
|
|
hexdump($d);
|
|
}
|
|
|
|
#########################
|
|
sub
|
|
getDevPage()
|
|
{
|
|
die "Usage: getDevPage pagenumber [length] (default length is 264)\n"
|
|
if(@ARGV < 3);
|
|
my $l = (@ARGV > 3 ? $ARGV[3] : 264);
|
|
my $d = getData(sprintf("52%02x%02x0000%02x%02x",
|
|
$ARGV[2]%256, int($ARGV[2]/256), $l%256, int($l/256)));
|
|
hexdump($d);
|
|
}
|
|
|
|
#########################
|
|
sub
|
|
getDevData()
|
|
{
|
|
my $smooth = 1; # Set this to 0 to get the "real" values
|
|
|
|
die "Usage: getDevData devicenumber (1-12)\n" if(@ARGV != 3);
|
|
my $d = getData(sprintf("7a%02x",$ARGV[2]-1));
|
|
|
|
if($d eq ((pack('H*',"00") x 45) . pack('H*',"FF") x 6)) {
|
|
printf(" No device no. $ARGV[2] present\n");
|
|
return;
|
|
}
|
|
|
|
my $nrreadings = w($d,2);
|
|
if($nrreadings == 0) {
|
|
printf("No data to read (yet?)\n");
|
|
exit(0);
|
|
}
|
|
my $step = b($d,6);
|
|
my $start = b($d,18)+13;
|
|
my $end = $start + int(($nrreadings-1)/64)*$step;
|
|
my $div = w($d,49)/10;
|
|
if ($div eq 0) {
|
|
$div = 1;
|
|
}
|
|
|
|
#printf("Total $nrreadings, $start - $end, Nr $step\n");
|
|
|
|
my $tm = time()-(($nrreadings-1)*300);
|
|
my $backlog = 0;
|
|
for(my $p = $start; $p <= $end; $p += $step) {
|
|
#printf("Get page $p\n");
|
|
|
|
$d = getData(sprintf("52%02x%02x00000801", $p%256, int($p/256)));
|
|
|
|
#hexdump($d);
|
|
|
|
my $max = (($p == $end) ? ($nrreadings%64)*4+4 : 260);
|
|
my $step = b($d, 7); # Switched from 6 to 7 (Thomas, 2009-12-31)
|
|
|
|
for(my $off = 8; $off <= $max; $off += 4) {
|
|
$backlog++;
|
|
if($smooth && (w($d,$off+2) == 0xffff)) { # "smoothing"
|
|
next;
|
|
} else {
|
|
my $v = w($d,$off)*12/$div/$backlog;
|
|
my $f1 = b($d,$off+2);
|
|
my $f2 = b($d,$off+3);
|
|
my $f3 = w($d,$off+2);
|
|
|
|
while($backlog--) {
|
|
printf("%s %0.3f kWh (%d %d %d)\n", maketime($tm), $v,
|
|
($backlog?-1:$f1), ($backlog?-1:$f2), ($backlog?-1:$f3));
|
|
$tm += 300;
|
|
}
|
|
$backlog = 0;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
sub
|
|
setPrice()
|
|
{
|
|
die "Usage: setPrice device value_in_cent\n"
|
|
if(@ARGV != 4);
|
|
my $d = $ARGV[2];
|
|
my $v = $ARGV[3];
|
|
|
|
$d = getData(sprintf("79%02x2f02%02x%02x", $d-1, $v%256, int($v/256)));
|
|
if(b($d,0) == 6) {
|
|
print("OK");
|
|
} else {
|
|
print("Error occured");
|
|
hexdump($d);
|
|
}
|
|
}
|
|
|
|
sub
|
|
setAlarm()
|
|
{
|
|
die "Usage: setAlarm device value_in_kWh\n"
|
|
if(@ARGV != 4);
|
|
my $d = $ARGV[2];
|
|
my $v = $ARGV[3];
|
|
|
|
$d = getData(sprintf("79%02x2d02%02x%02x", $d-1, $v%256, int($v/256)));
|
|
if(b($d,0) == 6) {
|
|
print("OK");
|
|
} else {
|
|
print("Error occured");
|
|
hexdump($d);
|
|
}
|
|
}
|
|
|
|
sub
|
|
setRperKW()
|
|
{
|
|
die "Usage: setRperKW device rotations_per_KW\n"
|
|
if(@ARGV != 4);
|
|
my $d = $ARGV[2];
|
|
my $v = $ARGV[3];
|
|
|
|
$v = $v * 10;
|
|
$d = getData(sprintf("79%02x3102%02x%02x", $d-1, $v%256, int($v/256)));
|
|
if(b($d,0) == 6) {
|
|
print("OK");
|
|
} else {
|
|
print("Error occured");
|
|
hexdump($d);
|
|
}
|
|
}
|
|
|
|
sub
|
|
reset()
|
|
{
|
|
my $d = getData("4545");
|
|
hexdump($d);
|
|
}
|
|
|
|
sub
|
|
get62()
|
|
{
|
|
my $d = getData("62");
|
|
hexdump($d);
|
|
}
|
|
|
|
sub
|
|
setTime()
|
|
{
|
|
my $a2 = '';
|
|
my $a3 = '';
|
|
|
|
if (@ARGV == 2) {
|
|
my @lt = localtime;
|
|
$a2 = sprintf ("%04d-%02d-%02d", $lt[5]+1900, $lt[4]+1, $lt[3]);
|
|
$a3 = sprintf ("%02d:%02d:%02d", $lt[2], $lt[1], $lt[0]);
|
|
} else {
|
|
die "Usage: setTime [time] (as YYYY-MM-DD HH:MM:SS, localtime if empty)\n"
|
|
if(@ARGV != 4);
|
|
$a2 = $ARGV[2];
|
|
$a3 = $ARGV[3];
|
|
}
|
|
my @d = split("-", $a2);
|
|
my @t = split(":", $a3);
|
|
|
|
my $s = sprintf("73%02x%02x%02x00%02x%02x%02x",
|
|
$d[2],$d[1],$d[0]-2000+0xd0,
|
|
$t[0],$t[1],$t[2]);
|
|
print("-> $s\n");
|
|
|
|
my $d = getData($s);
|
|
if(b($d,0) == 6) {
|
|
print("OK");
|
|
} else {
|
|
print("Error occured");
|
|
hexdump($d);
|
|
}
|
|
}
|