File Coverage

blib/lib/ControlX10/CM17.pm

Criterion	Covered	Total	%
statement	57	57	100.0
branch	27	30	90.0
condition			n/a
subroutine	5	5	100.0
pod	0	3	0.0
total	89	95	93.6

package ControlX10::CM17;

use strict;
use vars qw($VERSION $DEBUG @ISA @EXPORT @EXPORT_OK);

require Exporter;

@ISA = qw(Exporter);
@EXPORT= qw( send_cm17 );
@EXPORT_OK= qw();
($VERSION) = q$Revision: 0.07 $ =~ /: (\S+)/; # Note: cvs version reset when we moved to sourceforge
$DEBUG = 0;

#-----------------------------------------------------------------------------
#
# An X10 firecracker interface, used by Misterhouse ( http://misterhouse.net )
#
# Uses the Windows or Posix SerialPort.pm functions by Bill Birthisel,
#    available on CPAN
# Protocol documented at: http://www.x10.com/manuals/cm17a_proto.txt
#                         http://www.excel.net/~dpeterse/cm17a.htm
#
#-----------------------------------------------------------------------------

my %table_hcodes = qw(A 01100 B 01110 C 01000 D 01010 E 10000 F 10010 G 10100 H 10110
                      I 11100 J 11110 K 11000 L 11010 M 00000 N 00010 O 00100 P 00110);

my %table_dcodes = qw(1J 00000000000 1K 00000100000 2J 00000010000 2K 00000110000
                      3J 00000001000 3K 00000101000 4J 00000011000 4K 00000111000
                      5J 00001000000 5K 00001100000 6J 00001010000 6K 00001110000
                      7J 00001001000 7K 00001101000 8J 00001011000 8K 00001111000
                      9J 10000000000 9K 10000100000 AJ 10000010000 AK 10000110000
                      BJ 10000001000 BK 10000101000 CJ 10000011000 CK 10000111000
                      DJ 10001000000 DK 10001100000 EJ 10001010000 EK 10001110000
                      FJ 10001001000 FK 10001101000 GJ 10001011000 GK 10001111000
                      L  00010001000 M  00010011000 O  00010010000 N  00010100000 P 00010000000);

sub send_cm17 {
    return unless ( 2 == @_ );
    return ControlX10::CM17::send (@_);
}

sub send {
    my ($serial_port, $house_code) = @_;

    my ($house, $code) = $house_code =~ /(\S)(\S+)/;

    if (exists $main::config_parms{debug}) {
        $DEBUG = ($main::config_parms{debug} eq 'X10') ? 1 : 0;
    }
    print "CM17: $serial_port house=$house code=$code\n" if $DEBUG;

    my $data = $table_hcodes{$house};
    unless ($data) {
        print "CM17.pm error. Invalid house code: $house\n";
        return;
    }
                                # Check for +-## brighten/dim commands (e.g. 7+5  F-95)
                                # Looks like it takes 7 levels to go full bright/dim (14%).
    if ($code =~ /(\S)([\+\-])(\d+)/) {
        my $device= $1;
        my $dir   = $2;
        my $level = $3;
	my $ok;
        print "Running CM17 dim/bright loop: device=$device $dir=$dir level=$level\n" if $DEBUG;
                                # The CM17 dim/bright has not device address, so we must first
                                # address the device (need to make sure it is on anyway)
        &send($serial_port, $house . $device . 'J');
        my $code = ($dir eq '+') ? 'L' : 'M';
        while ($level >= 0) {
            $ok = &send($serial_port, $house . $code);
            $level -= 14;
        }
        return $ok;
    }

                                # Check for #J/#K or L/M/O/N
    my $data2 = $table_dcodes{$code};
    $data2 = $table_dcodes{substr($code, 1)} unless $data2;

    unless ($data2) {
        print "CM17.pm error. Invalid device code: $code.\n";
        return;
    }
                                # Header + data + footer = 40 bits
    &send_bits($serial_port, '1101010110101010' . $data . $data2 . '10101101');
}

sub send_bits {
    my ($serial_port, $bits) = @_;
    my @bits = split //, $bits;

                                # Reset the device
    $serial_port->dtr_active(0);
    $serial_port->rts_active(0);
    select (undef, undef, undef, .100); # How long??


                                # Turn the device on
    $serial_port->dtr_active(1);
    $serial_port->rts_active(1);
    select (undef, undef, undef, .20);  # How long??

    print "CM17: Sending: " if $DEBUG;
    while (@bits) {
        my $bit = shift @bits;

        if ($bit) {
            $serial_port->pulse_dtr_off(1);
            print "1" if $DEBUG;
        }
        else {
            $serial_port->pulse_rts_off(1);
            print "0" if $DEBUG;
        }
    }
                                # Leave the device on till switch occurs ... emperically derived
                                #  - 50->70  ms seemed to be the minnimum
    $serial_port->dtr_active(1);
    $serial_port->rts_active(1);
    select (undef, undef, undef, .150);

    print " done\n" if $DEBUG;

                                # Turn the device off
    $serial_port->dtr_active(0);
    $serial_port->rts_active(0);

}

1;           # for require
__END__