diff --git a/iec1107.pm b/iec1107.pm index 5439bd1..ff6d232 100755 --- a/iec1107.pm +++ b/iec1107.pm @@ -16,6 +16,7 @@ use Device::SerialPort; #for time conversion use DateTime::Format::Strptime qw( strptime ); +use DateTime; #constants our $SOH = chr(0x01); @@ -125,6 +126,36 @@ sub log_off() { 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 set_clock() { + my $self = shift; + my $res; + unless (ref $self){croak "call with an object, not a class";} + $res = $self->write_reg(31, _scale_datetime_to_raw_time(DateTime->now())); + # this function reliably returns an ACK + return $self; +}; + +sub reset_energy() { + my $self = shift; + my $res; + unless (ref $self){croak "call with an object, not a class";} + $res = $self->write_reg(0x40, "00000000"); + # this function does not reliably return an ACK, to be checked + return $self; +}; + sub _xfer { my $self = shift; my ($cmd) = @_; @@ -134,7 +165,7 @@ sub _xfer { $self->port->write( $cmd ); ($count,$res)=$self->port->read(32); return $res; -} +}; # Object accessor methods @@ -183,6 +214,13 @@ sub _scale_raw_time_to_datetime($){ 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 = ""; @@ -210,6 +248,16 @@ sub _generate_r1_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}; diff --git a/test_drs110m.pl b/test_drs110m.pl index ffd771c..69de8de 100644 --- a/test_drs110m.pl +++ b/test_drs110m.pl @@ -38,6 +38,9 @@ for my $id (@ids) { $drs110m->start_programming_mode(); + #$drs110m->set_clock(); + #$drs110m->reset_energy(); + $drs110m->update_values(); while ( my ($reg, $val) = each(%{$drs110m->regs})){#Note: this type switching in perl is crazy!