File Coverage

blib/lib/Device/Inverter/Aurora.pm

Criterion	Covered	Total	%
statement	145	202	71.7
branch	40	104	38.4
condition	30	91	32.9
subroutine	38	50	76.0
pod	41	43	95.3
total	294	490	60.0

package Device::Inverter::Aurora;

use 5.008008;
use strict;
use warnings;
use Carp qw/croak carp confess/;

require Exporter;

our @ISA = qw(Exporter);
our $TEST = 0;

my $onWindows = $^O eq "MSWin32" || $^O eq "cygwin";
if ($onWindows) {
	require Win32::SerialPort;
}
else {
	require Device::SerialPort;
}

use Device::Inverter::Aurora::Constants;
use Device::Inverter::Aurora::Strings;

our %EXPORT_TAGS = (
	CumulatedPeriod => [map {s/^.+:://; $_} grep {/Device::Inverter::Aurora::CUMULATED_/} keys %constant::declared],
	DSP             => [map {s/^.+:://; $_} grep {/Device::Inverter::Aurora::DSP_/} keys %constant::declared],
	Counters        => [map {s/^.+:://; $_} grep {/Device::Inverter::Aurora::COUNTER_/} keys %constant::declared],
	Operations      => [map {s/^.+:://; $_} grep {/Device::Inverter::Aurora::OP_/} keys %constant::declared],
);

# Combine all the tags to an :all tag
{my %s; push @{$EXPORT_TAGS{all}}, grep {!$s{$_}++} @{$EXPORT_TAGS{$_}} foreach keys %EXPORT_TAGS;}

our @EXPORT_OK = ( @{ $EXPORT_TAGS{all} } );

our @EXPORT = qw( );

our $VERSION = '0.05';

sub _error {
	my $self = shift;
	my $error = shift;

	$self->{error} = $error;
	carp $error unless $self->{quiet};
	return 1;
}

sub lastError {
	my $self = shift;
	my $error = $self->{error};
	$self->{error} = undef;
	return $error;
}

sub new {
	my $caller = shift;
	my $caller_is_ref = ref $caller;
	my $class = $caller_is_ref || $caller;

	my %args = ref $_ eq 'HASH' ? %{shift @_} : @_;

	# Extract some configuration from the given arguments
	my $debug    = $args{debug}   || 0;
	my $retries  = $args{retries} || 0;
	my $backoff  = $args{backoff} || 1;
	my $address  = $args{address} || 2;
	my $port_str = $args{port}    || '/dev/ttyS0';
	my $raw      = $args{raw}     || 0;
	my $quiet    = $args{quiet}   || 0;

	# Configure the serial port
	my $port = ($TEST
		? new Test::Device::SerialPort($port_str, debug => $debug)
		: ($onWindows
			? new Win32::SerialPort($port_str, debug => $debug)
			: new Device::SerialPort($port_str, debug => $debug)
		)
	) or croak "Can't open $port_str: $^E";

	# Again, mostly from the arguments provided
	$port->baudrate($args{baudrate} || 19200);
	$port->parity($args{parity} || 'none');
	$port->databits($args{databits} || 8);
	$port->stopbits($args{stopbits} || 1);
	$port->datatype($args{datatype} || 'raw');
	$port->handshake($args{handshake} || 'none');
	$port->read_const_time($args{read_const_time} || 150);

	$port->write_settings or warn "Unable to write settings to $port_str";

	# Does this even work?
	$port->purge_all;

	my $self = bless {
		port_str         => $port_str,
		debug            => $debug,
		quiet            => $quiet,
		retries          => $retries,
		backoff          => $backoff,
		port             => $port,
		address          => $address,
		error            => undef,
	}, $class;

	return $self;
}

sub raw {
	my ($self, $raw) = @_;
	$self->{raw} = $raw if defined $raw;
	return $self->{raw};
}

sub communicate {
	my ($self, $address, $command, @args) = @_;
	$address = $self->{address} unless defined $address;

	# Build a 8 byte space padded buffer based on address, command, and given arguments
	my @buffer = ($address, $command);
	push @buffer, map {defined $args[$_] ? $args[$_] : 32} 0..5;

	# Pack that buffer into a binary string, append CRC to it
	my $str = pack 'C8', @buffer;
	$str .= pack 'v', crc($str);

	# Try as many times as permitted to send to the inverter and get a reply
	my $try = -1;
	while ($try++ < $self->{retries}) {
		$self->{port}->purge_all;

		# Give the coms a break for a $backoff period
		sleep $self->{backoff} if $try > 1 && $self->{backoff};

		# Transmit data, make sure 10 bytes are sent
		warn "Sending " , hexstr($str) , "\n" if $self->{debug};
		my $sent = $self->{port}->write($str);
		$self->_error("Failed to write all bytes") and next unless defined $sent and $sent == 10;

		# Receive data, make sure that 8 bytes are read
		my $read = $self->{port}->read(8);
		warn "Received " , hexstr($read) , "\n" if $self->{debug};
		$self->_error("Failed to read in all bytes") and next unless defined $read and length $read == 8;

		# First 6 bytes of the reply are unsigned characters of data, the last 2 are a short CRC
		my @reply = unpack 'C6v', $read;
		my $reply_crc = pop @reply;

		# Verify the CRC matches
		$self->_error("CRC failure") and next unless crc(substr($read,0,6)) == $reply_crc;

		return wantarray ? @reply : \@reply;
	}

	confess "Read failure, $try attempts made.";
}

sub translate {
	my ($input, $matrix) = @_;

	# Given a hash and a valid $input, return the translation
	if (ref $matrix eq 'HASH' && defined $matrix->{$input}) {
		return $matrix->{$input}
	}
	# Given an array and a valid $input, return the translation
	elsif (ref $matrix eq 'ARRAY' && defined $matrix->[$input]) {
		return $matrix->[$input];
	}

	# Input was invalid or otherwise unknown
	return 'unknown';
}

sub transmissionCheck {
	my ($self, $input) = @_;

	# Get a translation for debugging
	my $translation = translate($input, \@TransmissionStates);
	warn "Transmission state check: $translation ($input)\n" if $self->{debug};

	# All is good in the world
	return 1 if $input == 0;

	# All is not so good, complain and return false
	$self->_error("Transmission State: $translation ($input)");
	return 0;
}

sub crc {
	my $str = shift;
	my $crc = 0xffff;
	foreach my $chr (unpack 'C*', $str) {
		for (my $i = 0, my $data =int 0xff & $chr; $i < 8; $i++, $data >>= 1) {
			$crc = ($crc & 0x0001) ^ ($data & 0x0001) ? ($crc >> 1) ^ 0x8408 : $crc >> 1;
		}
	}
	return 0xffff & ~$crc;
}

sub hexstr {
	my $str = shift;
	return join(' ', unpack('H2'x(length $str), $str));
}


sub commCheck {
	my ($self, $address) = @_;

	my @reply = $self->communicate($address, OP_GET_VERSION, 0);
	if (@reply && $self->transmissionCheck($reply[0])) {
		my $translation = translate(chr($reply[2]), \%ProductNames);
		warn "Product name: $translation\n" if $self->{debug};
		return 1;
	}
	return 0;
}

sub getState {
	my ($self, $address) = @_;

	my @reply = $self->communicate($address, OP_GET_STATE, 0);
	if (@reply && $self->transmissionCheck($reply[0])) {
		my %result = (
			globalState       => [$reply[1], translate($reply[1], \@GlobalStates)],
			inverterState     => [$reply[2], translate($reply[2], \@InverterStates)],
			channel1DCDCState => [$reply[3], translate($reply[3], \@DCDCStates)],
			channel2DCDCState => [$reply[4], translate($reply[4], \@DCDCStates)],
			alarmState        => [$reply[5], translate($reply[5], \@AlarmStates)],
		);
		return wantarray ? %result : \%result;
	}
	return wantarray ? () : undef;
}

sub getLastAlarms {
	my ($self, $address) = @_;

	my @reply = $self->communicate($address, 86, 0);
	if (@reply && $self->transmissionCheck($reply[0])) {
		my @result = map {[$_, translate($_, \@AlarmStates)]} @reply[2,3,4,5];
		return wantarray ? @result : \@result;
	}
	return wantarray ? () : undef;
}

sub getPartNumber {
	my ($self, $address) = @_;

	my @reply = $self->communicate($address, OP_GET_PART_NUMBER, 0);
	# Simple 6 character string to return
	return pack('C*', @reply);
}

sub getSerialNumber {
	my ($self, $address) = @_;

	my @reply = $self->communicate($address, OP_GET_SERIAL_NUMBER, 0);
	# Simple 6 character string to return
	return pack('C*', @reply);
}

sub getVersion {
	my ($self, $address) = @_;

	my @reply = $self->communicate($address, OP_GET_VERSION, 0, 46);
	if (@reply && $self->transmissionCheck($reply[0])) {
		my %result = (
			model       => [$reply[2], translate(chr($reply[2]), \%ProductNames)],
			regulation  => [$reply[3], translate(chr($reply[3]), \%ProductSpec)],
			transformer => [$reply[4], $reply[4] == 84 ? 'transformer' : 'transformerless'],
			type        => [$reply[5], $reply[5] == 87 ? 'wind' : 'photovoltic'],
		);
		return wantarray ? %result : \%result;
	}
	return wantarray ? () : undef;
}

sub getManufactureDate {
	my ($self, $address) = @_;

	my @reply = $self->communicate($address, OP_GET_MANUFACTURING_DATE, 0);
	if (@reply && $self->transmissionCheck($reply[0])) {
		# Two simple strings, month is first two bytes, year is last two.
		my %result = (
			year => pack('C*', @reply[4, 5]),
			month => pack('C*', @reply[2, 3]),
		);
		return wantarray ? %result : \%result;
	}
	return wantarray ? () : undef;
}

sub getFirmwareVersion {
	my ($self, $address) = @_;

	my @reply = $self->communicate($address, OP_GET_FIRMWARE_VERSION, 0);
	if (@reply && $self->transmissionCheck($reply[0])) {
		# Dot delimited characters
		return join '.', map{chr} @reply[2, 3, 4, 5];
	}
	return undef;
}

sub getConfiguration {
	my ($self, $address) = @_;

	my @reply = $self->communicate($address, OP_GET_CONFIGURATION, 0);
	if (@reply && $self->transmissionCheck($reply[0])) {
		my @result = ($reply[2],translate($reply[2], \@ConfigurationStrings));
		return wantarray ? @result : \@result;
	}
	return wantarray ? () : undef;
}

sub getCumulatedEnergy {
	my ($self, $period, $address) = @_;

	my @reply = $self->communicate($address, OP_GET_CUMULATED_ENERGY, $period, 0);
	if (@reply && $self->transmissionCheck($reply[0])) {
		# Data returned is a long expressing watts, pack the 4 bytes
		my $packed = pack 'C*', @reply[2, 3, 4, 5];
		# Return raw, or a long.
		return $self->{raw} ? $packed : unpack 'N', $packed;
	}
	return undef;
}

sub getDailyEnergy   {shift->getCumulatedEnergy(CUMULATED_DAILY, shift);}
sub getWeeklyEnergy  {shift->getCumulatedEnergy(CUMULATED_WEEKLY, shift);}
sub getMonthlyEnergy {shift->getCumulatedEnergy(CUMULATED_MONTHLY, shift);}
sub getYearlyEnergy  {shift->getCumulatedEnergy(CUMULATED_YEARLY, shift);}
sub getTotalEnergy   {shift->getCumulatedEnergy(CUMULATED_TOTAL, shift);}
sub getPartialEnergy {shift->getCumulatedEnergy(CUMULATED_PARTIAL, shift);}

sub getDSPData {
	my ($self, $parameter, $address) = @_;

	my @reply = $self->communicate($address, OP_GET_DSP, $parameter, 0);
	if (@reply && $self->transmissionCheck($reply[0])) {
		# Data returned is a single precision float, pack the 4 bytes
		my $packed = pack 'C*', @reply[5, 4, 3, 2];
		# Return raw or float.
		return $self->{raw} ? $packed : unpack 'f', $packed;
	}
	return undef;
}

sub getFrequency           {shift->getDSPData(DSP_FREQUENCY, shift);}
sub getGridVoltage         {shift->getDSPData(DSP_GRID_VOLTAGE, shift);}
sub getGridCurrent         {shift->getDSPData(DSP_GRID_CURRENT, shift);}
sub getGridPower           {shift->getDSPData(DSP_GRID_POWER, shift);}
sub getInput1Voltage       {shift->getDSPData(DSP_INPUT_1_VOLTAGE, shift);}
sub getInput1Current       {shift->getDSPData(DSP_INPUT_1_CURRENT, shift);}
sub getInput2Voltage       {shift->getDSPData(DSP_INPUT_2_VOLTAGE, shift);}
sub getInput2Current       {shift->getDSPData(DSP_INPUT_2_CURRENT, shift);}
sub getInverterTemperature {shift->getDSPData(DSP_INVERTER_TEMPERATURE, shift);}
sub getBoosterTemperature  {shift->getDSPData(DSP_BOOSTER_TEMPERATURE, shift);}

sub getJoules {
	my ($self, $address) = @_;

	my @reply = $self->communicate($address, OP_GET_LAST_10_SEC_ENERGY, 0);
	if (@reply && $self->transmissionCheck($reply[0])) {
		# Data returned is a short, only pack the first two bytes
		my $packed = pack 'C*', @reply[2, 3];
		# Return raw or short.
		return $self->{raw} ? $packed : (unpack 'n', $packed) * 0.319509;
	}
	return undef
}

sub getTime {
	my ($self, $address) = @_;

	my @reply = $self->communicate($address, OP_GET_TIME, 0);
	if (@reply && $self->transmissionCheck($reply[0])) {
		# Data returned is a long, pack the 4 bytes
		my $packed =  pack 'C*', @reply[2, 3, 4, 5];
		# Return as raw or as long offset for unix epoch (Inverter epoch is 946706400 later than unix)
		return $self->{raw} ? $packed : (unpack 'N', $packed) + 946706400;
	}
	return undef;
}

sub setTime {
	my ($self, $time, $address) = @_;

	# Convert from unix epoch to inverter epoch
	$time -= 946706400;

	# Pack the long and unpack into a 4 character array
	my @args = unpack 'C*', pack 'N', $time;
	my @reply = $self->communicate($address, OP_SET_TIME, @args, 0);
	if (@reply && $self->transmissionCheck($reply[0])) {
		return 1;
	}
	return undef;
}

sub getCounterData {
	my ($self, $counter, $address) = @_;

	my @reply = $self->communicate($address, OP_GET_COUNTERS, $counter);
	if (@reply && $self->transmissionCheck($reply[0])) {
		#Data returned is a long, pack the 4 bytes
		my $packed = pack 'C*', @reply[2, 3, 4, 5];
		# Return raw or long
		return $self->{raw} ? $packed : unpack 'N', $packed;
	}
	return undef;
}

sub getTotalRunTime {shift->getCounterData(COUNTER_TOTAL, shift);}
sub getPartialRunTime {shift->getTCounterData(COUNTER_PARTIAL, shift);}
sub getGridRunTime {shift->getCounterData(COUNTER_GRID, shift);}
sub getResetRunTime {shift->getCounterData(COUNTER_RESET, shift);}

1;
__END__