added more structure according to LEARNING PERL
This commit is contained in:
Patrick Menschel
parent
5bbcadf4fc
commit
649d1bd82a
347
test_drs110m.pl
347
test_drs110m.pl
@ -5,7 +5,7 @@
|
||||
# which itself borrows parts of http://www.ip-symcon.de/forum/threads/21407-Stromz%C3%A4hler-mit-RS485/page2
|
||||
# The general functions have been developed in python3, see https://github.com/menschel/pyehz
|
||||
# Use and copy as you wish.
|
||||
# Menschel (C) 2019
|
||||
# Menschel (C) 2020
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
@ -31,115 +31,9 @@ $port->read_const_time(100); # 100 millisecond per unfulfilled "read" call
|
||||
my $serialID = "001613300153"; # The serial number of the specific device 12-digits long.
|
||||
# It is possible to find out the device id of a single device on RS-485 9600@7E1 by sending "/?!\r\n"
|
||||
my $password = "00000000"; # Standard password 0 over 8-digits
|
||||
|
||||
my $verbose = 2 ;
|
||||
|
||||
# ========================================
|
||||
sub sendgetserial {
|
||||
my ($cmd) = @_;
|
||||
my $count;
|
||||
my $saw;
|
||||
my $x;
|
||||
|
||||
$port->lookclear;
|
||||
$port->write( $cmd );
|
||||
|
||||
($count,$saw)=$port->read(84); # will read 84 chars
|
||||
$x=uc(unpack('H*',$saw)); # nach hex wandeln
|
||||
|
||||
$cmd =~ s/\n/\\n/mg;
|
||||
$cmd =~ s/\r/\\r/mg;
|
||||
|
||||
$saw =~ s/\n/\\n/mg;
|
||||
$saw =~ s/\r/\\r/mg;
|
||||
|
||||
if ( $verbose>10 ) {
|
||||
printf "+++ sendserial\n" ;
|
||||
print " CMD: $cmd \n"; # gibt den Befehl in ASCII aus
|
||||
print " COUNT: $count \n"; # gibt die Anzahl der empfangenen Daten aus
|
||||
print " HEX: $x \n"; # gibt die empfangenen Daten in Hex aus
|
||||
print " ASCII: $saw \n"; # gibt die empfangenen Daten aus
|
||||
printf "--- sendserial\n" ;
|
||||
}
|
||||
|
||||
return $saw;
|
||||
}
|
||||
# ========================================
|
||||
sub decodeVAL {
|
||||
my ($val) = @_;
|
||||
|
||||
if ( $verbose>10 ) {
|
||||
printf "+++ decodeVAL\n" ;
|
||||
print " val = ( $val ) \n" ;
|
||||
}
|
||||
|
||||
if($val =~ m/\((\d+)\)/) {
|
||||
if ( $verbose>10 ) {
|
||||
print " decoded val = $1\n";
|
||||
printf " --- decodeVAL\n" ;
|
||||
}
|
||||
return $1;
|
||||
}
|
||||
|
||||
if($val =~ m/\((\S+)\)/) {#string value for temperature
|
||||
if ( $verbose>10 ) {
|
||||
print " decoded val = $1\n";
|
||||
printf " --- decodeVAL\n" ;
|
||||
}
|
||||
return $1;
|
||||
}
|
||||
|
||||
print " val = ( $val ) \n" ;
|
||||
die "NICHTS gefunden!\n";
|
||||
print "NICHTS gefunden!\n";
|
||||
return -8888;
|
||||
}
|
||||
|
||||
|
||||
|
||||
sub decodeVal1decimal {
|
||||
my ($val) = @_;
|
||||
return $val/10;
|
||||
};
|
||||
|
||||
sub decodeVal10times {
|
||||
my ($val) = @_;
|
||||
return $val*10;
|
||||
};
|
||||
|
||||
sub decodeVal1to1 {
|
||||
my ($val) = @_;
|
||||
return $val;
|
||||
};
|
||||
|
||||
sub decodeValTime {
|
||||
#"19112703192714" => 2019-11-27 19:27:14
|
||||
my ($str) = @_;
|
||||
#print("$str \n");
|
||||
my $fmt = "%y%m%d0%w%H%M%S";
|
||||
my @time = (POSIX::strptime($str,$fmt))[0..7];
|
||||
#print("@time \n");
|
||||
return @time;
|
||||
};
|
||||
|
||||
sub decodeValTemp {
|
||||
my ($val) = @_;
|
||||
my $hex = "";
|
||||
foreach (split '',$val){
|
||||
$hex .= sprintf("%X", ord($_)-0x30);
|
||||
};
|
||||
return hex($hex);
|
||||
};
|
||||
|
||||
sub calc_bcc {
|
||||
my ($val) = @_;
|
||||
my $bcc = 0;
|
||||
foreach (split'',substr($val,1)){
|
||||
$bcc ^= ord($_);
|
||||
}
|
||||
return $bcc;
|
||||
};
|
||||
|
||||
#constants
|
||||
my $SOH = chr(0x01);
|
||||
my $STX = chr(0x02);
|
||||
my $ETX = chr(0x03);
|
||||
@ -153,8 +47,182 @@ my $STARTCHARACTER = "/";
|
||||
my $TRANSMISSIONREQUESTCOMMAND = "?";
|
||||
my $ENDCHARACTER = "!";
|
||||
|
||||
#function prototypes
|
||||
|
||||
sub generate_r1_msg{
|
||||
#serial transfer function
|
||||
sub xfer($);
|
||||
|
||||
#read 1 message data interpretation
|
||||
sub interpret_r1_msg($);
|
||||
|
||||
#scaling functions
|
||||
sub scale_div_by_10($);
|
||||
sub scale_mul_by_10($);
|
||||
sub scale_1_to_1($);
|
||||
sub scale_to_time($);
|
||||
sub scale_to_temp($);
|
||||
|
||||
#calculate message checksum
|
||||
sub calc_bcc($);
|
||||
|
||||
|
||||
#message generation functions
|
||||
sub generate_r1_msg(%);
|
||||
sub generate_p1_msg(%);
|
||||
sub generate_b0_msg();
|
||||
sub generate_programming_command_message(%);
|
||||
sub generate_ack_optionselect_msg(%);
|
||||
sub generate_request_message(%);
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
#main() starts here
|
||||
|
||||
my %drs110m_values = (
|
||||
#'<measurement>'=>[<address>,<scalingfunction>,'<unit>'],
|
||||
'Voltage' =>[ 0,\&scale_div_by_10, 'V'],
|
||||
'Current' =>[ 1,\&scale_div_by_10, 'A'],
|
||||
'Frequency' =>[ 2,\&scale_div_by_10, 'Hz'],
|
||||
'Active Power' =>[ 3, \&scale_mul_by_10, 'W'],
|
||||
'Reactive Power'=>[ 4, \&scale_mul_by_10,'VAr'],
|
||||
'Apparent Power'=>[ 5, \&scale_mul_by_10, 'VA'],
|
||||
'Active Energy' =>[10, \&scale_1_to_1, 'Wh'],
|
||||
'Time' =>[31, \&scale_to_time, ''],
|
||||
'Temperature' =>[32, \&scale_to_temp, '°C'],
|
||||
);
|
||||
#generate messages first and only once for a run
|
||||
my %msgs = ();
|
||||
while ( my ($measurement, $vals) = each(%drs110m_values) ) {
|
||||
$msgs{$measurement} = generate_r1_msg("reg"=>$drs110m_values{$measurement}[0]);
|
||||
};
|
||||
|
||||
|
||||
|
||||
#communication part starts here
|
||||
my $res;
|
||||
|
||||
$res = xfer(generate_request_message("serialnumber"=>$serialID));
|
||||
#there is an automatic sleep from the serial timeout
|
||||
if (!$res){
|
||||
#a second wakeup call is not required every time but when the device was asleep.
|
||||
$res = xfer(generate_request_message("serialnumber"=>$serialID));
|
||||
};
|
||||
|
||||
|
||||
$res = xfer(generate_ack_optionselect_msg("protocol"=>0,"mode"=>1));#note: mode 1 is programming mode, obviously privileges are needed for register access
|
||||
$res = xfer(generate_p1_msg("password"=>$password));
|
||||
|
||||
|
||||
|
||||
my $valstr;
|
||||
my $unit;
|
||||
my ($addr,$val);
|
||||
while ( my ($measurement, $vals) = each(%drs110m_values) ) {
|
||||
$res = xfer( $msgs{$measurement} );
|
||||
($addr,$val) = interpret_r1_msg($res);
|
||||
if (defined($addr)){#sanity check
|
||||
if ($addr == $drs110m_values{$measurement}[0]){#paranoia check
|
||||
$val = &{$drs110m_values{$measurement}[1]}($val);
|
||||
$unit = $drs110m_values{$measurement}[2];
|
||||
$valstr = sprintf("%15s : %s %s\n",$measurement,$val,$unit);
|
||||
print($valstr);
|
||||
}
|
||||
else{
|
||||
die("Found $addr but expected $drs110m_values{$measurement}[0]");
|
||||
}
|
||||
}
|
||||
else {
|
||||
die("No Response for $measurement");
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
#log off
|
||||
$res = xfer(generate_b0_msg());
|
||||
|
||||
|
||||
|
||||
#functions
|
||||
sub xfer($){
|
||||
my ($cmd) = @_;
|
||||
my $count;
|
||||
my $res;
|
||||
|
||||
$port->lookclear;
|
||||
$port->write( $cmd );
|
||||
|
||||
($count,$res)=$port->read(32);
|
||||
|
||||
return $res;
|
||||
}
|
||||
|
||||
sub interpret_r1_msg($){
|
||||
my ($str) = @_;
|
||||
my $val;
|
||||
my $addr;
|
||||
if($str =~ m/\((\S+)\)/) {
|
||||
$val = $1;
|
||||
if($str =~ m/(\d+)\(/) {
|
||||
$addr = $1;
|
||||
};
|
||||
};
|
||||
return $addr,$val;
|
||||
};
|
||||
|
||||
|
||||
sub scale_div_by_10($){
|
||||
my ($val) = @_;
|
||||
return $val/10;
|
||||
};
|
||||
|
||||
sub scale_mul_by_10($){
|
||||
my ($val) = @_;
|
||||
return $val*10;
|
||||
};
|
||||
|
||||
sub scale_1_to_1($){
|
||||
my ($val) = @_;
|
||||
return $val;
|
||||
};
|
||||
|
||||
sub scale_to_time($){
|
||||
#"19112703192714" => 2019-11-27 19:27:14
|
||||
my ($str) = @_;
|
||||
#print("$str \n");
|
||||
my $fmt = "%y%m%d0%w%H%M%S";
|
||||
my @time = (POSIX::strptime($str,$fmt))[0..7];
|
||||
if (wantarray){
|
||||
return @time;
|
||||
}
|
||||
else{
|
||||
return strftime("%Y-%m-%d %H:%M:%S",@time);
|
||||
};
|
||||
};
|
||||
|
||||
sub scale_to_temp($){
|
||||
my ($val) = @_;
|
||||
my $hex = "";
|
||||
foreach (split '',$val){
|
||||
$hex .= sprintf("%X", ord($_)-0x30);
|
||||
};
|
||||
return hex($hex);
|
||||
};
|
||||
|
||||
sub calc_bcc($){
|
||||
my ($val) = @_;
|
||||
my $bcc = 0;
|
||||
foreach (split'',substr($val,1)){
|
||||
$bcc ^= ord($_);
|
||||
}
|
||||
return $bcc;
|
||||
};
|
||||
|
||||
sub generate_r1_msg(%){
|
||||
my %args = @_;
|
||||
my $reg = $args{reg};
|
||||
my $regstr = sprintf("%08d()",$reg);
|
||||
@ -163,7 +231,7 @@ sub generate_r1_msg{
|
||||
};
|
||||
|
||||
|
||||
sub generate_p1_msg{
|
||||
sub generate_p1_msg(%){
|
||||
my %args = @_;
|
||||
my $passwd = $args{password};
|
||||
my $passwdstr = sprintf("(%08d)",$passwd);
|
||||
@ -171,12 +239,12 @@ sub generate_p1_msg{
|
||||
return $msg;
|
||||
};
|
||||
|
||||
sub generate_b0_msg{
|
||||
sub generate_b0_msg(){
|
||||
my $msg=generate_programming_command_message("command"=>"B","commandtype"=>0,"data"=>"");
|
||||
return $msg;
|
||||
};
|
||||
|
||||
sub generate_programming_command_message{
|
||||
sub generate_programming_command_message(%){
|
||||
my %args = @_;
|
||||
my $command = $args{command};
|
||||
my $commandtype = $args{commandtype};
|
||||
@ -187,7 +255,7 @@ sub generate_programming_command_message{
|
||||
return $msg;
|
||||
};
|
||||
|
||||
sub generate_ack_optionselect_msg{
|
||||
sub generate_ack_optionselect_msg(%){
|
||||
my %args = @_;
|
||||
my $protocol = $args{protocol};
|
||||
my $mode = $args{mode};
|
||||
@ -197,7 +265,7 @@ sub generate_ack_optionselect_msg{
|
||||
};
|
||||
|
||||
|
||||
sub generate_request_message{
|
||||
sub generate_request_message(%){
|
||||
my %args = @_;
|
||||
my $serialnumber = $args{serialnumber};
|
||||
my $snstr = sprintf("%012d",$serialnumber);
|
||||
@ -205,56 +273,5 @@ sub generate_request_message{
|
||||
return $msg;
|
||||
};
|
||||
|
||||
# ========================================
|
||||
|
||||
#main() starts here
|
||||
|
||||
#my $cmd;
|
||||
my $res;
|
||||
#my %vals = ();
|
||||
|
||||
$res = sendgetserial(generate_request_message("serialnumber"=>$serialID));
|
||||
#there is an automatic sleep from the serial timeout
|
||||
if (!$res){
|
||||
#a second wakeup call is not required every time but when the device was asleep.
|
||||
$res = sendgetserial(generate_request_message("serialnumber"=>$serialID));
|
||||
};
|
||||
|
||||
|
||||
$res = sendgetserial(generate_ack_optionselect_msg("protocol"=>0,"mode"=>1));#note: mode 1 is programming mode, obvious privileges are needed for register access
|
||||
$res = sendgetserial(generate_p1_msg("password"=>$password));
|
||||
|
||||
|
||||
my %drs110m_values = (
|
||||
#'<measurement>'=>[<address>,<scalingfunction>,'<unit>'],
|
||||
'Voltage' =>[ 0,\&decodeVal1decimal, 'V'],
|
||||
'Current' =>[ 1,\&decodeVal1decimal, 'A'],
|
||||
'Frequency' =>[ 2,\&decodeVal1decimal, 'Hz'],
|
||||
'Active Power' =>[ 3, \&decodeVal10times, 'W'],
|
||||
'Reactive Power'=>[ 4, \&decodeVal10times,'VAr'],
|
||||
'Apparent Power'=>[ 5, \&decodeVal10times, 'VA'],
|
||||
'Active Energy' =>[10, \&decodeVal1to1, 'Wh'],
|
||||
'Time' =>[31, \&decodeValTime, ''],
|
||||
'Temperature' =>[32, \&decodeValTemp, '°C'],
|
||||
);
|
||||
|
||||
my $val;
|
||||
my $valstr;
|
||||
my $unit;
|
||||
while ( my ($measurement, $vals) = each(%drs110m_values) ) {
|
||||
$res = sendgetserial( generate_r1_msg("reg"=>$drs110m_values{$measurement}[0]) );
|
||||
if ($measurement eq 'Time'){
|
||||
$val = strftime("%Y-%m-%d %H:%M:%S",&{$drs110m_values{$measurement}[1]}(decodeVAL($res)));
|
||||
}
|
||||
else{
|
||||
$val = &{$drs110m_values{$measurement}[1]}(decodeVAL($res));
|
||||
};
|
||||
|
||||
$unit = $drs110m_values{$measurement}[2];
|
||||
$valstr = sprintf("%15s : %s %s\n",$measurement,$val,$unit);
|
||||
print($valstr);
|
||||
};
|
||||
|
||||
$res = sendgetserial(generate_b0_msg());
|
||||
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user