marko/drs110m
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

added data retrieval and some sanity checks

Browse Source
This commit is contained in:
Patrick Menschel
2020-01-10 09:33:12 +01:00
parent 748ce2abda
commit ec26a52ba5
3 changed files with 60 additions and 85 deletions
Download Patch File Download Diff File Expand all files Collapse all files

40
README.md
View File

@@ -5,31 +5,31 @@ Use and Copy as you wish. Maybe this module will mature enough to be uploaded to
# What works and what not # What works and what not
The module iec1107 can be used with a pre-defined serial port, a device serial number and a device password. The module iec1107 can be used with a pre-defined serial port, a device serial number and a device password.
The basic functions have been tested. There is work to do with sanity checks and data retrieval. The basic functions have been tested.
Currently the module just prints out what it reads from the meter, basically for debug purposes.
# Output example: # Output example:
``` ```
$ perl test_drs110m.pl $ perl test_drs110m.pl
Meter: 1613300152 Meter: 1613300152
Active Energy : 00000023 Wh Voltage : 229.4 V
Current : 0 A Active Power : 0 W
Reactive Power : 0 VAr Temperature : 23 °C
Frequency : 49.9 Hz Reactive Power : 0 VAr
Voltage : 228.6 V Frequency : 50 Hz
Active Power : 0 W Active Energy : 00000023 Wh
Apparent Power : 0 VA Apparent Power : 0 VA
Time : 2020-01-09 14:22:09 Time : 2020-01-10 09:26:16
Temperature : 32 °C Current : 0 A
Meter: 1613300153 Meter: 1613300153
Active Energy : 00000034 Wh Voltage : 229.4 V
Current : 0 A Active Power : 0 W
Reactive Power : 0 VAr Reactive Power : 0 VAr
Frequency : 49.9 Hz Temperature : 23 °C
Voltage : 228.8 V Frequency : 50 Hz
Active Power : 0 W Active Energy : 00000034 Wh
Apparent Power : 0 VA Apparent Power : 0 VA
Time : 2020-01-09 14:21:37 Time : 2020-01-10 09:25:44
Temperature : 31 °C Current : 0 A
``` ```

86
iec1107.pm
View File

@@ -12,7 +12,7 @@ package iec1107; # we name our package iec1107 as this is the original protocol
use strict; use strict;
use warnings; use warnings;
use Carp; #TODO: this is for the "ref" check use Carp;
use Device::SerialPort; use Device::SerialPort;
@@ -34,38 +34,7 @@ our $STARTCHARACTER = "/";
our $TRANSMISSIONREQUESTCOMMAND = "?"; our $TRANSMISSIONREQUESTCOMMAND = "?";
our $ENDCHARACTER = "!"; our $ENDCHARACTER = "!";
#function prototypes our %drs110m_values = (
#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(%);
my %drs110m_values = (
#'<measurement>'=>[<address>,<scalingfunction>,'<unit>'], #'<measurement>'=>[<address>,<scalingfunction>,'<unit>'],
'Voltage' =>[ 0,\&_scale_div_by_10, 'V'], 'Voltage' =>[ 0,\&_scale_div_by_10, 'V'],
'Current' =>[ 1,\&_scale_div_by_10, 'A'], 'Current' =>[ 1,\&_scale_div_by_10, 'A'],
@@ -81,13 +50,13 @@ my %drs110m_values = (
sub new(\$$$){ sub new(\$$$){
#we expect a HASH consisting of a reference to a valid port, an ID and a password #we expect a HASH consisting of a reference to a valid port, an ID and a password
# {"port"=>\$port, # {"port"=>$port, #perl automatically converts this to a reference
# "serialID"=>$id, # "id"=>$id,
# "passwd"=>$passwd, # "passwd"=>$passwd,
#} #}
my $class = shift; my $class = shift;
my $self = {@_};#creates reference to HASH my $self = {@_};
bless($self,$class);#changes class of $object to "drs110m" bless($self,$class);
$self->_init; $self->_init;
return $self; return $self;
}; };
@@ -95,34 +64,37 @@ sub new(\$$$){
sub _init { sub _init {
my $self = shift; my $self = shift;
#we expect $self->port to be setup correctly so nothing to do here #we expect $self->port to be setup correctly so nothing to do here
$self->{"regs"} = ();
#for whatever reason _init() does not return anything in the LEARN PERL Examples #for whatever reason _init() does not return anything in the LEARN PERL Examples
return; return;
}; };
sub start_communication { sub start_communication {
my $self = shift; my $self = shift;
unless (ref $self){croak "call with an object, not a class";}
my $res; my $res;
$res = $self->_xfer(_generate_request_message("serialnumber"=>$self->{serialID})); $res = $self->_xfer(_generate_request_message("serialnumber"=>$self->id));
#there is an automatic sleep from the serial timeout #there is an automatic sleep from the serial timeout
if (!$res){ if (!$res){
#a second wakeup call is not required every time but when the device was asleep. #a second wakeup call is not required every time but when the device was asleep.
$res = $self->_xfer(_generate_request_message("serialnumber"=>$self->{serialID})); $res = $self->_xfer(_generate_request_message("serialnumber"=>$self->id));
}; };
return $self; #utility functions should return self according to LEARN PERL examples return $self; #utility functions should return self according to LEARN PERL examples
}; };
sub start_programming_mode { sub start_programming_mode {
my $self = shift; my $self = shift;
unless (ref $self){croak "call with an object, not a class";}
my $res; my $res;
$res = $self->_xfer(_generate_ack_optionselect_msg("protocol"=>0,"mode"=>1));#note: mode 1 is programming mode, obviously privileges are needed for register access $res = $self->_xfer(_generate_ack_optionselect_msg("protocol"=>0,"mode"=>1));#note: mode 1 is programming mode, obviously privileges are needed for register access
$res = $self->_xfer(_generate_p1_msg("password"=>$self->{passwd})); $res = $self->_xfer(_generate_p1_msg("password"=>$self->passwd));
return $self; #utility functions should return self according to LEARN PERL examples return $self; #utility functions should return self according to LEARN PERL examples
}; };
sub update_values { sub update_values {
my $self = shift; my $self = shift;
unless (ref $self){croak "call with an object, not a class";}
my $res; my $res;
my $valstr; my $valstr;
my $unit; my $unit;
@@ -134,8 +106,9 @@ sub update_values {
if ($addr == $drs110m_values{$measurement}[0]){#paranoia check if ($addr == $drs110m_values{$measurement}[0]){#paranoia check
$val = &{$drs110m_values{$measurement}[1]}($val); $val = &{$drs110m_values{$measurement}[1]}($val);
$unit = $drs110m_values{$measurement}[2]; $unit = $drs110m_values{$measurement}[2];
$valstr = sprintf("%15s : %s %s\n",$measurement,$val,$unit); $valstr = sprintf("%s %s",$val,$unit);
print($valstr); #print($valstr);
$self->{regs}{$measurement}=$valstr;
} }
else{ else{
die("Found $addr but expected $drs110m_values{$measurement}[0]"); die("Found $addr but expected $drs110m_values{$measurement}[0]");
@@ -152,6 +125,7 @@ sub update_values {
sub log_off() { sub log_off() {
my $self = shift; my $self = shift;
my $res; my $res;
unless (ref $self){croak "call with an object, not a class";}
$res = $self->_xfer(_generate_b0_msg()); $res = $self->_xfer(_generate_b0_msg());
return $self; return $self;
}; };
@@ -161,33 +135,25 @@ sub _xfer {
my ($cmd) = @_; my ($cmd) = @_;
my $count; my $count;
my $res; my $res;
$self->{port}->lookclear; $self->port->lookclear;
$self->{port}->write( $cmd ); $self->port->write( $cmd );
($count,$res)=$self->{port}->read(32); ($count,$res)=$self->port->read(32);
return $res; return $res;
} }
#TODO: we have to include this obj class check with "ref" later
#sub do_something() {
# my $self = shift;
# unless (ref $self){"croak Should call surname() with an object, not a class";}
# return $self->{surname}
#}
#TODO: we need object accessor methodes later
# Object accessor methods # Object accessor methods
# interesting function that writes if there is an input, apparently sub port { $_[0]->{port}=$_[1] if defined $_[1]; $_[0]->{port} }
#sub address { $_[0]->{address }=$_[1] if defined $_[1]; $_[0]->{address } } sub id { $_[0]->{id}=$_[1] if defined $_[1]; $_[0]->{id} }
sub passwd { $_[0]->{passwd}=$_[1] if defined $_[1]; $_[0]->{passwd} }
sub regs { $_[0]->{regs}=$_[1] if defined $_[1]; $_[0]->{regs} }
#basic non-object functions
#basic functions
sub _interpret_r1_msg($){ sub _interpret_r1_msg($){
my ($str) = @_; my ($str) = @_;
@@ -288,7 +254,7 @@ sub _generate_ack_optionselect_msg(%){
my $protocol = $args{protocol}; my $protocol = $args{protocol};
my $mode = $args{mode}; my $mode = $args{mode};
my $msgstr = sprintf("%d:%d",$protocol,$mode);#the ':' is the baudrate identifier my $msgstr = sprintf("%d:%d",$protocol,$mode);#the ':' is the baudrate identifier
my $msg=$ACK.$msgstr.$CRLF;#Todo: make the special characters nicely, note there is no bcc for this msg type my $msg=$ACK.$msgstr.$CRLF;
return $msg; return $msg;
}; };

19
test_drs110m.pl
View File

@@ -22,22 +22,31 @@ $port->purge_all();
$port->read_char_time(0); # don't wait for each character $port->read_char_time(0); # don't wait for each character
$port->read_const_time(150); # 100 millisecond per unfulfilled "read" call - this was too short and lead into race conditions $port->read_const_time(150); # 100 millisecond per unfulfilled "read" call - this was too short and lead into race conditions
my @serialIDs = (1613300152,1613300153); my @ids = (1613300152,1613300153);
# It is possible to find out the device id of a single device on RS-485 9600@7E1 by sending "/?!\r\n" # 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 $passwd = "00000000"; # Standard password 0 over 8-digits
for my $serialID (@serialIDs) { for my $id (@ids) {
my $drs110m = iec1107->new("port"=>$port,"serialID"=>$serialID,"passwd"=>$password); my $drs110m = iec1107->new("port"=>$port,"id"=>$id,"passwd"=>$passwd);
#print("start communication to $serialID\n"); #print("start communication to $serialID\n");
print("Meter: $serialID\n"); print("Meter: $id\n");
$drs110m->start_communication(); $drs110m->start_communication();
#print("start programming mode\n"); #print("start programming mode\n");
$drs110m->start_programming_mode(); $drs110m->start_programming_mode();
#print("update values\n"); #print("update values\n");
$drs110m->update_values(); $drs110m->update_values();
# print($drs110m->regs);
# my $key,$val;
# for $key,$val ($drs110m->regs){
# print("$key : $value\n");
# }
while ( my ($reg, $val) = each(%{$drs110m->regs})){#Note: this type switching in perl is crazy!
print("$reg : $val\n");
};
#print("log off from $serialID\n"); #print("log off from $serialID\n");
$drs110m->log_off(); $drs110m->log_off();
} }