File Coverage

blib/lib/Device/RFXCOM/Encoder/X10.pm

Criterion	Covered	Total	%
statement	46	46	100.0
branch	10	10	100.0
condition			n/a
subroutine	9	9	100.0
pod	1	1	100.0
total	66	66	100.0

use strict;
use warnings;
package Device::RFXCOM::Encoder::X10;
$Device::RFXCOM::Encoder::X10::VERSION = '1.142010';
# ABSTRACT: Device::RFXCOM::Encoder::X10 encode X10 RF messages


use 5.006;
use constant DEBUG => $ENV{DEVICE_RFXCOM_ENCODER_X10_DEBUG};
use Carp qw/croak carp/;
use base 'Device::RFXCOM::Encoder';
use Device::RFXCOM::Response::X10;

my %command_to_byte =
  (
   'dim' => 0x98,
   'bright' => 0x88,
   'all_lights_on' => 0x90,
   'all_lights_off' => 0x80,
   'on' => 0x0,
   'off' => 0x20,
  );
my $i = 0;
my %house_to_byte =
  map { $_ => $i++ } ('m', 'n', 'o', 'p', 'c', 'd', 'a', 'b',
                      'e', 'f', 'g', 'h', 'k', 'l', 'i', 'j');

$i = 1;
my %bytes_to_unit =
  map { $_ => $i++ } ( 0x00, 0x10, 0x08, 0x18, 0x40, 0x50, 0x48, 0x58 );
my %unit_to_bytes = reverse %bytes_to_unit;


sub encode {
  my ($self, $parent, $p) = @_;
  my @res = ();
  if ($p->{house}) {
    foreach (split //, $p->{house}) {
      push @res, $self->_encode_x10({
                                     command => $p->{command},
                                     house => $p->{house},
                                    });
    }
  } elsif ($p->{device}) {
    foreach (split /,/, $p->{device}) {
      my ($house, $unit) = /^([a-p])(\d+)$/i or next;
      push @res, $self->_encode_x10({
                                     command => $p->{command},
                                     house => $house,
                                     unit => $unit,
                                    });
    }
  } else {
    carp $self.'->encode: Invalid x10 message';
  }
  return \@res;
}

sub _encode_x10 {
  my ($self, $p) = @_;
  my @bytes = ( 0, 0, 0, 0 );
  $bytes[2] |= $command_to_byte{lc $p->{command}};
  $bytes[0] |= ($house_to_byte{lc $p->{house}})<<4;
  my $unit = $p->{unit};
  unless ($bytes[2]&0x80) {
    if ($unit > 8) {
      $unit -= 8;
      $bytes[0] |= 0x4;
    }
    $bytes[2] |= $unit_to_bytes{$unit};
  }
  $bytes[1] = $bytes[0]^0xff;
  $bytes[3] = $bytes[2]^0xff;
  return { raw => (pack 'C5', 32, @bytes),
           desc =>
           'x10: '.(join '/',
                          grep { defined $_
                               } @{$p}{qw/command house unit/})
         };
}

1;

__END__