1133 lines
30 KiB
Perl
Executable file
1133 lines
30 KiB
Perl
Executable file
#!/usr/bin/perl
|
|
######################################################################
|
|
#
|
|
# tellstickControllerTdtool program
|
|
#
|
|
# Copyright (C) 2008-2010 Rickard Andersson (ran42ran@gmail.com)
|
|
# Version 2.0.0
|
|
#
|
|
######################################################################
|
|
#
|
|
# 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 3 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, see <http://www.gnu.org/licenses/>.
|
|
#
|
|
######################################################################
|
|
|
|
|
|
use warnings;
|
|
use strict;
|
|
use sigtrap 'handler', \&daemon_exit, 'normal-signals';
|
|
use sigtrap 'die', 'untrapped', 'normal-signals';
|
|
use sigtrap 'stack-trace', 'any', 'error-signals';
|
|
use POSIX 'setsid';
|
|
|
|
|
|
use DateTime;
|
|
use DateTime::Event::Sunrise;
|
|
|
|
|
|
######################################################################
|
|
|
|
|
|
# All these cfg settings can be altered from the configuration file.
|
|
#
|
|
my %cfg_set = (
|
|
"configfile" => "/etc/tellstickController.conf",
|
|
"logfile" => "/var/log/tellstickController.log",
|
|
"pidfile" => "/var/run/tellstickController.pid",
|
|
"program" => "/usr/bin/tdtool",
|
|
"altitude" => "-0.833",
|
|
"latitude" => "58.24",
|
|
"longitude" => "15.31",
|
|
"timezone" => "Europe/Stockholm",
|
|
);
|
|
|
|
|
|
######################################################################
|
|
|
|
|
|
my %cfg_group = ();
|
|
my %cfg_groupId = ();
|
|
my %cfg_idGroup = ();
|
|
my %cfg_alias = ();
|
|
my %cfg_aliasId = ();
|
|
my %cfg_idAlias = ();
|
|
my @cfg_rule = ();
|
|
my %option = (
|
|
"aliases" => 0,
|
|
"check" => 0,
|
|
"daemon" => 0,
|
|
"list" => 0,
|
|
"device" => "",
|
|
"state" => "",
|
|
"swapfirst" => 0,
|
|
"swap" => 0,
|
|
"test" => 0,
|
|
"verbose" => 0,
|
|
);
|
|
my @device = ();
|
|
|
|
|
|
######################################################################
|
|
|
|
|
|
sub check_args(@) {
|
|
my (@args) = @_;
|
|
|
|
if (not @args) {
|
|
usage();
|
|
exit;
|
|
}
|
|
while (@args) {
|
|
if ($args[0] =~ /^-(h|-help)$/) {
|
|
usage();
|
|
exit;
|
|
} elsif ($args[0] =~ /^-(a|-aliases)$/) {
|
|
shift(@args);
|
|
$option{"aliases"} = 1;
|
|
next;
|
|
} elsif ($args[0] =~ /^-(c|-check)$/) {
|
|
shift(@args);
|
|
$option{"check"} = 1;
|
|
next;
|
|
} elsif ($args[0] =~ /^-(d|-daemon)$/) {
|
|
shift(@args);
|
|
$option{"daemon"} = 1;
|
|
next;
|
|
} elsif ($args[0] =~ /^-(f|-file)$/) {
|
|
shift(@args);
|
|
$cfg_set{"configfile"} = shift(@args);
|
|
next;
|
|
} elsif ($args[0] =~ /^-(g|-get)$/) {
|
|
shift(@args);
|
|
$option{"get"} = 1;
|
|
$option{"device"} = lc($args[0]);
|
|
shift(@args);
|
|
next;
|
|
} elsif ($args[0] =~ /^-(l|-list)$/) {
|
|
shift(@args);
|
|
$option{"list"} = 1;
|
|
next;
|
|
} elsif ($args[0] =~ /^-(s|-set)$/) {
|
|
shift(@args);
|
|
$option{"set"} = 1;
|
|
$option{"device"} = lc($args[0]);
|
|
shift(@args);
|
|
$option{"state"} = lc($args[0]);
|
|
shift(@args);
|
|
next;
|
|
} elsif ($args[0] =~ /^-(w|-swapfirst)$/) {
|
|
shift(@args);
|
|
$option{"swapfirst"} = 1;
|
|
$option{"device"} = lc($args[0]);
|
|
shift(@args);
|
|
next;
|
|
} elsif ($args[0] =~ /^-(x|-swap)$/) {
|
|
shift(@args);
|
|
$option{"swap"} = 1;
|
|
$option{"device"} = lc($args[0]);
|
|
shift(@args);
|
|
next;
|
|
} elsif ($args[0] =~ /^-(t|-test)$/) {
|
|
shift(@args);
|
|
$option{"test"} = 1;
|
|
next;
|
|
} elsif ($args[0] =~ /^-(v|-verbose)$/) {
|
|
shift(@args);
|
|
$option{"verbose"} = 1;
|
|
next;
|
|
}
|
|
|
|
usage();
|
|
exit;
|
|
}
|
|
}
|
|
|
|
|
|
sub usage() {
|
|
while (<DATA>) {
|
|
if ($_ =~ /^#-(.*)/) {
|
|
print "$1\n";
|
|
}
|
|
}
|
|
}
|
|
|
|
|
|
sub printLine($) {
|
|
my ($text) = @_;
|
|
|
|
print "$text\n";
|
|
}
|
|
|
|
|
|
sub printlogger($) {
|
|
my ($text) = @_;
|
|
|
|
if ($option{"daemon"}) {
|
|
my $now = get_datetime_now();
|
|
my $logfile = $cfg_set{"logfile"};
|
|
my $output = "echo '$now $text' >> $logfile";
|
|
system ($output);
|
|
}
|
|
}
|
|
|
|
|
|
######################################################################
|
|
|
|
|
|
sub daemon_init() {
|
|
chdir "/";
|
|
umask 0;
|
|
my $pid = fork;
|
|
exit if $pid;
|
|
die "Couldn't fork program" unless defined(\$pid);
|
|
setsid() or die "Couldn't start new program session";
|
|
open STDIN, '/dev/null' or die "Couldn't read /dev/null!";
|
|
open STDOUT, '>/dev/null' or die "Couldn't write to /dev/null!";
|
|
open STDERR, '>/dev/null' or die "Couldn't write to /dev/null!";
|
|
|
|
my $pidfile = $cfg_set{"pidfile"};
|
|
$0="tellstickControllerDaemon";
|
|
$pid = $$;
|
|
system("echo $pid > $pidfile") if (defined($pidfile));
|
|
|
|
printlogger "> Daemon started";
|
|
}
|
|
|
|
|
|
sub daemon_exit() {
|
|
printlogger "> Daemon stopped";
|
|
|
|
unlink $cfg_set{"pidfile"} if (defined($cfg_set{"pidfile"}));
|
|
my $pid = $$;
|
|
kill('TERM', $pid);
|
|
exit;
|
|
}
|
|
|
|
|
|
sub get_datetime_now() {
|
|
my $now = DateTime->now(time_zone => $cfg_set{"timezone"});
|
|
|
|
return $now;
|
|
}
|
|
|
|
|
|
sub get_datetime_sunrise($) {
|
|
my ($now) = @_;
|
|
|
|
my $sunrise = DateTime::Event::Sunrise->sunrise (
|
|
altitude => $cfg_set{"altitude"},
|
|
latitude => $cfg_set{"latitude"},
|
|
longitude => $cfg_set{"longitude"},
|
|
iteration => '4'
|
|
);
|
|
my $time = $sunrise->next($now);
|
|
|
|
return $time;
|
|
}
|
|
|
|
|
|
sub get_datetime_sunset($) {
|
|
my ($now) = @_;
|
|
|
|
my $sunset = DateTime::Event::Sunrise->sunset (
|
|
altitude => $cfg_set{"altitude"},
|
|
latitude => $cfg_set{"latitude"},
|
|
longitude => $cfg_set{"longitude"},
|
|
iteration => '2'
|
|
);
|
|
my $time = $sunset->next($now);
|
|
|
|
return $time;
|
|
}
|
|
|
|
|
|
sub get_info_from_program() {
|
|
my $prog = $cfg_set{"program"};
|
|
my $command = "$prog --list";
|
|
my $text = "Executing command: '$command'";
|
|
printLine $text if ($option{"verbose"});
|
|
my @result = qx($command);
|
|
|
|
foreach my $line (@result) {
|
|
chomp($line);
|
|
$line =~ s/\s+/ /g;
|
|
|
|
if ($line =~ /^\d+/i) {
|
|
my ($id, $name, $state) = split(/\s+/, $line);
|
|
if (defined($name)) {
|
|
$cfg_alias{lc($name)} = 'off';
|
|
if (defined($state)) {
|
|
$cfg_alias{lc($name)} = lc($state);
|
|
}
|
|
if (defined($id)) {
|
|
$cfg_idAlias{lc($id)} = lc($name);
|
|
$cfg_aliasId{lc($name)} = lc($id);
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
|
|
sub read_config($) {
|
|
my ($infile) = @_;
|
|
|
|
my $text = "> Reading configurationfile started";
|
|
printLine $text if ($option{"verbose"});
|
|
printlogger $text;
|
|
|
|
open(my $indata, $infile) or die "Couldn't read configfile '$infile'!";
|
|
|
|
while(my $line = <$indata>) {
|
|
chomp($line);
|
|
$line =~ s/\s+/ /g;
|
|
|
|
if ($line =~ /^Set\s+/i) {
|
|
my (undef, $key, $val, $suffix) = split(/\s+/, $line);
|
|
if (defined($suffix)) {
|
|
printLine "Wrong argument '$suffix' in line '$line'!";
|
|
} else {
|
|
if (defined($key)) {
|
|
if (defined($val)) {
|
|
$cfg_set{lc($key)} = $val;
|
|
} else {
|
|
printLine "Wrong value in line '$line'!";
|
|
}
|
|
} else {
|
|
printLine "Wrong key in line '$line'!";
|
|
}
|
|
}
|
|
next;
|
|
}
|
|
}
|
|
|
|
close $indata;
|
|
|
|
get_info_from_program();
|
|
|
|
open($indata, $infile) or die "Couldn't read configfile '$infile'!";
|
|
|
|
while(my $line = <$indata>) {
|
|
chomp($line);
|
|
$line =~ s/\s+/ /g;
|
|
|
|
if ($line =~ /^Group\s+/i) {
|
|
my (undef, $name, $id, $delay, $aliases) = split(/\s+/, $line, 5);
|
|
$name = lc($name);
|
|
$delay = lc($delay);
|
|
if (defined $id) {
|
|
$cfg_idGroup{$id} = $name;
|
|
$cfg_groupId{$name} = $id;
|
|
}
|
|
if ($delay =~ /^\d+$/) {
|
|
my $error = 0;
|
|
$aliases = lc($aliases);
|
|
my @aliaslist = split(/\s+/, $aliases);
|
|
foreach my $alias (@aliaslist) {
|
|
if (! exists($cfg_alias{$alias})) {
|
|
printLine "Wrong alias '$alias' in line '$line'!";
|
|
$error += 1;
|
|
}
|
|
}
|
|
if ($error == 0) {
|
|
$cfg_group{$name} = "$delay $aliases";
|
|
}
|
|
} else {
|
|
printLine "Wrong delay time '$delay' in line '$line'!";
|
|
}
|
|
next;
|
|
}
|
|
|
|
if ($line =~ /^Rule\s+/i) {
|
|
my (undef, $alias, $on, $off, $suffix) = split(/\s+/, $line);
|
|
if (defined($suffix)) {
|
|
printLine "Wrong argument '$suffix' in line '$line'!";
|
|
} else {
|
|
$alias = lc($alias);
|
|
$on = lc($on);
|
|
$off = lc($off);
|
|
if ($on eq "") {
|
|
printLine "Wrong on time '$on' in line '$line'!";
|
|
} elsif ($off eq "") {
|
|
printLine "Wrong off time '$off' in line '$line'!";
|
|
} else {
|
|
if ($on !~ /[\w\/\+\-\:\$\(\)]+/) {
|
|
printLine "Wrong on time '$on' in line '$line'!";
|
|
} elsif ($off !~ /[\w\/\+\-\:\$\(\)]+/) {
|
|
printLine "Wrong off time '$off' in line '$line'!";
|
|
}
|
|
}
|
|
if (exists($cfg_alias{$alias})) {
|
|
push @cfg_rule, [$alias, $on, $off];
|
|
} elsif (exists($cfg_group{$alias})) {
|
|
push @cfg_rule, [$alias, $on, $off];
|
|
} else {
|
|
printLine "Wrong alias '$alias' in line '$line'!";
|
|
}
|
|
}
|
|
next;
|
|
}
|
|
}
|
|
|
|
close $indata;
|
|
|
|
$text = "=== Set ===";
|
|
printLine $text if ($option{"check"});
|
|
printlogger $text;
|
|
foreach my $key (sort keys %cfg_set) {
|
|
$text = "$key = $cfg_set{$key}";
|
|
printLine $text if ($option{"check"});
|
|
printlogger $text;
|
|
}
|
|
$text = "=== Alias ===";
|
|
printLine $text if ($option{"check"});
|
|
printlogger $text;
|
|
foreach my $key (sort keys %cfg_alias) {
|
|
$text = "$key($cfg_aliasId{$key}) = $cfg_alias{$key}";
|
|
printLine $text if ($option{"check"});
|
|
printlogger $text;
|
|
}
|
|
$text = "=== Group ===";
|
|
printLine $text if ($option{"check"});
|
|
printlogger $text;
|
|
foreach my $key (sort keys %cfg_group) {
|
|
my $val = $cfg_group{$key};
|
|
my ($delay, $aliases) = split(/\s+/, $val, 2);
|
|
$text = "$key($cfg_groupId{$key}) =";
|
|
$text .= " delay time $delay seconds";
|
|
$text .= " between aliases ($aliases)";
|
|
printLine $text if ($option{"check"});
|
|
printlogger $text;
|
|
}
|
|
$text = "=== Rule ===";
|
|
printLine $text if ($option{"check"});
|
|
printlogger $text;
|
|
foreach my $rule (@cfg_rule) {
|
|
my ($alias, $on, $off) = @$rule;
|
|
$text = "$alias =";
|
|
$text .= " on at $on" if ($on !~ /no/);
|
|
$text .= " and" if (($on !~ /no/) && ($off !~ /no/));
|
|
$text .= " off at $off" if ($off !~ /no/);
|
|
printLine $text if ($option{"check"});
|
|
printlogger $text;
|
|
}
|
|
|
|
$text = "> Reading configurationfile finished";
|
|
printLine $text if ($option{"verbose"});
|
|
printlogger $text;
|
|
}
|
|
|
|
|
|
sub call_program($$) {
|
|
my ($device, $state) = @_;
|
|
|
|
if ($option{"test"}) {
|
|
my $text = "Test mode, no real device will be used";
|
|
printLine $text if ($option{"verbose"});
|
|
printlogger $text;
|
|
} else {
|
|
my $mode = "--off";
|
|
if ($state eq "off") {
|
|
$mode = "--off";
|
|
} elsif ($state eq "on") {
|
|
$mode = "--on";
|
|
} elsif (($state >= 0) && ($state <= 255)) {
|
|
$mode = "--dimlevel $state --dim";
|
|
}
|
|
my $prog = $cfg_set{"program"};
|
|
my $command = "$prog $mode $device";
|
|
my $text = "Executing command: '$command'";
|
|
printLine $text if ($option{"verbose"});
|
|
system($command);
|
|
}
|
|
}
|
|
|
|
|
|
sub load_device_rules () {
|
|
my $text = "> Loading device rules started";
|
|
printLine $text if ($option{"verbose"});
|
|
printlogger $text;
|
|
|
|
my $now = get_datetime_now();
|
|
$text = "Time = $now";
|
|
printLine $text if ($option{"verbose"});
|
|
printlogger $text;
|
|
my $today = get_datetime_now();
|
|
$today->set( hour => 0, minute => 0, second => 0 );
|
|
$text = "Today = $today";
|
|
printLine $text if ($option{"verbose"});
|
|
printlogger $text;
|
|
my $sunrise = get_datetime_sunrise($today);
|
|
$text = "Sunrise = $sunrise";
|
|
printLine $text if ($option{"verbose"});
|
|
printlogger $text;
|
|
my $sunset = get_datetime_sunset($today);
|
|
$text = "Sunset = $sunset";
|
|
printLine $text if ($option{"verbose"});
|
|
printlogger $text;
|
|
|
|
foreach my $rule (@cfg_rule) {
|
|
my ($alias, $on, $off) = @$rule;
|
|
if (exists($cfg_alias{$alias})) {
|
|
my $time = get_rule_datetime($on, $today, $sunrise, $sunset);
|
|
my $value = 'on';
|
|
if ($on =~ /dimmer\((.*)\)/i) {
|
|
load_dimmer_rules($alias, $time, $on, $now, $today, $sunrise, $sunset);
|
|
} else {
|
|
push @device, [$time, $alias, $value] if (defined($time) && ($now <= $time));
|
|
}
|
|
$time = get_rule_datetime($off, $today, $sunrise, $sunset);
|
|
$value = 'off';
|
|
if ($off =~ /dimmer\((.*)\)/i) {
|
|
load_dimmer_rules($alias, $time, $off, $now, $today, $sunrise, $sunset);
|
|
} else {
|
|
push @device, [$time, $alias, $value] if (defined($time) && ($now <= $time));
|
|
}
|
|
} else {
|
|
foreach my $val ($cfg_group{$alias}) {
|
|
my ($delay, $aliases) = split(/\s+/, $val, 2);
|
|
my $timedelay = 0;
|
|
my $ontime = get_rule_datetime($on, $today, $sunrise, $sunset);
|
|
my $offtime = get_rule_datetime($off, $today, $sunrise, $sunset);
|
|
my (@aliaslist) = split(/\s+/, $aliases);
|
|
foreach my $device (@aliaslist) {
|
|
if (defined($ontime)) {
|
|
my $time = $ontime->clone->add(seconds => $timedelay);
|
|
my $value = 'on';
|
|
if ($on =~ /dimmer\((.*)\)/i) {
|
|
load_dimmer_rules($device, $time, $on, $now, $today, $sunrise, $sunset);
|
|
} else {
|
|
push @device, [$time, $device, $value] if (defined($time) && ($now <= $time));
|
|
}
|
|
}
|
|
if (defined($offtime)) {
|
|
my $time = $offtime->clone->add(seconds => $timedelay);
|
|
my $value = 'off';
|
|
if ($off =~ /dimmer\((.*)\)/i) {
|
|
load_dimmer_rules($device, $time, $off, $now, $today, $sunrise, $sunset);
|
|
} else {
|
|
push @device, [$time, $device, $value] if (defined($time) && ($now <= $time));
|
|
}
|
|
}
|
|
$timedelay += $delay;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
@device = sort { $a->[0] cmp $b->[0] } @device;
|
|
|
|
$text = "=== Device ===";
|
|
printLine $text if ($option{"verbose"});
|
|
printlogger $text;
|
|
foreach my $rule (@device) {
|
|
my ($time, $alias, $value) = @$rule;
|
|
$text = "$alias = $value at $time";
|
|
printLine $text if ($option{"verbose"});
|
|
printlogger $text;
|
|
}
|
|
|
|
$text = "> Loading device rules finished";
|
|
printLine $text if ($option{"verbose"});
|
|
printlogger $text;
|
|
}
|
|
|
|
|
|
sub get_rule_datetime($$$$) {
|
|
my ($rule, $now, $sunrise, $sunset) = @_;
|
|
|
|
my ($date, $time) = split(/\//, $rule);
|
|
if (not defined($time)) {
|
|
$time = $date;
|
|
$date = $now->ymd;
|
|
} else {
|
|
my $today = 0;
|
|
my $match = 0;
|
|
if ($date =~ /([\d#]{4})-([\d#]{2})-([\d#]{2})/) {
|
|
$match = 1;
|
|
$today = 1 if ((($1 =~ /####/) || ($now->year == $1))
|
|
&& (($2 =~ /##/) || ($now->month == $2))
|
|
&& (($3 =~ /##/) || ($now->day == $3)));
|
|
}
|
|
if ($date =~ /workweek/) {
|
|
$match = 1;
|
|
$today = 1 if ($now->day_of_week < 6);
|
|
}
|
|
if ($date =~ /weekend/) {
|
|
$match = 1;
|
|
$today = 1 if ($now->day_of_week > 5);
|
|
}
|
|
if ($date =~ /monday/) {
|
|
$match = 1;
|
|
$today = 1 if ($now->day_of_week == 1);
|
|
}
|
|
if ($date =~ /tuesday/) {
|
|
$match = 1;
|
|
$today = 1 if ($now->day_of_week == 2);
|
|
}
|
|
if ($date =~ /wednesday/) {
|
|
$match = 1;
|
|
$today = 1 if ($now->day_of_week == 3);
|
|
}
|
|
if ($date =~ /thursday/) {
|
|
$match = 1;
|
|
$today = 1 if ($now->day_of_week == 4);
|
|
}
|
|
if ($date =~ /friday/) {
|
|
$match = 1;
|
|
$today = 1 if ($now->day_of_week == 5);
|
|
}
|
|
if ($date =~ /saturday/) {
|
|
$match = 1;
|
|
$today = 1 if ($now->day_of_week == 6);
|
|
}
|
|
if ($date =~ /sunday/) {
|
|
$match = 1;
|
|
$today = 1 if ($now->day_of_week == 7);
|
|
}
|
|
|
|
if ($match) {
|
|
if ($today) {
|
|
$date = $now->ymd;
|
|
} else {
|
|
$time = undef;
|
|
}
|
|
} else {
|
|
printLine "Wrong date '$date' for rule '$rule'!";
|
|
$time = undef;
|
|
}
|
|
}
|
|
|
|
if (defined($time) && ($time !~ /^no$/)) {
|
|
my $days = 0;
|
|
my $hours = 0;
|
|
my $minutes = 0;
|
|
my $lastOp = "+";
|
|
my $expr = "";
|
|
my $op = "";
|
|
my $rest = "";
|
|
my $mins = 0;
|
|
|
|
while ($time ne "") {
|
|
$op = $lastOp;
|
|
if ($time =~ /(.+?)(\+|-)(.*)/) {
|
|
$expr = $1;
|
|
$lastOp = $2;
|
|
$rest = $3;
|
|
$time = $rest;
|
|
} elsif ($time =~ /(.+)/) {
|
|
$expr = $1;
|
|
$lastOp = "";
|
|
$rest = "";
|
|
$time = "";
|
|
}
|
|
|
|
if ($expr =~ /^sunrise$/) {
|
|
$expr = 0;
|
|
if ($sunrise->hms =~ /(\d\d):(\d\d):(\d\d)/) {
|
|
$expr = $1*60+$2;
|
|
}
|
|
} elsif ($expr =~ /^sunset$/) {
|
|
$expr = 0;
|
|
if ($sunset->hms =~ /(\d\d):(\d\d):(\d\d)/) {
|
|
$expr = $1*60+$2;
|
|
}
|
|
} elsif ($expr =~ /^random\((\d\d):(\d\d)\)$/) {
|
|
$expr = int rand($1*60+$2+1);
|
|
} elsif ($expr =~ /^dimmer\((\d\d):(\d\d).*\)$/) {
|
|
$expr = 0;
|
|
} elsif ($expr =~ /^(\d\d):(\d\d)$/) {
|
|
$expr = $1*60+$2;
|
|
} else {
|
|
printLine "Wrong time '$expr' for rule '$rule'!";
|
|
return;
|
|
$expr = "";
|
|
}
|
|
|
|
if ($op eq "+") {
|
|
$mins += $expr;
|
|
} elsif ($op eq "-") {
|
|
$mins -= $expr;
|
|
}
|
|
}
|
|
if ($mins <= 0) {
|
|
$mins = $mins % (24*60);
|
|
$days = 1;
|
|
} elsif ($mins >= 24*60) {
|
|
$mins = $mins % (24*60);
|
|
$days = 1;
|
|
}
|
|
|
|
$hours = int $mins/60;
|
|
$minutes = int $mins%60;
|
|
# Hopefully we will deal with UTC and daylightsavingtime in a decent fashion?
|
|
$time = get_datetime_now();
|
|
$time->set(hour => 0, minute => 0, second => 0);
|
|
$time->add(hours => $hours+24*$days, minutes => $minutes, seconds => 0);
|
|
} else {
|
|
$time = undef;
|
|
}
|
|
|
|
return $time;
|
|
}
|
|
|
|
sub load_dimmer_rules($$$$$$$$){
|
|
my ($alias, $time, $expr, $now, $today, $sunrise, $sunset) = @_;
|
|
|
|
my $dimmer =$expr;
|
|
if ($expr =~ /dimmer\((.*)\)/i) {
|
|
$dimmer = $1;
|
|
}
|
|
|
|
my ($offset, $start, $stop, $step) = split(/\,/,$dimmer);
|
|
|
|
if (!defined($offset)) {
|
|
$offset = '';
|
|
}
|
|
if ($offset !~ /^\d\d:\d\d$/) {
|
|
printLine "Wrong dimmer time offset '$offset' for rule '$expr'!";
|
|
next;
|
|
}
|
|
if (!defined($start)) {
|
|
$start = '';
|
|
}
|
|
if (($start !~ /^(\d+)$/) || (($start < 0) || ($start > 255))) {
|
|
printLine "Wrong dimmer start level '$start' for rule '$expr'!";
|
|
next;
|
|
}
|
|
if (!defined($stop)) {
|
|
$stop = '';
|
|
}
|
|
if (($stop !~ /^(\d+)$/) || (($stop < 0) || ($stop > 255))) {
|
|
printLine "Wrong dimmer stop level '$stop' for rule '$expr'!";
|
|
next;
|
|
}
|
|
if (!defined($step)) {
|
|
$step = '';
|
|
}
|
|
if (($step !~ /^(\d+)$/) || (($step < 1) || ($step > 255))) {
|
|
printLine "Wrong dimmer step level '$step' for rule '$expr'!";
|
|
next;
|
|
}
|
|
|
|
if (! defined($time)) {
|
|
return;
|
|
}
|
|
|
|
my $dimtime = $time;
|
|
my $level = $start;
|
|
while(1) {
|
|
if ($dimtime =~ /T(.*):00/) {
|
|
$dimtime = $1;
|
|
}
|
|
if ($level != $start) {
|
|
$dimtime .= "+" . $offset;
|
|
}
|
|
|
|
$dimtime = get_rule_datetime($dimtime, $today, $sunrise, $sunset);
|
|
push @device, [$dimtime, $alias, $level] if (defined($time) && ($now <= $time));
|
|
|
|
if ($stop>=$start) {
|
|
$level += $step;
|
|
if ($level>$stop) {
|
|
last;
|
|
}
|
|
}
|
|
if ($stop<$start) {
|
|
$level -= $step;
|
|
if ($level<$stop) {
|
|
last;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
|
|
sub check_device_rules($) {
|
|
my ($now) = @_;
|
|
|
|
printLine "Checking device rules '$now'" if ($option{verbose});
|
|
|
|
my $rule = $device[0];
|
|
while (defined(@$rule)) {
|
|
my ($time, $device, $value) = @$rule;
|
|
if ($time <= $now) {
|
|
shift(@device);
|
|
change_device_state($device, $value);
|
|
} else {
|
|
last;
|
|
}
|
|
$rule = $device[0];
|
|
}
|
|
}
|
|
|
|
|
|
sub change_device_state($$) {
|
|
my ($device, $state) = @_;
|
|
|
|
call_program($device, $state);
|
|
my $text = "Device $device = $state";
|
|
printLine $text if ($option{"verbose"});
|
|
printlogger $text;
|
|
}
|
|
|
|
|
|
######################################################################
|
|
|
|
|
|
sub get_device_state() {
|
|
get_info_from_program();
|
|
|
|
if (defined($option{"device"})) {
|
|
my $device = $option{"device"};
|
|
if (defined($cfg_idAlias{$device})) {
|
|
$device = $cfg_idAlias{$device};
|
|
}
|
|
if ($cfg_alias{$device}) {
|
|
my $state = $cfg_alias{$device};
|
|
printLine "$state" if (not $option{"verbose"});
|
|
printLine "Device $device = $state" if ($option{"verbose"});
|
|
return;
|
|
}
|
|
if (defined($cfg_idGroup{$device})) {
|
|
$device = $cfg_idGroup{$device};
|
|
}
|
|
if (exists($cfg_group{$device})) {
|
|
my $val = $cfg_group{$device};
|
|
my ($delay, $aliases) = split(/\s+/, $val, 2);
|
|
my $states = "";
|
|
my (@aliaslist) = split(/\s+/, $aliases);
|
|
foreach my $alias (@aliaslist) {
|
|
$states .= " $cfg_alias{$alias}";
|
|
}
|
|
printLine "Group $device =$states";
|
|
return;
|
|
}
|
|
printLine "No alias or group found with name/id '$device'!";
|
|
}
|
|
}
|
|
|
|
|
|
sub set_device_state() {
|
|
get_info_from_program();
|
|
|
|
if (defined($option{"device"})) {
|
|
if (defined($option{"state"})) {
|
|
my $state = $option{"state"};
|
|
if ($state !~ /^(on|off|\d+)$/i) {
|
|
printLine "No state found with name '$state'!";
|
|
return;
|
|
}
|
|
if (($state =~ /^(\d+)$/i) && (($state < 0) || ($state > 255))) {
|
|
printLine "State needs to be an integer between 0 and 255 for dimmers!";
|
|
return;
|
|
}
|
|
my $device = $option{"device"};
|
|
if (defined($cfg_idAlias{$device})) {
|
|
$device = $cfg_idAlias{$device};
|
|
}
|
|
if ($cfg_alias{$device}) {
|
|
change_device_state($device, $state);
|
|
return;
|
|
}
|
|
if (defined($cfg_idGroup{$device})) {
|
|
$device = $cfg_idGroup{$device};
|
|
}
|
|
if (exists($cfg_group{$device})) {
|
|
my $val = $cfg_group{$device};
|
|
my ($delay, $aliases) = split(/\s+/, $val, 2);
|
|
my (@aliaslist) = split(/\s+/, $aliases);
|
|
foreach my $alias (@aliaslist) {
|
|
change_device_state($alias, $state);
|
|
sleep(1);
|
|
}
|
|
return;
|
|
}
|
|
printLine "No alias or group found with name '$device'!";
|
|
}
|
|
}
|
|
}
|
|
|
|
|
|
sub swap_first_device_state() {
|
|
get_info_from_program();
|
|
|
|
if ($option{"device"}) {
|
|
if ($option{"swapfirst"}) {
|
|
my $device = $option{"device"};
|
|
if (defined($cfg_idAlias{$device})) {
|
|
$device = $cfg_idAlias{$device};
|
|
}
|
|
if ($cfg_alias{$device}) {
|
|
my $state = $cfg_alias{$device};
|
|
if ($state =~ /^off$/i) {
|
|
$state = 'on';
|
|
} else {
|
|
$state = 'off';
|
|
}
|
|
change_device_state($device, $state);
|
|
return;
|
|
}
|
|
if (defined($cfg_idGroup{$device})) {
|
|
$device = $cfg_idGroup{$device};
|
|
}
|
|
if (exists($cfg_group{$device})) {
|
|
my $val = $cfg_group{$device};
|
|
my ($delay, $aliases) = split(/\s+/, $val, 2);
|
|
my ($alias) = split(/\s+/, $aliases);
|
|
my $state = $cfg_alias{$device};
|
|
if ($state =~ /^off$/i) {
|
|
$state = 'on';
|
|
} else {
|
|
$state = 'off';
|
|
}
|
|
my (@aliaslist) = split(/\s+/, $aliases);
|
|
foreach my $alias (@aliaslist) {
|
|
change_device_state($alias, $state);
|
|
sleep(1);
|
|
}
|
|
return;
|
|
}
|
|
printLine "No alias or group found with name '$device'!";
|
|
}
|
|
}
|
|
}
|
|
|
|
|
|
sub swap_device_state() {
|
|
get_info_from_program();
|
|
|
|
if ($option{"device"}) {
|
|
if ($option{"swap"}) {
|
|
my $device = $option{"device"};
|
|
if (defined($cfg_idAlias{$device})) {
|
|
$device = $cfg_idAlias{$device};
|
|
}
|
|
if ($cfg_alias{$device}) {
|
|
my $state = $cfg_alias{$device};
|
|
if ($state =~ /^off$/i) {
|
|
$state = 'on';
|
|
} else {
|
|
$state = 'off';
|
|
}
|
|
change_device_state($device, $state);
|
|
return;
|
|
}
|
|
if (defined($cfg_idGroup{$device})) {
|
|
$device = $cfg_idGroup{$device};
|
|
}
|
|
if (exists($cfg_group{$device})) {
|
|
my $val = $cfg_group{$device};
|
|
my ($delay, $aliases) = split(/\s+/, $val, 2);
|
|
my (@aliaslist) = split(/\s+/, $aliases);
|
|
foreach my $alias (@aliaslist) {
|
|
my $state = $cfg_alias{$device};
|
|
if ($state =~ /^off$/i) {
|
|
$state = 'on';
|
|
} else {
|
|
$state = 'off';
|
|
}
|
|
change_device_state($alias, $state);
|
|
sleep(1);
|
|
}
|
|
return;
|
|
}
|
|
printLine "No alias or group found with name '$device'!";
|
|
}
|
|
}
|
|
}
|
|
|
|
|
|
sub list_all_devices() {
|
|
foreach my $key (sort keys %cfg_alias) {
|
|
printLine "Device $key($cfg_aliasId{$key}) = $cfg_alias{$key}";
|
|
}
|
|
foreach my $key (sort keys %cfg_group) {
|
|
my $val = $cfg_group{$key};
|
|
my ($delay, $aliases) = split(/\s+/, $val, 2);
|
|
my $states = "";
|
|
my (@aliaslist) = split(/\s+/, $aliases);
|
|
foreach my $device (@aliaslist) {
|
|
$states .= " $cfg_alias{$device}";
|
|
}
|
|
printLine "Group $key($cfg_groupId{$key}) =$states";
|
|
}
|
|
}
|
|
|
|
|
|
sub list_all_aliases {
|
|
foreach my $key (sort keys %cfg_alias) {
|
|
printLine "Alias $key($cfg_aliasId{$key}) = receiver";
|
|
}
|
|
foreach my $key (sort keys %cfg_group) {
|
|
my $val = $cfg_group{$key};
|
|
my ($delay, $aliases) = split(/\s+/, $val, 2);
|
|
printLine "Group $key($cfg_groupId{$key}) = delay $delay seconds, aliases ($aliases)";
|
|
}
|
|
}
|
|
|
|
|
|
sub daemon_loop() {
|
|
daemon_init();
|
|
|
|
while ($option{"daemon"}) {
|
|
my $now = get_datetime_now();
|
|
my $next_day = get_datetime_now();
|
|
$next_day->add( hours => 24 );
|
|
$next_day->set( hour => 0, minute => 0, second => 0 );
|
|
printLine "Next reload of device rules = $next_day" if ($option{"verbose"});
|
|
|
|
my $wait_time = 5;
|
|
my $loop = 1;
|
|
|
|
check_device_rules($now);
|
|
|
|
while ($loop) {
|
|
$now = get_datetime_now();
|
|
if ($now > $next_day) {
|
|
load_device_rules();
|
|
$next_day->add( hours => 24 );
|
|
}
|
|
check_device_rules($now);
|
|
sleep($wait_time);
|
|
}
|
|
}
|
|
|
|
daemon_exit();
|
|
}
|
|
|
|
|
|
sub perform_action() {
|
|
if ($option{"aliases"}) {
|
|
list_all_aliases();
|
|
} elsif ($option{"get"}) {
|
|
get_device_state();
|
|
} elsif ($option{"set"}) {
|
|
set_device_state();
|
|
} elsif ($option{"swapfirst"}) {
|
|
swap_first_device_state();
|
|
} elsif ($option{"swap"}) {
|
|
swap_device_state();
|
|
} elsif ($option{"list"}) {
|
|
list_all_devices();
|
|
} elsif ($option{"daemon"}) {
|
|
daemon_loop();
|
|
}
|
|
}
|
|
|
|
|
|
######################################################################
|
|
|
|
|
|
sub main() {
|
|
# check arguments
|
|
check_args(@ARGV);
|
|
|
|
# read configuration file
|
|
read_config($cfg_set{"configfile"});
|
|
|
|
# Load rules
|
|
load_device_rules();
|
|
|
|
# perform action
|
|
perform_action();
|
|
}
|
|
|
|
|
|
main();
|
|
|
|
|
|
######################################################################
|
|
|
|
|
|
__DATA__
|
|
#-
|
|
#- NAME
|
|
#- tellstickControllerTdtool
|
|
#-
|
|
#- SYNOPSIS
|
|
#- tellstickControllerTdtool [options]
|
|
#-
|
|
#- DESCRIPTION
|
|
#- tellstickController is used for controlling wireless recevier devices from
|
|
#- a TellStick transmitter. This version uses the tdtool software to perform
|
|
#- the actual device control. tellstickController can be used for manual
|
|
#- control of devices, or used as a daemon that is controlled by a number of
|
|
#- configuration file rules.
|
|
#- Devices and groups can be accessed by either name or id.
|
|
#- States can be set to ON, OFF or an integer between 0-255 for dimmer.
|
|
#-
|
|
#- -h, --help Show this help text.
|
|
#- -v, --verbose Show extra information.
|
|
#- -d, --daemon Starts in daemon mode.
|
|
#- -f, --file F Set configfile to file F.
|
|
#- -c, --check Check content of configuration file.
|
|
#- -t, --test Test mode, no real devices will used.
|
|
#- -a, --aliases List of aliases for devices/groups.
|
|
#- -l, --list List states for all devices/groups.
|
|
#- -s, --set D S Set device D to state S
|
|
#- -g, --get D Get state for device/group D.
|
|
#- -w, --swapfirst G Swap states for group G based on first device state.
|
|
#- -x, --swap D Swap state for device/group D.
|
|
#-
|
|
#- EXAMPLES
|
|
#- tellstickControllerTdtool -l
|
|
#- tellstickControllerTdtool --set device_alias on
|
|
#- tellstickControllerTdtool --swap device_alias
|
|
#- tellstickControllerTdtool -d -f myConfigFile.conf
|
|
#-
|
|
#- DEPENDENCIES
|
|
#- The following Perl modules needs to be installed:
|
|
#- DateTime and DateTime::Event::Sunrise
|
|
#-
|
|
#- FILES
|
|
#- tellstickController.conf
|
|
#- tellstickController.log
|
|
#- tellstickController.pid
|
|
#-
|
|
#- CONFIGURATION
|
|
#- The configuration file consists of a number of settings 'Set', a number of
|
|
#- group aliases 'Group', and a number of device rules 'Rules'.
|
|
#-
|
|
#- The settings controls sunrise/sunset, logfile, pidfile, etc.
|
|
#-
|
|
#- The groups configures a list of devices and a delay time.
|
|
#-
|
|
#- The rules can be written as a string containing two parts.
|
|
#- The first part is optional and ends with an '/'. It can contain one or more
|
|
#- of these keywords 'Weekend', 'Workweek', 'Monday', 'Tuesday', 'Wednesday',
|
|
#- 'Thursday', 'Friday', 'Saturday' and 'Sunday'. A specified date like
|
|
#- '2008-03-18', '2008-03-##', '####-03-##' or '####-##-15' is also allowed.
|
|
#- The second part is mandatory and is either a expression or the keyword 'No'.
|
|
#- The expression can contain a micture of these keywords 'Sunrise', 'Sunset',
|
|
#- 'Random(HH:MM)', 'HH:MM' and 'Dimmer(HH:MM,startlevel,stoplevel,steplevel)'.
|
|
#- A Dimmer can be controlled to change dim level from startlevel to stoplevel
|
|
#- by adding/subtracting steplevel value every HH:MM time period.
|
|
#-
|
|
#- Example rule: Weekend/07:15
|
|
#- Example rule: Monday+Sunday/07:15
|
|
#- Example rule: 2008-03-##/12:10
|
|
#- Example rule: 07:15+Random(02:00)
|
|
#- Example rule: Sunset-00:30
|
|
#- Example rule: Workweek/07:00+Dimmer(00:01,5,255,25)
|
|
#-
|
|
#- AUTHOR
|
|
#- Original version written by Rickard Andersson
|
|
#-
|
|
#- LICENSE
|
|
#- Copyright (C) 2008-2010 Rickard Andersson. Version 2.0.0
|
|
#- This program comes with ABSOLUTELY NO WARRANTY.
|
|
#- This is free software, and you are welcome to redistribute it under certain
|
|
#- conditions; See license file for details.
|
|
#-
|