File Coverage

blib/lib/Device/W800.pm

Criterion	Covered	Total	%
statement	60	60	100.0
branch	8	8	100.0
condition			n/a
subroutine	12	12	100.0
pod	2	2	100.0
total	82	82	100.0

use strict;
use warnings;
package Device::W800;
$Device::W800::VERSION = '1.142010';
# ABSTRACT: Module to support W800 RF receiver


use 5.006;
use constant DEBUG => $ENV{DEVICE_W800_DEBUG};
use Carp qw/croak/;
use base 'Device::RFXCOM::RX';
use Device::RFXCOM::Response;


sub new {
  my ($pkg, %p) = @_;
  my @plugins;
  # TODO: Make 32-bit support a class method on the decoder so
  # this process (to restrict the plugins to a useful set) is
  # encapsulated better.
  foreach my $decoder (qw/RFXSensor X10 X10Security/) {
    my $module = 'Device::RFXCOM::Decoder::'.$decoder;
    my $file = 'Device/RFXCOM/Decoder/'.$decoder.'.pm';
    require $file; import $module;
    push @plugins, $module->new();
  }
  $pkg->SUPER::new(device => '/dev/w800', plugins => \@plugins, %p);
}

sub _write {
  croak "Writes not supported for W800: @_\n";
}

sub _write_now {
  # do nothing
}

sub _init {
  my $self = shift;
  $self->{init} = 1;
}


sub read_one {
  my ($self, $rbuf) = @_;
  return unless ($$rbuf);

  print STDERR "rbuf=", (unpack "H*", $$rbuf), "\n" if DEBUG;
  my $bits = 32;
  my $length = 4;
  my %result =
    (
     master => 1,
     header_byte => $bits,
     type => 'unknown',
    );
  my $msg = '';
  my @bytes;

  return if (length $$rbuf < $length);

  $msg = substr $$rbuf, 0, $length, ''; # message from buffer
  @bytes = unpack 'C*', $msg;

  $result{key} = $bits.'!'.$msg;
  my $entry = $self->_cache_get(\%result);
  if ($entry) {
    print STDERR "using cache entry\n" if DEBUG;
    @result{qw/messages type/} = @{$entry->{result}}{qw/messages type/};
    $self->_cache_set(\%result);
  } else {
    foreach my $decoder (@{$self->{plugins}}) {
      my $matched = $decoder->decode($self, $msg, \@bytes, $bits, \%result)
        or next;
      ($result{type} = lc ref $decoder) =~ s/.*:://;
      last;
    }
    $self->_cache_set(\%result);
  }

  @result{qw/data bytes/} = ($msg, \@bytes);
  return Device::RFXCOM::Response->new(%result);
}

1;

__END__