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

added usage example to docs, some general cleanup

Browse Source
This commit is contained in:
Patrick Menschel 2020-01-10 17:42:09 +01:00
parent ec26a52ba5
commit 3e17a525d8
3 changed files with 54 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
README.md
View File

@ -5,8 +5,38 @@ Use and Copy as you wish. Maybe this module will mature enough to be uploaded to
# 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 basic functions have been tested.
The basic functions have been tested. Some special functions
# Usage example:
```
use iec1107;#include the module
my $port = Device::SerialPort->new("/dev/ttyUSB0") || die $!;#define a port with 9600@7E1
$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 $id = 1613300152;#or whatever number the meter has
my $passwd = "00000000";
my $drs110m = iec1107->new("port"=>$port,"id"=>$id,"passwd"=>$passwd);
$drs110m->start_communication();
$drs110m->start_programming_mode();
$drs110m->update_values();
$drs110m->log_off();
while ( my ($reg, $val) = each(%{$drs110m->regs})){
print("$reg : $val\n");
};
```
# Output example:

39
iec1107.pm
View File

@ -1,15 +1,13 @@
#!/usr/bin/perl
#
# This is actually my first attempt with perl.
# This script borrows parts of https://wiki.volkszaehler.org/hardware/channels/meters/power/eastron_drs155m
# 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.
# 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
package iec1107; # we name our package iec1107 as this is the original protocol name
use strict;
use warnings;
use Carp;
@ -46,10 +44,10 @@ our %drs110m_values = (
'Time' =>[31, \&_scale_to_time, ''],
'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 port, an ID and a password
#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,
@ -63,9 +61,7 @@ sub new(\$$$){
sub _init {
my $self = shift;
#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
return;
};
@ -74,21 +70,22 @@ sub start_communication {
unless (ref $self){croak "call with an object, not a class";}
my $res;
$res = $self->_xfer(_generate_request_message("serialnumber"=>$self->id));
#there is an automatic sleep from the serial timeout
#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 but when the device was asleep.
#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; #utility functions should return self according to LEARN PERL examples
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_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; #utility functions should return self according to LEARN PERL examples
return $self;
};
@ -102,12 +99,11 @@ sub update_values {
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)){#sanity check
if ($addr == $drs110m_values{$measurement}[0]){#paranoia check
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);
#print($valstr);
$self->{regs}{$measurement}=$valstr;
}
else{
@ -137,9 +133,7 @@ sub _xfer {
my $res;
$self->port->lookclear;
$self->port->write( $cmd );
($count,$res)=$self->port->read(32);
return $res;
}
@ -154,7 +148,6 @@ sub regs { $_[0]->{regs}=$_[1] if defined $_[1]; $_[0]->{regs} }
#basic non-object functions
sub _interpret_r1_msg($){
my ($str) = @_;
my $val;
@ -185,9 +178,7 @@ sub _scale_1_to_1($){
};
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){
@ -268,4 +259,4 @@ sub _generate_request_message(%){
};
1;#for whatever reason
1;

19
test_drs110m.pl
View File

@ -4,7 +4,7 @@ use strict;
use warnings;
sub BEGIN {
push @INC, ".";#how long did we take for this absolute simple path include ?!
push @INC, ".";
}
@ -19,11 +19,12 @@ $port->handshake("none");
$port->write_settings;
$port->purge_all();
$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_char_time(0);
$port->read_const_time(150);#was 100ms previously, this lead to race conditions
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
@ -31,18 +32,14 @@ my $passwd = "00000000"; # Standard password 0 over 8-digits
for my $id (@ids) {
my $drs110m = iec1107->new("port"=>$port,"id"=>$id,"passwd"=>$passwd);
#print("start communication to $serialID\n");
print("Meter: $id\n");
# $drs110m->start_communication()->start_programming_mode()->update_values();#this function concatenation is neat but absolutely destroying readability
$drs110m->start_communication();
#print("start programming mode\n");
$drs110m->start_programming_mode();
#print("update values\n");
$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");
};