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

Compare commits

merge into: marko:main
Branches Tags
marko:main
marko:dev
...
pull from: marko:dev
Branches Tags
marko:dev
marko:main

7 Commits
main ... dev

Author SHA1 Message Date
Marko Oldenburg
ecae350c46 Subject line (try to keep under 50 characters) 
Multi-line description of commit,
feel free to be detailed.

[Ticket: X]
 2022-02-01 17:06:07 +01:00
Marko Oldenburg
a3d04bd254 fix 2022-01-18 19:13:00 +01:00
Marko Oldenburg
1179c54af9 add call exit 2022-01-18 19:09:45 +01:00
Marko Oldenburg
c94340f92e Merge branch 'main' into dev 
style code
 2022-01-18 18:54:11 +01:00
Marko Oldenburg
b0c354a0a8 Merge branch 'main' into dev 2022-01-18 18:15:07 +01:00
Marko Oldenburg
7de6cb98ab remove .gitignore 2022-01-15 20:55:48 +01:00
Marko Oldenburg
8e78ccf8b5 read from file, push to fhem 
add read sensor ids from file
add sensor data to fhem

you must create dummys in fhem in form of Meter_<SENSORID>
to run the script install perlmodul Tiny.pm
for debian apt install libtry-tiny-perl
 2022-01-03 12:20:18 +01:00
4 changed files with 476 additions and 338 deletions
Show Stats Expand all files Collapse all files

316
iec1107.pm
View File

@ -1,316 +0,0 @@
#!/usr/bin/perl
#
# perl module for accessing a IEC1107 device
# This is my first my perl module and these resources were a good kickstart
# https://learn.perl.org/books/beginning-perl/
# https://wiki.volkszaehler.org/hardware/channels/meters/power/eastron_drs155m
# Menschel (C) 2020-2021
package iec1107; # we name our package iec1107 as this is the original protocol name
use strict;
use warnings;
use Carp;
use Device::SerialPort;
#for time conversion
use DateTime::Format::Strptime qw( strptime );
use DateTime;
#constants
our $SOH = chr(0x01);
our $STX = chr(0x02);
our $ETX = chr(0x03);
our $EOT = chr(0x04);
our $ACK = chr(0x06);
our $NACK = chr(0x15);
our $CRLF = "\r\n";
our $STARTCHARACTER = "/";
our $TRANSMISSIONREQUESTCOMMAND = "?";
our $ENDCHARACTER = "!";
our %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_raw_time_to_datetime, ''],
'Temperature' =>[32, \&_scale_to_temp, '°C'],
);
#actually there are more registers, but who cares about cosphi for example?!
sub new(\$$$){
#we expect a HASH consisting of a reference to a valid and correctly set up port, an ID and a password
# {"port"=>$port, #perl automatically converts this to a reference
# "id"=>$id,
# "passwd"=>$passwd,
#}
my $class = shift;
my $self = {@_};
bless($self,$class);
$self->_init;
return $self;
};
sub _init {
my $self = shift;
$self->{"regs"} = ();
return;
};
sub start_communication {
my $self = shift;
unless (ref $self){croak "call with an object, not a class";}
my $res;
$res = $self->_xfer(_generate_request_message("serialnumber"=>$self->id));
#Note: There is an automatic sleep from the serial timeout, so we don't sleep here
if (!$res){
#a second wakeup call is not required every time, only when the device was asleep.
$res = $self->_xfer(_generate_request_message("serialnumber"=>$self->id));
};
return $self;
};
sub start_programming_mode {
my $self = shift;
unless (ref $self){croak "call with an object, not a class";}
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_p1_msg("password"=>$self->passwd));
return $self;
};
sub update_values {
my $self = shift;
unless (ref $self){croak "call with an object, not a class";}
my $res;
my $valstr;
my $unit;
my ($addr,$val);
while ( my ($measurement, $vals) = each(%drs110m_values) ) {
$res = $self->_xfer(_generate_r1_msg("reg"=>$drs110m_values{$measurement}[0]));
($addr,$val) = _interpret_r1_msg($res);
if (defined($addr)){
if ($addr == $drs110m_values{$measurement}[0]){
$val = &{$drs110m_values{$measurement}[1]}($val);
$unit = $drs110m_values{$measurement}[2];
$valstr = sprintf("%s %s",$val,$unit);
$self->{regs}{$measurement}=$valstr;
}
else{
die("Found $addr but expected $drs110m_values{$measurement}[0]");
};
}
else {
die("No Response for $measurement");
};
}
return $self;
};
sub log_off() {
my $self = shift;
my $res;
unless (ref $self){croak "call with an object, not a class";}
$res = $self->_xfer(_generate_b0_msg());
return $self;
};
sub write_reg($$) {
my $self = shift;
my ($reg, $val) = @_;
unless (ref $self){croak "call with an object, not a class";}
my $res = $self->_xfer(_generate_w1_msg("reg"=>$reg, "val"=>$val));
if ($res ne $ACK) {
print("No Ack for write operation $reg : $val \n");
};
return $self;
};
sub get_values() {
my $self = shift;
my $res;
unless (ref $self){croak "call with an object, not a class";}
$self->start_communication()->start_programming_mode()->update_values()->log_off();
return $self->regs;
};
sub set_clock() {
my $self = shift;
my $res;
unless (ref $self){croak "call with an object, not a class";}
$self->start_communication()->start_programming_mode();
$res = $self->write_reg(31, _scale_datetime_to_raw_time(DateTime->now()));
# this function reliably returns an ACK
$self->log_off();
return $self;
};
sub reset_energy() {
my $self = shift;
my $res;
unless (ref $self){croak "call with an object, not a class";}
$self->start_communication()->start_programming_mode();
$res = $self->write_reg(0x40, "00000000");
# this function does not reliably return an ACK, to be checked
$self->log_off();
return $self;
};
sub _xfer {
my $self = shift;
my ($cmd) = @_;
my $count;
my $res;
$self->port->lookclear;
$self->port->write( $cmd );
($count,$res)=$self->port->read(32);
return $res;
};
# Object accessor methods
sub port { $_[0]->{port}=$_[1] if defined $_[1]; $_[0]->{port} }
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
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_raw_time_to_datetime($){
my ($str) = @_;
my $fmt = "%y%m%d%w%H%M%S";
my $dt = strptime($fmt, $str);
return $dt;
};
sub _scale_datetime_to_raw_time($){
my ($dt) = @_;
my $fmt = "%y%m%d0%w%H%M%S";
my $str = $dt->strftime($fmt);
return $str;
};
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);
my $msg=_generate_programming_command_message("command"=>"R","commandtype"=>1,"data"=>$regstr);
return $msg;
};
sub _generate_w1_msg(%){
my %args = @_;
my $reg = $args{reg};
my $val = $args{val};
my $regstr = sprintf("%08d(%d)",$reg,$val);
my $msg=_generate_programming_command_message("command"=>"W","commandtype"=>1,"data"=>$regstr);
return $msg;
};
sub _generate_p1_msg(%){
my %args = @_;
my $passwd = $args{password};
my $passwdstr = sprintf("(%08d)",$passwd);
my $msg=_generate_programming_command_message("command"=>"P","commandtype"=>1,"data"=>$passwdstr);
return $msg;
};
sub _generate_b0_msg(){
my $msg=_generate_programming_command_message("command"=>"B","commandtype"=>0,"data"=>"");
return $msg;
};
sub _generate_programming_command_message(%){
my %args = @_;
my $command = $args{command};
my $commandtype = $args{commandtype};
my $data = $args{data};
my $cmdstr = sprintf("%s%d",$command,$commandtype);
my $msg=$SOH.$cmdstr.$STX.$data.$ETX;
$msg .= chr(_calc_bcc($msg));
return $msg;
};
sub _generate_ack_optionselect_msg(%){
my %args = @_;
my $protocol = $args{protocol};
my $mode = $args{mode};
my $msgstr = sprintf("%d:%d",$protocol,$mode);#the ':' is the baudrate identifier
my $msg=$ACK.$msgstr.$CRLF;
return $msg;
};
sub _generate_request_message(%){
my %args = @_;
my $serialnumber = $args{serialnumber};
my $snstr = sprintf("%012d",$serialnumber);
my $msg = $STARTCHARACTER.$TRANSMISSIONREQUESTCOMMAND.$snstr.$ENDCHARACTER.$CRLF;
return $msg;
};
1;

417
lib/iec1107.pm Executable file
View File

@ -0,0 +1,417 @@
#!/usr/bin/perl
#
# perl module for accessing a IEC1107 device
# This is my first my perl module and these resources were a good kickstart
# https://learn.perl.org/books/beginning-perl/
# https://wiki.volkszaehler.org/hardware/channels/meters/power/eastron_drs155m
# Menschel (C) 2020-2021
package iec1107
; # we name our package iec1107 as this is the original protocol name
use strict;
use warnings;
use Carp;
use Device::SerialPort;
#for time conversion
use DateTime::Format::Strptime qw( strptime );
use DateTime;
#constants
our $SOH = chr(0x01);
our $STX = chr(0x02);
our $ETX = chr(0x03);
our $EOT = chr(0x04);
our $ACK = chr(0x06);
our $NACK = chr(0x15);
our $CRLF = "\r\n";
our $STARTCHARACTER = "/";
our $TRANSMISSIONREQUESTCOMMAND = "?";
our $ENDCHARACTER = "!";
our %drs110m_values = ( ## no critic (Package variable declared or used)
#'<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_raw_time_to_datetime, '' ],
'Temperature' => [ 32, \&_scale_to_temp, '°C' ],
);
## use critic
#actually there are more registers, but who cares about cosphi for example?!
=head1 METHODS
=head2 Constructor new
# we expect a HASH consisting of a reference to a valid and correctly set up port, an ID and a password
# {"port"=>$port, #perl automatically converts this to a reference
# "id"=>$id,
# "passwd"=>$passwd,
# }
=cut
sub new { ## no critic (always unpack @_ first)
my $class = shift;
my @options = @_ ? $_[0] =~ /ARRAY/ ? @{ $_[0] } : @_ : ();
my $self = bless {@options} => $class;
$self->_init;
return $self;
}
sub _init {
my $self = shift;
$self->{"regs"} = ();
return;
}
sub start_communication {
my $self = shift;
unless ( ref $self ) { croak "call with an object, not a class"; }
my $res;
$res =
$self->_xfer( _generate_request_message( "serialnumber" => $self->id ) );
#Note: There is an automatic sleep from the serial timeout, so we don't sleep here
if ( !$res ) {
#a second wakeup call is not required every time, only when the device was asleep.
$res = $self->_xfer(
_generate_request_message( "serialnumber" => $self->id ) );
}
return $self;
}
sub start_programming_mode {
my $self = shift;
unless ( ref $self ) { croak "call with an object, not a class"; }
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_p1_msg( "password" => $self->passwd ) );
return $self;
}
sub update_values {
my $self = shift;
unless ( ref $self ) { croak "call with an object, not a class"; }
my $res;
my $valstr;
my $unit;
my ( $addr, $val );
while ( my ( $measurement, $vals ) = each(%drs110m_values) ) {
$res = $self->_xfer(
_generate_r1_msg( "reg" => $drs110m_values{$measurement}[0] ) );
( $addr, $val ) = _interpret_r1_msg($res);
if ( defined($addr) ) {
if ( $addr == $drs110m_values{$measurement}[0] ) {
$val = &{ $drs110m_values{$measurement}[1] }($val);
$unit = $drs110m_values{$measurement}[2];
$valstr = sprintf( "%s %s", $val, $unit );
$self->{regs}{$measurement} = $valstr;
}
else {
## no critic (warn used instead of carp)
warn(
"Found $addr but expected $drs110m_values{$measurement}[0]"
);
}
}
else {
## no critic (warn used instead of carp)
warn("No Response for $measurement");
}
}
return $self;
}
sub log_off {
my $self = shift;
unless ( ref $self ) { croak "call with an object, not a class"; }
my $res;
$res = $self->_xfer( _generate_b0_msg() );
return $self;
}
sub write_reg { ## no critic (always unpack @_ first)
my $self = shift;
unless ( ref $self ) { croak "call with an object, not a class"; }
my ( $reg, $val ) = @_;
my $res = $self->_xfer( _generate_w1_msg( "reg" => $reg, "val" => $val ) );
if ( $res ne $ACK ) {
print("No Ack for write operation $reg : $val \n");
}
return $self;
}
sub get_values {
my $self = shift;
unless ( ref $self ) { croak "call with an object, not a class"; }
$self->start_communication()->start_programming_mode()->update_values()
->log_off();
return $self->regs;
}
sub set_clock {
my $self = shift;
unless ( ref $self ) { croak "call with an object, not a class"; }
$self->start_communication()->start_programming_mode();
my $res;
$res =
$self->write_reg( 31, _scale_datetime_to_raw_time( DateTime->now() ) );
# this function reliably returns an ACK
$self->log_off();
return $self;
}
sub reset_energy {
my $self = shift;
unless ( ref $self ) { croak "call with an object, not a class"; }
$self->start_communication()->start_programming_mode();
my $res;
$res = $self->write_reg( 0x40, "00000000" );
# this function does not reliably return an ACK, to be checked
$self->log_off();
return $self;
}
sub _xfer { ## no critic (always unpack @_ first)
my $self = shift;
my $cmd = @_;
my $count;
my $res;
$self->port->lookclear;
$self->port->write($cmd);
( $count, $res ) = $self->port->read(32);
return $res;
}
# Object accessor methods
## no critic (no return in subs)
sub port { $_[0]->{port} = $_[1] if defined $_[1]; $_[0]->{port} }
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} }
## use critic
#basic non-object functions
sub _interpret_r1_msg {
my $str = shift;
my $val;
my $addr;
if ( $str =~ m/\((\S+)\)/x ) {
$val = $1;
if ( $str =~ m/(\d+)\(/x ) {
$addr = $1;
}
}
return $addr, $val;
}
sub _scale_div_by_10 {
my $val = shift;
return $val / 10;
}
sub _scale_mul_by_10 {
my $val = shift;
return $val * 10;
}
sub _scale_1_to_1 {
my $val = shift;
return $val;
}
sub _scale_raw_time_to_datetime {
my $str = shift;
my $fmt = "%y%m%d%w%H%M%S";
my $dt = strptime( $fmt, $str );
return $dt;
}
sub _scale_datetime_to_raw_time {
my $dt = shift;
my $fmt = "%y%m%d0%w%H%M%S";
my $str = $dt->strftime($fmt);
return $str;
}
sub _scale_to_temp {
my $val = shift;
my $hex = "";
foreach ( split '', $val ) {
$hex .= sprintf( "%X", ord($_) - 0x30 );
}
return hex($hex);
}
sub _calc_bcc {
my $val = shift;
my $bcc = 0;
foreach ( split '', substr( $val, 1 ) ) {
$bcc ^= ord($_);
}
return $bcc;
}
sub _generate_r1_msg {
my %args = shift;
my $reg = $args{reg};
my $regstr = sprintf( "%08d()", $reg );
my $msg = _generate_programming_command_message(
"command" => "R",
"commandtype" => 1,
"data" => $regstr
);
return $msg;
}
sub _generate_w1_msg {
my %args = shift;
my $reg = $args{reg};
my $val = $args{val};
my $regstr = sprintf( "%08d(%d)", $reg, $val );
my $msg = _generate_programming_command_message(
"command" => "W",
"commandtype" => 1,
"data" => $regstr
);
return $msg;
}
sub _generate_p1_msg {
my %args = shift;
my $passwd = $args{password};
my $passwdstr = sprintf( "(%08d)", $passwd );
my $msg = _generate_programming_command_message(
"command" => "P",
"commandtype" => 1,
"data" => $passwdstr
);
return $msg;
}
sub _generate_b0_msg {
my $msg = _generate_programming_command_message(
"command" => "B",
"commandtype" => 0,
"data" => ""
);
return $msg;
}
sub _generate_programming_command_message {
my %args = shift;
my $command = $args{command};
my $commandtype = $args{commandtype};
my $data = $args{data};
my $cmdstr = sprintf( "%s%d", $command, $commandtype );
my $msg = $SOH . $cmdstr . $STX . $data . $ETX;
$msg .= chr( _calc_bcc($msg) );
return $msg;
}
sub _generate_ack_optionselect_msg {
my %args = shift;
my $protocol = $args{protocol};
my $mode = $args{mode};
my $msgstr =
sprintf( "%d:%d", $protocol, $mode ); #the ':' is the baudrate identifier
my $msg = $ACK . $msgstr . $CRLF;
return $msg;
}
sub _generate_request_message {
my %args = shift;
my $serialnumber = $args{serialnumber};
my $snstr = sprintf( "%012d", $serialnumber );
my $msg =
$STARTCHARACTER
. $TRANSMISSIONREQUESTCOMMAND
. $snstr
. $ENDCHARACTER
. $CRLF;
return $msg;
}
1;

12
sensors/id.list Normal file
View File

@ -0,0 +1,12 @@
1613300191
1613300192
1613300193
1613300194
1613300195
1613300196
1613300197
1613300198
1613300199
1613300200
1613300026
1613300028

57
test_drs110m.pl Normal file → Executable file
View File

@ -1,16 +1,23 @@
#!/usr/bin/perl
#
package main;
use strict;
use warnings;
sub BEGIN {
push @INC, ".";
}
use Path::Tiny;
use IO::Socket::INET;
BEGIN {
push @INC, "./lib";
}
use iec1107;
my $port = Device::SerialPort->new("/dev/ttyUSB0") || die $!;
my $port = Device::SerialPort->new(
"/dev/serial/by-id/usb-FTDI_FT232R_USB_UART_AK072UA9-if00-port0")
or die "$! \n";
$port->baudrate(9600);
$port->databits(7);
$port->parity("even");
@ -20,31 +27,49 @@ $port->write_settings;
$port->purge_all();
$port->read_char_time(0);
$port->read_const_time(150);#was 100ms previously, this lead to race conditions
$port->read_const_time(150); #was 100ms previously, this lead to race conditions
my $dir = path("$workdir/sensors"); # Config Directory there find the id-file
my $file = $dir->child("id.list");
# Read in the entire contents of a file
my $content = $file->slurp();
# openr() returns an IO::File object to read from
my $file_handle = $file->openr();
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 does not work with more than one device on the same bus, it results in garbage!
my $passwd = "00000000"; # Standard password 0 over 8-digits
my $fhemDummy = 'Meter_';
my $HOSTNAME = "localhost";
my $HOSTPORT = "7072";
my $socket = IO::Socket::INET->new(
'PeerAddr' => $HOSTNAME,
'PeerPort' => $HOSTPORT,
'Proto' => 'tcp'
) or die "Cant\'t connect to FHEM Instance \n";
for my $id (@ids) {
my $drs110m = iec1107->new("port"=>$port,"id"=>$id,"passwd"=>$passwd);
print("Meter: $id\n");
while ( my $id = $file_handle->getline() ) {
chomp $id;
my $drs110m =
iec1107->new( "port" => $port, "id" => $id, "passwd" => $passwd );
$drs110m->set_clock();
my $values = $drs110m->get_values();
while ( my ($reg, $val) = each(%{$values})){#Note: this type switching in perl is crazy!
print("$reg : $val\n");
};
print("log off from $id\n");
next if ( ref($values) ne 'HASH' );
while ( my ( $reg, $val ) = each( %{$values} ) ) {
$socket->print(
'setreading ' . $fhemDummy . $id . ' ' . $reg . ' ' . $val . "\n" );
}
}
$socket->close;
exit;