The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
###########################################
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.03";

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,
        %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}";

    $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__

=head1 NAME

X10::Home - Configure X10 for your Home

=head1 SYNOPSIS

    # System-wide /etc/x10.conf Configuration File

    module: ControlX10::CM11
    device: /dev/ttyS0
    receivers:  
      - name: bedroom_lights
        code: K15
        desc: Bedroom Lights
      - name: dsl_router
        code: ...

    # In your application:

    use X10::Home;
    my $x10 = X10::Home->new();
      # Address services by name
    $x10->send("bedroom_lights", "on");

=head1 DESCRIPTION

C<X10::Home> lets you set parameters of all your home X10 devices in a
single configuration file. After that's done, applications can access
them by name and without worrying about details like "house codes",
"unit codes", "serial ports", X10 commands and other low-level details.

C<X10::Home> also maintains a status database to remember the assumed
status of cheap X10 devices without a feedback mechanism.

=head2 Usage

After a one-time setup of the C<x10.conf> file, to switch the bedroom
lights on, simply use

    use X10::Home;
    my $x10->X10::Home->new();
    $x10->send("bedroom_lights", "on");

and

    $x10->send("bedroom_lights", "off");

to switch them off again.

C<X10::Home> uses the C<ControlX10::CM11> or C<ControlX10::CM17> CPAN
modules under the hood to send actual X10 commands via the
computer's serial port.

=head2 Configuration File

Upon initialization, C<X10::Home> will search a configuration file
in the following locations (in the order listed):

=over 4

=item *

If C<X10::Home::new()> gets called with the C<conf_file> parameter
set, the configuration will be read from C<conf_file>.

=item * 

C<~/.x10.conf> (in the user's local home directory) if present

=item *

C</etc/x10.conf> if present

=back

The configuration file is written in YAML format and looks like this:

    # /etc/x10.conf Configuration File

    module:   ControlX10::CM11
    device:   /dev/ttyS0
    baudrate: 4800

    receivers:  
      - name: bedroom_lights
        code: K15
        desc: Bedroom Lights
      - name: dsl_router
        code: K16
        desc: DSL Router

The C<module> parameter specifies which X10 low-level module
to use, C<ControlX10::CM11> or C<ControlX10::CM17>, it defaults
to C<ControlX10::CM11>.

The C<device> parameter specifies the device entry of the serial port 
to use, it defaults to C</dev/ttyS0>. This can be C</dev/ttyS4> or
C</dev/ttyS5> if a serial PCI card gets plugged into the computer.

The C<baudrate> is the baud rate to be used to communicate over the serial 
port. It defaults to 4800.

The C<receivers> parameter specifies an array of receivers. The reason
why this is an array an not a hash is that certain applications like to
display all available receivers in a predefined order. Receivers are
hashed internally by C<X10::Home> by their C<name> entries for quick 
lookups, though.

=head2 METHODS

=over 4

=item C<new()>

Constructor. Optional parameters are 

=over 4

=item C<conf_file>

to specify the path to a special x10.conf file instead of the natural
search order of system x10.conf files.

=item C<db_file>

to indicate that C<X10::Home> should be maintaining a persistent data
store with assumed device status. Defaults to C</tmp/x10.status>.
To check/manipulate the maintained status, see C<db_status> below.

=back

=item C<send($name, $action)>

Sends a message to the specified X10 receiver. Uses locking 
(see C<lock/unlock> below)
internally
to make sure that no other X10 commands are sent over the wire by this
sender at the same time, which would confuse the receivers.

=item C<lock()>

Aquire an exclusive lock.

=item C<unlock()>

Release the previously acquired exclusive lock.

=item C<db_status($field, [$value])>

For persistent storage of assumed device status, C<X10::Home> maintains
a file-based data store (if the constructor is called with the C<db_file>
parameter set to a persistent datastore location). 
If a device gets switched on or off,
C<X10::Home> will make a note of that in the data store. To query the
(assumed) status of a device, use

    my $x10 = X10::Home( db_file => "/tmp/x10.status" );

    if( $x10->db_status("bedroom_lights") eq "on" ) {
        print "Bedroom lights are on!\n";
    }

=head1 Sample Applications

The C<eg> directory contains a command line application C<x10> which 
allows you to run X10 commands from the command line, e.g.

    $ x10 office_lights on

or 

    $ x10 office_lights status
    on

The C<eg> directory also contains an AJAXed X10 web application, check
out C<x10.cgi> and read the installation instructions at the top of
the file.

=back

=head1 LEGALESE

Copyright 2007 by Mike Schilli, all rights reserved.
This program is free software, you can redistribute it and/or
modify it under the same terms as Perl itself.

=head1 AUTHOR

2007, Mike Schilli <m@perlmeister.com>