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
This commit is contained in:
Marko Oldenburg
parent
cc3e69d385
commit
8e78ccf8b5
344
lib/iec1107.pm
Executable file
344
lib/iec1107.pm
Executable file
@ -0,0 +1,344 @@
|
||||
#!/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 {
|
||||
warn("Found $addr but expected $drs110m_values{$measurement}[0]"
|
||||
);
|
||||
}
|
||||
}
|
||||
else {
|
||||
warn("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;
|
||||
12
sensors/id.list
Normal file
12
sensors/id.list
Normal file
@ -0,0 +1,12 @@
|
||||
1613300191
|
||||
1613300192
|
||||
1613300193
|
||||
1613300194
|
||||
1613300195
|
||||
1613300196
|
||||
1613300197
|
||||
1613300198
|
||||
1613300199
|
||||
1613300200
|
||||
1613300026
|
||||
1613300028
|
||||
78
test_drs110m.pl
Normal file → Executable file
78
test_drs110m.pl
Normal file → Executable file
@ -1,50 +1,80 @@
|
||||
#!/usr/bin/perl
|
||||
#
|
||||
#
|
||||
package main;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
sub BEGIN {
|
||||
push @INC, ".";
|
||||
}
|
||||
use Path::Tiny;
|
||||
use Cwd qw(getcwd);
|
||||
use IO::Socket::INET;
|
||||
|
||||
my $workdir = getcwd;
|
||||
|
||||
use iec1107;
|
||||
push @INC, "$workdir/lib";
|
||||
|
||||
# sub BEGIN {
|
||||
# push @INC, "$workdir/lib";
|
||||
|
||||
# return;
|
||||
# }
|
||||
|
||||
require iec1107;
|
||||
|
||||
my $port = Device::SerialPort->new(
|
||||
"/dev/serial/by-id/usb-FTDI_FT232R_USB_UART_AK072UA9-if00-port0")
|
||||
or die "$! \n";
|
||||
|
||||
my $port = Device::SerialPort->new("/dev/ttyUSB0") || die $!;
|
||||
$port->baudrate(9600);
|
||||
$port->databits(7);
|
||||
$port->parity("even");
|
||||
$port->stopbits(1);
|
||||
$port->handshake("none");
|
||||
$port->write_settings;
|
||||
|
||||
|
||||
$port->purge_all();
|
||||
$port->read_char_time(0);
|
||||
$port->read_const_time(150);#was 100ms previously, this lead to race conditions
|
||||
|
||||
my @ids = (1613300152,1613300153);
|
||||
$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();
|
||||
|
||||
# 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 $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);
|
||||
while ( my $id = $file_handle->getline() ) {
|
||||
chomp $id;
|
||||
my $drs110m =
|
||||
iec1107->new( "port" => $port, "id" => $id, "passwd" => $passwd );
|
||||
|
||||
print("Meter: $id\n");
|
||||
$drs110m->set_clock();
|
||||
|
||||
$drs110m->set_clock();
|
||||
my $values = $drs110m->get_values();
|
||||
|
||||
my $values = $drs110m->get_values();
|
||||
next if ( ref($values) ne 'HASH' );
|
||||
|
||||
while ( my ($reg, $val) = each(%{$values})){#Note: this type switching in perl is crazy!
|
||||
print("$reg : $val\n");
|
||||
};
|
||||
|
||||
|
||||
print("log off from $id\n");
|
||||
|
||||
while ( my ( $reg, $val ) = each( %{$values} ) ) {
|
||||
$socket->print(
|
||||
'setreading ' . $fhemDummy . $id . ' ' . $reg . ' ' . $val . "\n" );
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
$socket->close;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user