File Coverage

blib/lib/X10/Home.pm

Criterion	Covered	Total	%
statement	19	21	90.4
branch			n/a
condition			n/a
subroutine	7	7	100.0
pod			n/a
total	26	28	92.8

###########################################
package X10::Home;
###########################################
use strict;
use warnings;
use YAML qw(LoadFile);
use Log::Log4perl qw(:easy);
use Device::SerialPort;
use Fcntl qw/:flock/;
use DB_File;

our $VERSION = "0.04";

my @CONF_PATHS = (
    glob("~/.x10.conf"),
    "/etc/x10.conf",
);

my($STATUS_FILE) = glob("~/.x10.status");

###########################################
sub new {
###########################################
    my($class, %options) = @_;

    my $self = {
        conf_paths => \@CONF_PATHS,
        conf_file  => undef,
        commands   => {
          on     => "J",
          off    => "K",
          status => undef,
        },
        lockfile   => '/tmp/x10_home.lock',
        db_file    => "/tmp/x10.status",
        db_perm    => 0666,
        probe      => 1,
        %options,
    };

    bless $self, $class;

    $self->init();

    return $self;
}

###########################################
sub init {
###########################################
    my($self) = @_;

    if(defined $self->{conf_file}) {
        $self->{conf} = LoadFile( $self->{conf_file} );
    } else {
        for my $path (@{ $self->{conf_paths} }) {
            if(-f $path) {
                $self->{conf} = LoadFile( $path );
                last;
            }
        }
    }

    LOGDIE "No configuration file found (searched ",
           join (", ", @{ $self->{conf_paths} }),
           ")" unless defined $self->{conf};

    if(ref( $self->{conf} ) ne "HASH") {
        LOGDIE "Configuration file invalid (not a hash)";
    }

    $self->{conf}->{device}   ||= "/dev/ttyS0";
    $self->{conf}->{module}   ||= "ControlX10::CM11";
    $self->{conf}->{baudrate} ||= 4800;

    eval "require $self->{conf}->{module}";

    if($self->{probe}) {
        $self->{serial} = Device::SerialPort->new(
            $self->{conf}->{device}, undef);

        $self->{serial}->baudrate($self->{conf}->{baudrate});
    }

    $self->{receivers} = {
        map { $_->{name} => $_ } @{$self->{conf}->{receivers}} };

    $self->db_init() if defined $self->{db_file};

    1;
}

###########################################
sub db_init {
###########################################
    my($self) = @_;

    $self->{dbm} = {};

    dbmopen(%{$self->{dbm}},
        $self->{db_file}, 0666) or
        LOGDIE "Cannot open $self->{db_file}";

    chmod $self->{db_perm}, $self->{db_file};

    for (keys %{$self->{receivers}}) {
        my $receiver = $self->{receivers}->{$_};
        $self->{dbm}->{ $receiver->{name} } ||= "off";
    }

    1;
}

###########################################
sub db_status {
###########################################
    my($self, $field, $value) = @_;

    if(defined $value) {
        $self->{dbm}->{ $field } = $value;
    }

    return $self->{dbm}->{ $field };
}

###########################################
sub send {
###########################################
    my($self, $receiver, $cmd) = @_;

    if(! exists $self->{receivers}->{$receiver}) {
        ERROR "Unknown receiver '$receiver'";
        return undef;
    }

    if(! exists $self->{commands}->{$cmd}) {
        ERROR "Unknown command '$cmd'";
        return undef;
    }

    my($house_code, $unit_code) = split //,
        $self->{receivers}->{$receiver}->{code}, 2;

    my $send = "$self->{conf}->{module}" . "::" . "send";

    $self->lock();

    {
      no strict 'refs';

      DEBUG "Addressing HC=$house_code UC=$unit_code";
      $send->($self->{serial}, $house_code . $unit_code);

      DEBUG "Sending command $cmd $self->{commands}->{$cmd}";
      $send->($self->{serial},
                    $house_code .
                    $self->{commands}->{$cmd});
    }

    if(defined $self->{db_file}) {
        DEBUG "Setting db status of $receiver to $cmd";
        $self->db_status($receiver, $cmd);
    }

    $self->unlock();

    1;
}

###########################################
sub lock {
###########################################
    my($self) = @_;

    open my $fh, ">>$self->{lockfile}" or
        LOGDIE "Cannot open lockfile $self->{lockfile} ($!)";
    flock($fh, LOCK_EX);

    $self->{fh} = $fh;
}

###########################################
sub unlock {
###########################################
    my($self) = @_;

    if(! defined $self->{fh}) {
        LOGDIE "Called unlock without previous lock";
    }

    flock($self->{fh}, LOCK_UN);
    close $self->{fh};
    $self->{fh} = undef;
    unlink $self->{lockfile};
}

###########################################
sub receivers {
###########################################
    my($self) = @_;
    return keys %{$self->{receivers}};
}

###########################################
sub command_valid {
###########################################
    my($self, $command) = @_;

    return exists $self->{commands}->{$command};
}

###########################################
sub DESTROY {
###########################################
    my($self) = @_;

    dbmclose(%{$self->{dbm}});
}

1;

__END__