diff --git a/README.md b/README.md index b893357..ba3b7c0 100644 --- a/README.md +++ b/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 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: diff --git a/iec1107.pm b/iec1107.pm index 9982b75..667c73a 100755 --- a/iec1107.pm +++ b/iec1107.pm @@ -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; diff --git a/test_drs110m.pl b/test_drs110m.pl index 30a4e48..ffd771c 100644 --- a/test_drs110m.pl +++ b/test_drs110m.pl @@ -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"); };