281 lines
7.1 KiB
Perl
Executable File
281 lines
7.1 KiB
Perl
Executable File
#!/usr/bin/perl -wT
|
|
#
|
|
# ==========================================================================
|
|
#
|
|
# Zone Minder X10 Control Script, $Date$, $Revision$
|
|
# Copyright (C) 2002 Philip Coombes
|
|
#
|
|
# This program is free software; you can redistribute it and/or
|
|
# modify it under the terms of the GNU General Public License
|
|
# as published by the Free Software Foundation; either version 2
|
|
# of the License, or (at your option) any later version.
|
|
#
|
|
# This program is distributed in the hope that it will be useful,
|
|
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
# GNU General Public License for more details.
|
|
#
|
|
# You should have received a copy of the GNU General Public License
|
|
# along with this program; if not, write to the Free Software
|
|
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
|
|
#
|
|
# ==========================================================================
|
|
#
|
|
# This script controls the monitoring of the X10 interface and the consequent
|
|
# management of the ZM daemons based on the receipt of X10 signals.
|
|
#
|
|
|
|
# ==========================================================================
|
|
#
|
|
# These are the elements you need to edit to suit your installation
|
|
#
|
|
# ==========================================================================
|
|
use constant X10_DEVICE => '/dev/ttyS1';
|
|
use constant X10_HOUSE_CODE => 'K';
|
|
use constant X10_SOCK_FILE => '/tmp/zmx10.sock';
|
|
use constant X10_LOG_FILE => '/tmp/zmx10.log';
|
|
|
|
# ==========================================================================
|
|
#
|
|
# Don't change anything below here
|
|
#
|
|
# ==========================================================================
|
|
|
|
use strict;
|
|
|
|
use POSIX;
|
|
#use DBI;
|
|
use Socket;
|
|
use Getopt::Long;
|
|
use Data::Dumper;
|
|
use X10::ActiveHome;
|
|
|
|
$| = 1;
|
|
|
|
sub Usage
|
|
{
|
|
print( "
|
|
Usage: zmx10.pl -c <command>,--command=<command> [-u <unit code>,--unit-code=<unit code>]
|
|
Parameters are :-
|
|
-c <command>, --command=<command> - Command to issue, one of 'on','off','dim','bright','status','shutdown'
|
|
-u <unit code>, --unit-code=<unit code> - Unit code to act on required for all commands except 'status' (optional) and 'shutdown'
|
|
");
|
|
exit( -1 );
|
|
}
|
|
|
|
my $command;
|
|
my $unit_code;
|
|
|
|
if ( !GetOptions( 'command=s'=>\$command, 'unit-code=i'=>\$unit_code ) )
|
|
{
|
|
Usage();
|
|
}
|
|
|
|
die( "No command given" ) unless( $command );
|
|
die( "No unit code given" ) unless( $unit_code || ($command eq 'status' || $command eq 'shutdown') );
|
|
|
|
socket( CLIENT, PF_UNIX, SOCK_STREAM, 0 ) or die( "Can't open socket: $!" );
|
|
|
|
my $saddr = sockaddr_un( X10_SOCK_FILE );
|
|
|
|
if ( !connect( CLIENT, $saddr ) )
|
|
{
|
|
# The server isn't there
|
|
print( "Unable to connect, starting server\n" );
|
|
close( CLIENT );
|
|
|
|
if ( my $cpid = fork() )
|
|
{
|
|
# Parent process just sleep and fall through
|
|
sleep( 2 );
|
|
socket( CLIENT, PF_UNIX, SOCK_STREAM, 0 ) or die( "Can't open socket: $!" );
|
|
connect( CLIENT, $saddr ) or die( "Can't connect: $!" );
|
|
}
|
|
elsif ( defined($cpid) )
|
|
{
|
|
setpgrp();
|
|
|
|
open( LOG, '>>'.X10_LOG_FILE ) or die( "Can't open log file: $!" );
|
|
select( LOG );
|
|
$| = 1;
|
|
print( LOG "X10 server starting at ".strftime( '%y/%m/%d %H:%M:%S', localtime() )."\n" );
|
|
|
|
socket( SERVER, PF_UNIX, SOCK_STREAM, 0 ) or die( "Can't open socket: $!" );
|
|
unlink( X10_SOCK_FILE );
|
|
bind( SERVER, $saddr ) or die( "Can't bind: $!" );
|
|
listen( SERVER, SOMAXCONN ) or die( "Can't listen: $!" );
|
|
|
|
( $ENV{PATH} ) = ( $ENV{PATH} =~ /^(.*)$/ );
|
|
|
|
my %device_hash;
|
|
|
|
sub dprint
|
|
{
|
|
if ( fileno(CLIENT) )
|
|
{
|
|
print CLIENT @_
|
|
}
|
|
else
|
|
{
|
|
print @_;
|
|
}
|
|
}
|
|
|
|
my $x10 = new X10::ActiveHome( port=>X10_DEVICE, house_code=>X10_HOUSE_CODE, debug=>1 );
|
|
|
|
sub x10listen
|
|
{
|
|
foreach my $event ( @_ )
|
|
{
|
|
#print( Dumper( $_ )."\n" );
|
|
if ( $event->house_code() eq X10_HOUSE_CODE )
|
|
{
|
|
my $unit_code = $event->unit_code();
|
|
my $device = $device_hash{$unit_code};
|
|
if ( !$device )
|
|
{
|
|
$device = $device_hash{$unit_code} = $x10->Appliance( unit_code=>$unit_code );
|
|
}
|
|
$device->{status} = $event->func();
|
|
}
|
|
print( LOG strftime( "%y/%m/%d %H:%M:%S", localtime() )." - ".$event->as_string()."\n" );
|
|
}
|
|
}
|
|
|
|
$x10->register_listener( \&x10listen );
|
|
|
|
my $rin = '';
|
|
vec( $rin, fileno(SERVER),1) = 1;
|
|
vec( $rin, $x10->select_fds(),1) = 1;
|
|
my $timeout = 60;
|
|
#print( "F:".fileno(SERVER)."\n" );
|
|
while( 1 )
|
|
{
|
|
my $nfound = select( my $rout = $rin, undef, undef, $timeout );
|
|
#print( "Off select, NF:$nfound, ER:$!\n" );
|
|
#print( vec( $rout, fileno(SERVER),1)."\n" );
|
|
#print( vec( $rout, $x10->select_fds(),1)."\n" );
|
|
if ( $nfound > 0 )
|
|
{
|
|
if ( vec( $rout, fileno(SERVER),1) )
|
|
{
|
|
my $paddr = accept( CLIENT, SERVER );
|
|
my $message = <CLIENT>;
|
|
|
|
my ( $command, $unit_code ) = split( ';', $message );
|
|
|
|
my $device;
|
|
if ( defined($unit_code) )
|
|
{
|
|
if ( $unit_code < 1 || $unit_code > 16 )
|
|
{
|
|
dprint( "Error, invalid unit code '$unit_code'\n" );
|
|
next;
|
|
}
|
|
|
|
$device = $device_hash{$unit_code};
|
|
if ( !$device )
|
|
{
|
|
$device = $device_hash{$unit_code} = $x10->Appliance( unit_code=>$unit_code );
|
|
$device->{status} = 'unknown';
|
|
}
|
|
}
|
|
|
|
my $result;
|
|
if ( $command eq 'on' )
|
|
{
|
|
$result = $device->on();
|
|
}
|
|
elsif ( $command eq 'off' )
|
|
{
|
|
$result = $device->off();
|
|
}
|
|
elsif ( $command eq 'dim' )
|
|
{
|
|
$result = $device->dim();
|
|
}
|
|
elsif ( $command eq 'bright' )
|
|
{
|
|
$result = $device->bright();
|
|
}
|
|
elsif ( $command eq 'status' )
|
|
{
|
|
if ( $device )
|
|
{
|
|
dprint( $device->address()." ".$device->{status}."\n" );
|
|
}
|
|
else
|
|
{
|
|
foreach my $unit_code ( sort( keys(%device_hash) ) )
|
|
{
|
|
my $device = $device_hash{$unit_code};
|
|
dprint( $device->address()." ".$device->{status}."\n" );
|
|
}
|
|
}
|
|
}
|
|
elsif ( $command eq 'shutdown' )
|
|
{
|
|
last;
|
|
}
|
|
else
|
|
{
|
|
dprint( "Error, invalid command '$command'\n" );
|
|
}
|
|
if ( defined($result) )
|
|
{
|
|
if ( 1 || $result )
|
|
{
|
|
$device->{status} = $command;
|
|
dprint( $device->address()." $command, ok\n" );
|
|
}
|
|
else
|
|
{
|
|
dprint( $device->address()." $command, failed\n" );
|
|
}
|
|
}
|
|
close( CLIENT );
|
|
}
|
|
elsif ( vec( $rout, $x10->select_fds(),1) )
|
|
{
|
|
$x10->handle_input();
|
|
}
|
|
else
|
|
{
|
|
die( "Bogus descriptor" );
|
|
}
|
|
}
|
|
elsif ( $nfound < 0 )
|
|
{
|
|
die( "Can't select: $!" );
|
|
}
|
|
else
|
|
{
|
|
#print( "Select timed out\n" );
|
|
# Maybe do something administrative, not sure what though!
|
|
}
|
|
}
|
|
print( LOG "X10 server exiting at ".strftime( '%y/%m/%d %H:%M:%S', localtime() )."\n" );
|
|
close( LOG );
|
|
close( SERVER );
|
|
exit();
|
|
}
|
|
else
|
|
{
|
|
die( "Can't fork: $!" );
|
|
}
|
|
}
|
|
# The server is there, connect to it
|
|
#print( "Writing commands\n" );
|
|
CLIENT->autoflush();
|
|
my $message = "$command";
|
|
$message .= ";$unit_code" if ( $unit_code );
|
|
print( CLIENT $message );
|
|
shutdown( CLIENT, 1 );
|
|
while ( my $line = <CLIENT> )
|
|
{
|
|
chomp( $line );
|
|
print( "$line\n" );
|
|
}
|
|
close( CLIENT );
|
|
#print( "Finished writing, bye\n" );
|