added usage example to docs, some general cleanup
This commit is contained in:
parent
ec26a52ba5
commit
3e17a525d8
32
README.md
32
README.md
@ -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
|
# 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.
|
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:
|
# Output example:
|
||||||
|
39
iec1107.pm
39
iec1107.pm
@ -1,15 +1,13 @@
|
|||||||
#!/usr/bin/perl
|
#!/usr/bin/perl
|
||||||
#
|
#
|
||||||
# This is actually my first attempt with perl.
|
# perl module for accessing a IEC1107 device
|
||||||
# This script borrows parts of https://wiki.volkszaehler.org/hardware/channels/meters/power/eastron_drs155m
|
# This is my first my perl module and these resources were a good kickstart
|
||||||
# which itself borrows parts of http://www.ip-symcon.de/forum/threads/21407-Stromz%C3%A4hler-mit-RS485/page2
|
# https://learn.perl.org/books/beginning-perl/
|
||||||
# The general functions have been developed in python3, see https://github.com/menschel/pyehz
|
# https://wiki.volkszaehler.org/hardware/channels/meters/power/eastron_drs155m
|
||||||
# Use and copy as you wish.
|
|
||||||
# Menschel (C) 2020
|
# Menschel (C) 2020
|
||||||
|
|
||||||
package iec1107; # we name our package iec1107 as this is the original protocol name
|
package iec1107; # we name our package iec1107 as this is the original protocol name
|
||||||
|
|
||||||
|
|
||||||
use strict;
|
use strict;
|
||||||
use warnings;
|
use warnings;
|
||||||
use Carp;
|
use Carp;
|
||||||
@ -46,10 +44,10 @@ our %drs110m_values = (
|
|||||||
'Time' =>[31, \&_scale_to_time, ''],
|
'Time' =>[31, \&_scale_to_time, ''],
|
||||||
'Temperature' =>[32, \&_scale_to_temp, '°C'],
|
'Temperature' =>[32, \&_scale_to_temp, '°C'],
|
||||||
);
|
);
|
||||||
|
#actually there are more registers, but who cares about cosphi for example?!
|
||||||
|
|
||||||
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 and correctly set up port, an ID and a password
|
||||||
# {"port"=>$port, #perl automatically converts this to a reference
|
# {"port"=>$port, #perl automatically converts this to a reference
|
||||||
# "id"=>$id,
|
# "id"=>$id,
|
||||||
# "passwd"=>$passwd,
|
# "passwd"=>$passwd,
|
||||||
@ -63,9 +61,7 @@ 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
|
|
||||||
$self->{"regs"} = ();
|
$self->{"regs"} = ();
|
||||||
#for whatever reason _init() does not return anything in the LEARN PERL Examples
|
|
||||||
return;
|
return;
|
||||||
};
|
};
|
||||||
|
|
||||||
@ -74,21 +70,22 @@ sub start_communication {
|
|||||||
unless (ref $self){croak "call with an object, not a class";}
|
unless (ref $self){croak "call with an object, not a class";}
|
||||||
my $res;
|
my $res;
|
||||||
$res = $self->_xfer(_generate_request_message("serialnumber"=>$self->id));
|
$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){
|
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));
|
$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 {
|
sub start_programming_mode {
|
||||||
my $self = shift;
|
my $self = shift;
|
||||||
unless (ref $self){croak "call with an object, not a class";}
|
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;
|
||||||
};
|
};
|
||||||
|
|
||||||
|
|
||||||
@ -102,12 +99,11 @@ sub update_values {
|
|||||||
while ( my ($measurement, $vals) = each(%drs110m_values) ) {
|
while ( my ($measurement, $vals) = each(%drs110m_values) ) {
|
||||||
$res = $self->_xfer(_generate_r1_msg("reg"=>$drs110m_values{$measurement}[0]));
|
$res = $self->_xfer(_generate_r1_msg("reg"=>$drs110m_values{$measurement}[0]));
|
||||||
($addr,$val) = _interpret_r1_msg($res);
|
($addr,$val) = _interpret_r1_msg($res);
|
||||||
if (defined($addr)){#sanity check
|
if (defined($addr)){
|
||||||
if ($addr == $drs110m_values{$measurement}[0]){#paranoia check
|
if ($addr == $drs110m_values{$measurement}[0]){
|
||||||
$val = &{$drs110m_values{$measurement}[1]}($val);
|
$val = &{$drs110m_values{$measurement}[1]}($val);
|
||||||
$unit = $drs110m_values{$measurement}[2];
|
$unit = $drs110m_values{$measurement}[2];
|
||||||
$valstr = sprintf("%s %s",$val,$unit);
|
$valstr = sprintf("%s %s",$val,$unit);
|
||||||
#print($valstr);
|
|
||||||
$self->{regs}{$measurement}=$valstr;
|
$self->{regs}{$measurement}=$valstr;
|
||||||
}
|
}
|
||||||
else{
|
else{
|
||||||
@ -137,9 +133,7 @@ sub _xfer {
|
|||||||
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;
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -154,7 +148,6 @@ sub regs { $_[0]->{regs}=$_[1] if defined $_[1]; $_[0]->{regs} }
|
|||||||
|
|
||||||
|
|
||||||
#basic non-object functions
|
#basic non-object functions
|
||||||
|
|
||||||
sub _interpret_r1_msg($){
|
sub _interpret_r1_msg($){
|
||||||
my ($str) = @_;
|
my ($str) = @_;
|
||||||
my $val;
|
my $val;
|
||||||
@ -185,9 +178,7 @@ sub _scale_1_to_1($){
|
|||||||
};
|
};
|
||||||
|
|
||||||
sub _scale_to_time($){
|
sub _scale_to_time($){
|
||||||
#"19112703192714" => 2019-11-27 19:27:14
|
|
||||||
my ($str) = @_;
|
my ($str) = @_;
|
||||||
#print("$str \n");
|
|
||||||
my $fmt = "%y%m%d0%w%H%M%S";
|
my $fmt = "%y%m%d0%w%H%M%S";
|
||||||
my @time = (POSIX::strptime($str,$fmt))[0..7];
|
my @time = (POSIX::strptime($str,$fmt))[0..7];
|
||||||
if (wantarray){
|
if (wantarray){
|
||||||
@ -268,4 +259,4 @@ sub _generate_request_message(%){
|
|||||||
};
|
};
|
||||||
|
|
||||||
|
|
||||||
1;#for whatever reason
|
1;
|
||||||
|
@ -4,7 +4,7 @@ use strict;
|
|||||||
use warnings;
|
use warnings;
|
||||||
|
|
||||||
sub BEGIN {
|
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->write_settings;
|
||||||
|
|
||||||
$port->purge_all();
|
$port->purge_all();
|
||||||
$port->read_char_time(0); # don't wait for each character
|
$port->read_char_time(0);
|
||||||
$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);#was 100ms previously, this lead to race conditions
|
||||||
|
|
||||||
my @ids = (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"
|
||||||
|
# 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
|
||||||
|
|
||||||
|
|
||||||
@ -31,18 +32,14 @@ my $passwd = "00000000"; # Standard password 0 over 8-digits
|
|||||||
for my $id (@ids) {
|
for my $id (@ids) {
|
||||||
my $drs110m = iec1107->new("port"=>$port,"id"=>$id,"passwd"=>$passwd);
|
my $drs110m = iec1107->new("port"=>$port,"id"=>$id,"passwd"=>$passwd);
|
||||||
|
|
||||||
#print("start communication to $serialID\n");
|
|
||||||
print("Meter: $id\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();
|
$drs110m->start_communication();
|
||||||
#print("start programming mode\n");
|
|
||||||
$drs110m->start_programming_mode();
|
$drs110m->start_programming_mode();
|
||||||
#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!
|
while ( my ($reg, $val) = each(%{$drs110m->regs})){#Note: this type switching in perl is crazy!
|
||||||
print("$reg : $val\n");
|
print("$reg : $val\n");
|
||||||
};
|
};
|
||||||
|
Loading…
Reference in New Issue
Block a user