File Coverage

blib/lib/ZWave/Protocol.pm

Criterion	Covered	Total	%
statement	20	110	18.1
branch	0	20	0.0
condition	0	3	0.0
subroutine	6	17	35.2
pod	8	12	66.6
total	34	162	20.9

package ZWave::Protocol;
use strict;
use warnings;
use Log::Log4perl qw(:easy);
use Device::SerialPort;
use Moo;

our $VERSION = "0.03";

has device           => ( is => 'rw', default => sub { "/dev/ttyUSB0" } );
has error            => ( is => 'rw' );
has port             => ( is => 'rw' );
has read_timeout_ms  => ( is => 'rw', default => sub { "200" } );
has ack_timeout_ms   => ( is => 'rw', default => sub { "5000" } );

sub connect {
    my( $self ) = @_;

    my $port = Device::SerialPort->new( $self->device, 1 );

    if( !defined $port ) {
        ERROR "Can't connect to ", $self->device;
        return undef;
    }

    $port->baudrate( 115200 );
    $port->databits( 8 );
    $port->parity( "none" );
    $port->stopbits( 1 );
    $port->handshake( "none" );
    $port->dtr_active( 1 );

    $port->error_msg( 1 );
    $port->user_msg( 0 );

    $port->write_settings or
        die "Failed to initialize USB port " . $self->device . ": $@";

    $self->port( $port );

    return 1;
}

sub checksum {
    my( $self, @bytes ) = @_;

    my $checksum = 0xFF;

      # x-or all elements but the first one
    for my $byte ( splice @bytes, 1, @bytes - 1 ) {
        $checksum ^= $byte;
    }

    return $checksum;
}

sub packet_dump {
    my( $self, $packet ) = @_;

    my @bytes = unpack "C*", $packet;

    return $self->bytes_dump( @bytes );
}

sub bytes_dump {
    my( $self, @bytes ) = @_;

    my $string = "";

    for my $byte ( @bytes ) {
        if( length $string ) {
            $string .= " ";
        }
        $string .= sprintf "%02x", $byte;
    }

    return "[ $string ]";
}

sub request_packet {
    my( $self, @payload ) = @_;

    my $length = @payload + 1;

    my @bytes    = ( 0x1, $length, @payload );
    my $checksum = $self->checksum( @bytes );

    DEBUG "Checksum of ", $self->bytes_dump( @bytes ), " is ",
        $self->bytes_dump( $checksum );

    push @bytes, $checksum;

    return pack "C*", @bytes;
}

sub payload_send {
    my( $self, @payload ) = @_;

    my $request = $self->request_packet( @payload );

    DEBUG "Sending request: ", $self->packet_dump( $request );

    if( !$self->port->write( $request ) ) {
        $self->error( "Failed to send payload " .
            $self->bytes_dump( @payload ) . ": $@" );
        return undef;
    }

    return 1;
}

sub ack_recv {
    my( $self ) = @_;

    DEBUG "Waiting for ACK";

    my $packet = $self->packet_recv( );
    my @bytes = unpack "C*", $packet;

    DEBUG "ACK bytes: ", $self->bytes_dump( @bytes );

    if( @bytes == 0 ) {
        INFO "Received nothing";
        return 0;
    }

    if( defined $bytes[ 0 ] and $bytes[ 0 ] == 6 ) {
        INFO "Received ACK";
        $self->ack_send();
        return 1;
    }

    INFO "Received non-ACK";

    return undef;
}

sub ack_send {
    my( $self, $node_id ) = @_;

    INFO "Sending ACK";
    $self->port->write( pack( "C", 6 ) );

    return 1;
}

sub payload_transmit {
    my( $self, @payload ) = @_;

    if( !$self->payload_send( @payload ) ) {
        return undef;
    }

    if( !$self->ack_recv() ) {
        $self->error( "Failed to receive ack for sent payload @payload: $@" );
        return undef;
    }

    return 1;
}

sub error_process {
    my( $self, $string ) = @_;

    local $Log::Log4perl::caller_depth =
        $Log::Log4perl::caller_depth + 1;

    ERROR $string;
    $self->error( $string );

    return 1;
}

sub packet_recv {
    my( $self ) = @_;

    $self->port->read_const_time( $self->read_timeout_ms );

      # read one byte at a time until there's no more
    my $sofar = "";
    while( 1 ) {
	my( $count, $bytes ) = $self->port->read( 1 );
        DEBUG "Read $count bytes: ", $self->packet_dump( $bytes );
	$sofar .= $bytes;
        if( !$count ) {
            last;
        }
    }

    DEBUG "Read packet: ", $self->packet_dump( $sofar );

    return $sofar;
}

sub payload_recv {
    my( $self ) = @_;

    my @bytes = unpack "C*", $self->packet_recv;

    my( $type, $len, @rest ) = @bytes;

    my $checksum = pop @rest;

    if( $checksum != $self->checksum( $len, @rest ) ) {
        $self->error_process( "Received package with invalid checksum: " .
            $self->bytes_dump( @bytes ) . " (checksum should be " .
            $self->bytes_dump( $checksum ) . ")" );
        return undef;
    }

    DEBUG "Received payload: ", $self->bytes_dump( @rest );

    return @rest;
}

1;

__END__