#########################################################################################
# Package        HiPi::RF::OpenThings::Message
# Description  : Handle OpenThings protocol message
# Copyright    : Copyright (c) 2013-2017 Mark Dootson
# License      : This is free software; you can redistribute it and/or modify it under
#                the same terms as the Perl 5 programming language system itself.
#########################################################################################

package HiPi::RF::OpenThings::Message;

#########################################################################################

use strict;
use warnings;
use parent qw( HiPi::Class );
use HiPi qw( :openthings );
use Try::Tiny;

our $VERSION ='0.61';

__PACKAGE__->create_accessors( qw(
    cryptseed
    errorbuffer
    databuffer
    epoch
    length
    ok
    records
    _mid
    _pid
    _sid
    _pip
));

sub new {
    my( $class, %params ) = @_;
    $params{epoch} = time();
    $params{errorbuffer}  = [];
    $params{databuffer} //= [];
    $params{cryptseed} //= 1;
    $params{records} = [];
    $params{_mid} = $params{mid} || $params{manufacturer_id} || 0;
    $params{_pid} = $params{pid} || $params{product_id} || 0;
    $params{_sid} = $params{sid} || $params{sensor_id} || 0;
    $params{_pip} = $params{pip} || $params{encrypt_pip} || 0;
    my $self = $class->SUPER::new( %params );
    return $self;
}

sub manufacturer_id { return $_[0]->_mid; }

sub product_id { return $_[0]->_pid; }

sub sensor_id { return $_[0]->_sid; }

sub encrypt_pip { return $_[0]->_pip; }

sub sensor_key {
    my $self = shift;
    my $key = sprintf(qq(%04X-%04X-%06X), $self->manufacturer_id || 0, $self->product_id || 0, $self->sensor_id || 0);
    return $key;    
}

sub encode_buffer {
    my $self = shift;
    my $result = try {
        my $payload = [ 0 ]; # len we will assign later
        push @$payload, $self->manufacturer_id;
        push @$payload, $self->product_id;
        push @$payload, ( $self->encrypt_pip >> 8 ) & 0xFF;
        push @$payload, $self->encrypt_pip & 0xFF;
        push @$payload, ( $self->sensor_id >> 16 ) & 0xFF;
        push @$payload, ( $self->sensor_id >> 8 ) & 0xFF;
        push @$payload, $self->sensor_id  & 0xFF;
        
        for my $record ( @{ $self->records } ) {
            my $writemask = ( $record->wr ) ? OPENTHINGS_WRITE_MASK : 0x0;
            # ID and R/W
            push @$payload, $record->id | $writemask;
            # Type (will and length later)
            push @$payload, $record->typeid & 0xF0;
            # record position of type/length byte
            my $lenpos = ( scalar @$payload ) -1;
            
            my $val = $record->value;
            if(defined($val) && $val ne '') {
                my @valbytes = $self->encode_value( $record->typeid, $val, $record->length );
                my $vallen = ( @valbytes ) ? scalar(@valbytes) : 0;
                $payload->[$lenpos] = ( $record->typeid & 0xF0 ) | ( $vallen & 0xF );
                for my $byte ( @valbytes ) {
                    push @$payload, $byte;
                }
            }
        }
        
        # FOOTER
        push @$payload, 0; #NUL
        
        $self->databuffer( $payload );
        my $crc = $self->calculate_crc( 1 );
        
        push @$payload, ( $crc >> 8 ) & 0xFF;
        push @$payload, $crc & 0xFF;
        
        $payload->[0] = ( scalar @$payload ) -1;
        
        $self->crypt_buffer;
        
        return 1;
    } catch {
        die $_;
        $self->push_error(q(unexpected error in message encode ) . $_);
        return 0;
    };
    
    $self->ok( $result );
}

sub decode_buffer {
    my $self = shift;
    my $result = try {
        
        # clear records
        $self->records([]);
        
        # check basic message length
        if ( ( $self->buffer_length < 10 )
            || ( $self->databuffer->[0] + 1 != $self->buffer_length ) ) {
            $self->push_error(q(invalid message length ) . $self->buffer_length);
            return 0;
        }
        
        $self->crypt_buffer;
        
        my $payload = $self->databuffer;
        
        $self->_mid( $payload->[1] );
        $self->_pid( $payload->[2] );
        $self->_pip( ( $payload->[3] << 8 ) + $payload->[4] );
        $self->_sid( ( $payload->[5] << 16 ) + ( $payload->[6] << 8 ) + $payload->[7] );
        
        # check CRC to see if this is good message
        my $crc_sent  = ( $payload->[-2] << 8 ) + $payload->[-1];
        my $crc_calculated= $self->calculate_crc;
        if ( $crc_sent != $crc_calculated ) {
            $self->push_error(qq(invalid CRC - got $crc_sent, expected $crc_calculated));
            return 0;
        }
        
        # decode the records
        
        my $index = 8;
        my @records;
        while ( ( $index  < @$payload -2 ) && $payload->[$index] != 0 ) {
            my $param = $payload->[$index];
            my $wr = (($param & 0x80) == 0x80);
		    my $paramid = $param & 0x7F;
            my ( $paramname, $paramunit ) = $self->ot_param_map( $paramid );
            $index ++;
            my $typeid = $payload->[$index] & 0xF0;
            my $paramlen = $payload->[$index] & 0x0F;
            $index ++;
            
            my $record = {
                wr     => $wr,
                id     => $paramid,
                name   => $paramname,
                units  => $paramunit,
                typeid => $typeid,
                length => $paramlen,
                value  => '',
                bytes  => [],
            };
            
            if ( $paramlen != 0 ) {
                my @valuebytes = ();
                for (my $i = 0; $i < $paramlen; $i++ ) {
                    push @valuebytes, $payload->[$index];
                    $index ++;
                }
                
                if ( $paramlen != @valuebytes ) {
                    $self->push_error('length of bytes for param incorrect');
                    return 0;
                }
                
                
                my $value = $self->decode_value($typeid, \@valuebytes );
                $record->{value} = $value;
                $record->{bytes} = \@valuebytes;
            }
            push @records, $record;   
        }
    
        for my $record ( @records ) {
            $self->add_record(%$record);
        }
        return 1;
    } catch {
        $self->push_error(q(unexpected error in message decode ) . $_);
        return 0;
    };
    
    $self->ok( $result );
}

sub get_value_type_bits {
    my($self, $typeid) = @_;
    
    my $rval = 1;
    
    if ($typeid == OPENTHINGS_UINT_BP4 ) {
        $rval = 4;
    } elsif($typeid == OPENTHINGS_UINT_BP8 ) {
        $rval = 8;
    } elsif($typeid == OPENTHINGS_UINT_BP12 ) {
        $rval = 12;
    } elsif($typeid == OPENTHINGS_UINT_BP16 ) {
        $rval = 16;
    } elsif($typeid == OPENTHINGS_UINT_BP20 ) {
        $rval = 20;
    } elsif($typeid == OPENTHINGS_UINT_BP24 ) {
        $rval = 24;
    } elsif($typeid == OPENTHINGS_SINT_BP8 ) {
        $rval = 8;
    } elsif($typeid == OPENTHINGS_SINT_BP16 ) {
        $rval = 16;
    } elsif($typeid == OPENTHINGS_SINT_BP24 ) {
        $rval = 24;
    }
    return $rval;    
}

sub get_value_bits {
    my($self, $value) = @_;
    return 2 if $value == -1;
	# Turn into  2's
	my $maxbytes = 15;
	my $maxbits = 1 << ( $maxbytes * 8 );
	$value = $value & $maxbits -1;
	
    my $bits = 2 + $self->get_highest_clear_bit($value, $maxbytes * 8 );
    
    return $bits;
}

sub get_highest_clear_bit {
    my($self, $value, $maxbits) = @_;
    
    my $mask = 1 << ( $maxbits -1 );
	my $bitno = $maxbits - 1;
	while( $mask != 0 ) {
        last if( ($value & $mask) == 0);
        $mask >>= 1;
		$bitno -= 1;
    }
	return $bitno;
}

sub decode_value {
    my($self, $typeid, $bytes) = @_;
    
    my $numbytes = scalar @$bytes;
    
    if ( $typeid <= OPENTHINGS_UINT_BP24 ) {
		my $result = 0;
		# decode unsigned integer first
		for (my $i = 0; $i < @$bytes; $i++) {
			$result <<= 8;
			$result += $bytes->[$i];
        }
		# process any fixed binary points
		if( $typeid == OPENTHINGS_UINT ) {
            return $result; # no BP adjustment
        } else {
            return $result / ( 2 ** $self->get_value_type_bits( $typeid ) );
        }
    } elsif( $typeid == OPENTHINGS_CHAR ) {
        my $result = join('', @$bytes);
        return $result;
    } elsif( $typeid >= OPENTHINGS_SINT && $typeid <= OPENTHINGS_SINT_BP24 ) {     
        # decode unsigned int first
		my $result = 0;
		for (my $i = 0; $i < @$bytes; $i++) {
			$result <<= 8;
			$result += $bytes->[$i];
        }
		# turn to signed int based on high bit of MSB
		# 2's comp is 1's comp plus 1
		if(($bytes->[0] & 0x80) == 0x80) {
            my $onescomp = (~$result) & ( ( 2 ** ( $numbytes * 8) ) -1 );
            $result = -($onescomp + 1);
        }
		# adjust for binary point
		if( $typeid == OPENTHINGS_SINT ) {
			return $result; # no BP, return as int
        } else {
            return $result / ( 2 ** $self->get_value_type_bits( $typeid ) );
        }
    } elsif( $typeid == OPENTHINGS_FLOAT ) {
        return "TODO_FLOAT_IEEE_754-2008";
    }
       
    return 0;
}

sub encode_value {
    my($self, $typeid, $value, $vallength ) = @_;
    $vallength ||= 0;
    
    my @result = ();
    my @emptyresult = ();
    
    if ( $typeid <= OPENTHINGS_UINT_BP24 ) {
        # unsigned integer
        if ( $typeid != OPENTHINGS_UINT ) {
			# pre-adjust for BP
			if( int($value) != $value ) {
				$value *= ( 2 ** $self->get_value_type_bits( $typeid ) ); # shifts float into int range using BP
				$value = int($value);
            }
        }
        
        my $v = $value;
        unshift(@result, $v & 0xFF );
        $v >>= 8;        
		
        while( $v != 0 ) {
            unshift(@result, $v & 0xFF );
            $v >>= 8;
        }
        
        if( $vallength && $vallength > ( scalar @result) ) {
            # left pad with zeros
			my $numbytes = $vallength - ( scalar @result );
            for (my $index = 0; $index < $numbytes; $index ++) {
                unshift(@result, 0);
            }
        }
        
    } elsif( $typeid == OPENTHINGS_CHAR ) {
        unless(defined($value) && $value ne '' ) {
            return @emptyresult;
        }
        my @chars = split(//, $value);
        my $numchars = scalar @chars;
        return @emptyresult unless $numchars;
        $numchars = $vallength if( $vallength && $vallength < $numchars );
        my $extrachars = (  $vallength && $vallength > $numchars ) ? $vallength - $numchars : 0;
        
        for (my $index = 0; $index < $numchars; $index ++) {
            push @result, ord( $chars[$index]);
        }
        
        for (my $extra  = 0; $extra < $extrachars; $extra ++) {
            push @result, 0;
        }
       
    } elsif( $typeid == OPENTHINGS_FLOAT ) {
        warn "TODO_FLOAT_IEEE_754-2008";
        return @emptyresult;
        
    } elsif($typeid >=  OPENTHINGS_SINT && $typeid <= OPENTHINGS_SINT_BP24 ) {
		# signed int
        if ( $typeid != OPENTHINGS_SINT ) {
			# pre-adjust for BP
			if( int($value) != $value ) {
				$value *= ( 2 ** $self->get_value_type_bits( $typeid ) ); # shifts float into int range using BP
				$value = int($value);
            }
        }
        
        $value = int($value);
        my $negative = 0;
        
        if( $value < 0 ) {
            my $bits;
			if( $typeid == OPENTHINGS_SINT ) {
				$bits = $self->get_value_bits($value);
            } else {
				$bits = $self->get_value_type_bits( $typeid );
            }
    
            # NORMALISE BITS TO BYTES
            #round up to nearest number of 8 bits
            # if already 8, leave 1,2,3,4,5,6,7,8 = 8   0,1,2,3,4,5,6,7 (((b-1)/8)+1)*8
            # 9,10,11,12,13,14,15,16=16
            $bits = ((($bits-1)/8)+1)*8; # snap to nearest byte boundary

            $value &= ((2**int($bits))-1);
            $negative = 1;
        }
        
        my $v = $value;
		while( $v != 0 ) {
            unshift(@result, $v & 0xFF );
            $v >>= 8;
        }
        
        if( $vallength && $vallength > ( scalar @result) ) {
            # left pad with zeros
			my $numbytes = $vallength - ( scalar @result );
            if( $negative ) {
                for (my $index = 0; $index < $numbytes; $index ++) {
                    unshift(@result, 0xFF);
                }
            } else {
                for (my $index = 0; $index < $numbytes; $index ++) {
                    unshift(@result, 0);
                }
            }
        }
    }
    
    return @result;
}

sub crypt_buffer {
    my $self = shift;
    return unless $self->cryptseed;
    my $payload = $self->databuffer;
    my $pip = ( $payload->[3] << 8 ) + $payload->[4];
    return unless $pip;
    my $pid = $self->cryptseed;
    my $block = ( ( ($pid & 0xFF ) << 8 ) ^ $pip ) & 0xFFFF;
    
    for ( my $byte = 5; $byte < @$payload; $byte ++ ) {
        for (my $i = 0; $i < 5; $i ++ )	{
            $block = ( $block & 1 ) ? (($block >> 1) ^ 0xF5F5 ) & 0xFFFF : ($block >> 1);
        }
        $payload->[$byte] = ( $block ^  $payload->[$byte] ^ 0x5A ) & 0xFF;
    }   
}

sub calculate_crc {
    my ( $self, $nocrcbytes ) = @_;
    
    my $skipbytes = ( $nocrcbytes ) ? 0 : 2;
    
    my $payload = $self->databuffer;
    
    # calculate from 5th byte (start of encrypt pip excluding the two crc bytes at the end if specified)
    my $crc = 0;
    for ( my $i = 5; $i < @$payload - $skipbytes; $i ++ ) {
        my $byte = $payload->[$i];
		$crc ^= ( $byte << 8 );
        for ( my $bit = 0; $bit < 8; $bit ++ ) {
            if( ( $crc & ( 1 <<15 ) ) != 0 ) {
				# bit is set
				$crc = (( $crc << 1) ^ 0x1021) & 0xFFFF;
            } else {
				# bit is clear
				$crc = ( $crc << 1 ) & 0xFFFF;
            }
        }
    }
    
	return $crc;
}

sub buffer_length {
    my $self = shift;
    my $val = scalar @{ $self->databuffer };
    return $val;
}

sub push_error {
    my( $self, $error) = @_;
    
    if ( $error ) {
       push( @{ $self->errorbuffer }, $error );
    }
    return;
}

sub error {
    my $self = shift;
    return scalar @{ $self->errorbuffer };
}

sub shift_error {
    my $self = shift;
    my $rval = shift @{ $self->errorbuffer };
    return $rval;
}

sub add_record {
    my($self, %params) = @_;
    my $record = HiPi::RF::OpenThings::Message::Record->new( %params );
    push @{ $self->records }, $record;
    return;
}

sub ot_param_map {
    my ($self, $param ) = @_;
    
    my($name, $units) = ('Unknown - ' . $param, '');
    
    if ( $param == OPENTHINGS_PARAM_ALARM ) {
        $name = 'Alarm';
    } elsif( $param == OPENTHINGS_PARAM_DEBUG_OUTPUT ) {
        $name = 'Debug Output';
    } elsif( $param == OPENTHINGS_PARAM_IDENTIFY ) {
        $name = 'Identify';
    } elsif( $param == OPENTHINGS_PARAM_SOURCE_SELECTOR ) {
        $name = 'Source Selector';
    } elsif( $param == OPENTHINGS_PARAM_WATER_DETECTOR ) {
        $name = 'Water Detector';
    } elsif( $param == OPENTHINGS_PARAM_GLASS_BREAKAGE ) {
        $name = 'Glass Breakage';
    } elsif( $param == OPENTHINGS_PARAM_CLOSURES ) {
        $name = 'Closures';
    } elsif( $param == OPENTHINGS_PARAM_DOOR_BELL ) {
        $name = 'Door Bell';
    } elsif( $param == OPENTHINGS_PARAM_ENERGY ) {
        $name = 'Energy';
        $units = 'kWh'
    } elsif( $param == OPENTHINGS_PARAM_FALL_SENSOR ) {
        $name = 'Fall Sensor';
    } elsif( $param == OPENTHINGS_PARAM_GAS_VOLUME ) {
        $name = 'Gas Volume';
        $units = 'm3';
    } elsif( $param == OPENTHINGS_PARAM_AIR_PRESSURE ) {
        $name = 'Air Pressure';
        $units = 'mbar';
    } elsif( $param == OPENTHINGS_PARAM_ILLUMINANCE ) {
        $name = 'Illuminance';
        $units = 'Lux';
    } elsif( $param == OPENTHINGS_PARAM_LEVEL ) {
        $name = 'Level';
    } elsif( $param == OPENTHINGS_PARAM_RAINFALL ) {
        $name = 'Rainfall';
        $units = 'mm';
    } elsif( $param == OPENTHINGS_PARAM_APPARENT_POWER ) {
        $name = 'Apparent Power';
        $units = 'VA';
    } elsif( $param == OPENTHINGS_PARAM_POWER_FACTOR ) {
        $name = 'Power Factor';
    } elsif( $param == OPENTHINGS_PARAM_REPORT_PERIOD ) {
        $name = 'Report Period';
        $units = 's';
    } elsif( $param == OPENTHINGS_PARAM_SMOKE_DETECTOR ) {
        $name = 'Smoke Detector';
    } elsif( $param == OPENTHINGS_PARAM_TIME_AND_DATE ) {
        $name = 'Time and Date';
        $units = 's';
    } elsif( $param == OPENTHINGS_PARAM_VIBRATION ) {
        $name = 'Vibration';
    } elsif( $param == OPENTHINGS_PARAM_WATER_VOLUME ) {
        $name = 'Water Volume';
        $units = 'l';
    } elsif( $param == OPENTHINGS_PARAM_WIND_SPEED ) {
        $name = 'Wind Speed';
        $units = 'm/s';
    } elsif( $param == OPENTHINGS_PARAM_GAS_PRESSURE ) {
        $name = 'Gas Pressure';
        $units = 'Pa';
    } elsif( $param == OPENTHINGS_PARAM_BATTERY_LEVEL ) {
        $name = 'Battery Level';
        $units = 'V';
    } elsif( $param == OPENTHINGS_PARAM_CO_DETECTOR ) {
        $name = 'Carbon Monoxide Detector';
    } elsif( $param == OPENTHINGS_PARAM_DOOR_SENSOR ) {
        $name = 'Door Sensor';
    } elsif( $param == OPENTHINGS_PARAM_EMERGENCY ) {
        $name = 'Emergency';
    } elsif( $param == OPENTHINGS_PARAM_FREQUENCY ) {
        $name = 'Frequency';
        $units = 'Hz';
    } elsif( $param == OPENTHINGS_PARAM_GAS_FLOW_RATE ) {
        $name = 'Gas Flow Rate';
        $units = 'm3/hr';
    } elsif( $param == OPENTHINGS_PARAM_RELATIVE_HUMIDITY ) {
        $name = 'Relative Humidity';
        $units = '%';
    } elsif( $param == OPENTHINGS_PARAM_CURRENT ) {
        $name = 'Current';
        $units = 'A';
    } elsif( $param == OPENTHINGS_PARAM_JOIN ) {
        $name = 'Join';
    } elsif( $param == OPENTHINGS_PARAM_LIGHT_LEVEL ) {
        $name = 'Light Level';
    } elsif( $param == OPENTHINGS_PARAM_MOTION_DETECTOR ) {
        $name = 'Motion Detector';
    } elsif( $param == OPENTHINGS_PARAM_OCCUPANCY ) {
        $name = 'Occupancy';
    } elsif( $param == OPENTHINGS_PARAM_REAL_POWER ) {
        $name = 'Real Power';
        $units = 'W';
    } elsif( $param == OPENTHINGS_PARAM_REACTIVE_POWER ) {
        $name = 'Reactive Power';
        $units = 'VAR';
    } elsif( $param == OPENTHINGS_PARAM_SWITCH_STATE ) {
        $name = 'Switch State';
    } elsif( $param == OPENTHINGS_PARAM_TEMPERATURE ) {
        $name = 'Temperature';
        $units = 'C';
    } elsif( $param == OPENTHINGS_PARAM_VOLTAGE ) {
        $name = 'Voltage';
        $units = 'V';
    } elsif( $param == OPENTHINGS_PARAM_WATER_FLOW_RATE ) {
        $name = 'Water Flow Rate';
        $units = 'l/hr';
    } elsif( $param == OPENTHINGS_PARAM_WATER_PRESSURE ) {
        $name = 'Water Pressure';
        $units = 'Pa';
    } elsif( $param == OPENTHINGS_PARAM_PHASE_1_POWER ) {
        $name = 'Phase 1 Power';
        $units = 'W';
    } elsif( $param == OPENTHINGS_PARAM_PHASE_2_POWER ) {
        $name = 'Phase 2 Power';
        $units = 'W';
    } elsif( $param == OPENTHINGS_PARAM_PHASE_3_POWER ) {
        $name = 'Phase 3 Power';
        $units = 'W';
    } elsif( $param == OPENTHINGS_PARAM_3_PHASE_TOTAL ) {
        $name = '3 Phase Total Power';
        $units = 'W';
    } elsif( $param == OPENTHINGS_PARAM_TEST ) {
        $name = 'Test';
    }
    return ( wantarray ) ? ( $name, $units ) : $name;
}

#########################################################################################

package HiPi::RF::OpenThings::Message::Record;

#########################################################################################
use strict;
use warnings;
use parent qw( HiPi::Class );

__PACKAGE__->create_accessors( qw( wr id name units typeid length value bytes ));

sub new {
    my ( $class, %params ) = @_;
    my $self = $class->SUPER::new( %params );
    
    unless($self->name && $self->units) {
        my ( $name, $units ) = HiPi::RF::OpenThings::Message->ot_param_map( $self->id );
        unless( $self->name ) {
            $self->name( $name );
        }
        unless( $self->units ) {
            $self->units( $units );
        }
    }
    
    return $self;
}

1;

__END__