AHA
view release on metacpan or search on metacpan
example/lava_lamp.pl view on Meta::CPAN
used to customize the time ranges on a weekday basis.
=item notify
The "notify" mode is used by a notification handler, e.g. from Nagios or from
Jenkins. In this mode, the C<type> parameter is used for signaling whether the
lamp should be switched on ("problem") or off ("recovery").
=item list
This scripts logs all activities in a log file C<$LOG_FILE>. With the "list"
mode, all history entries can be viewed.
=back
=cut
# ===========================================================================
# Configuration section
# Configuration required for accessing the switch.
example/lava_lamp.pl view on Meta::CPAN
"Tue" => [ ["13:55", "23:00"] ],
"Wed" => [ ["13:55", "23:00"] ],
"Thu" => [ ["13:55", "23:00"] ],
"Fri" => [ ["6:55", "23:00"] ],
"Sat" => [ ["7:55", "23:00"] ],
};
# File holding the lamp's status
my $STATUS_FILE = "/var/run/lamp.status";
# Log file where to log to
my $LOG_FILE = "/var/log/lamp.log";
# Stop file, when, if exists, keeps the lamp off
my $OFF_FILE = "/tmp/lamp_off";
# Time back in passed assumed when switching was done manually (seconds)
# I.e. if a manual state change is detected, it is assumed that it was back
# that amount of seconds in the past (5 minutes here)
my $MANUAL_DELTA = 5 * 60;
# Maximum number of history entries to store
example/lava_lamp.pl view on Meta::CPAN
# Open status and lock
my $status = fetch_status();
# Name and connection parameters
my $lamp = open_lamp($SWITCH_CONFIG,$opts{name});
# Check current switch state
my $is_on = $lamp->is_on();
# Log a manual switch which might has happened in between checks or notification
log_manual_switch($status,$is_on);
if ($mode eq "watch") {
# Watchdog mode If the lamp is on but out of the period, switch it
# off. Also, if it is running alredy for too long. $off_file can be used
# to switch it always off.
my $in_period = check_on_period();
if ($is_on && (-e $OFF_FILE ||
!$in_period ||
lamp_on_for_too_long($status))) {
# Switch off lamp whether the stop file is switched on when we are off the
example/lava_lamp.pl view on Meta::CPAN
# Create empty status file if necessary
sub init_status {
my $status = {};
$status->{hist} = [];
if (! -e $STATUS_FILE) {
store $status,$STATUS_FILE;
}
}
sub log_manual_switch {
my $status = shift;
my $is_on = shift;
my $last = get_last_entry($status);
if ($last && $is_on != $last->[1]) {
# Change has been manualy in between the interval. Add an approx history entry
update_status($status,$is_on,"manual",estimate_manual_time($status));
}
}
sub update_status {
example/lava_lamp.pl view on Meta::CPAN
my $config = shift;
my $name = shift || $config->{id};
return new Lamp($name,
$config->{host},
$config->{password},
$config->{user});
}
sub close_lamp {
my $lamp = shift;
$lamp->logout();
}
package Lamp;
use AHA;
sub new {
my $class = shift;
my $name = shift;
my $host = shift;
example/lava_lamp.pl view on Meta::CPAN
}
sub on {
shift->{switch}->on();
}
sub off {
shift->{switch}->off();
}
sub logout {
shift->{aha}->logout();
}
=head1 LICENSE
lava_lampl.pl 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.
lava_lamp.pl is distributed in the hope that it will be useful,
$switch->is_on() ? $switch->off() : $switch->on();
}
# Access switch directly via name as configured
$aha->energy("Lava lamp");
# ... or by AIN
$aha->energy("087610077197");
# Logout
$aha->logout();
=head1 DESCRIPTION
This module allows programatic access to AVM's Home Automation (AHA) system as
it is specified in L<AVM AHA HTTP Protocol
specification|http://www.avm.de/de/Extern/files/session_id/AHA-HTTP-Interface.pdf>.
Please note that this module is not connected to AVM in any way. It's a hobby
project, without any warranty and no guaranteed support.
=item port
Port to connect to. It's 80 by default
=item password
Password for connecting to the Fritz Box
=item user
User role for login. Only required if a role based login is configured for the
Fritz box
=back
If used without an hashref as argument, the first argument must be the host,
the second the password and the third optionally the user.
=cut
sub new {
$self->{user} = shift;
} else {
map { $self->{$_} = $arg1->{$_} } qw(host password user port);
}
die "No host given" unless $self->{host};
die "No password given" unless $self->{password};
my $base = $self->{port} ? $self->{host} . ":" . $self->{port} : $self->{host};
$self->{ua} = LWP::UserAgent->new;
$self->{login_url} = "http://" . $base . "/login_sid.lua";
$self->{ws_url} = "http://" . $base . "/webservices/homeautoswitch.lua";
$self->{ain_map} = {};
return bless $self,$class;
}
=item $switches = $aha->list()
List all switches know to AHA. An arrayref with L<AHA::Switch> objects is
returned, one for each device. When no switch is registered an empty arrayref
is returned.
my $self = shift;
my $name = shift;
my $map = $self->{ain_map};
return $map->{$name} if $map->{$name};
$self->_init_ain_map();
my $ain = $self->{ain_map}->{$name};
die "No AIN for '$name' found" unless $ain;
return $ain;
}
=item $aha->logout()
Logout from the connected fritz.box in order to free up any resources. You
can still use any other method on this object, in which case it is
logs in again (which eats up some performance, of course)
=cut
sub logout {
my $self = shift;
return unless $self->{sid};
# Send a post request as defined in
# http://www.avm.de/de/Extern/files/session_id/AVM_Technical_Note_-_Session_ID.pdf
my $req = HTTP::Request->new(POST => $self->{login_url});
$req->content_type("application/x-www-form-urlencoded");
my $login = "sid=".$self->{sid}."&security:command/logout=fcn";
$req->content($login);
my $resp = $self->{ua}->request($req);
die "Cannot logout SID ",$self->{sid},": ",$resp->status_line unless $resp->is_success;
print "--- Logout ",$self->{sid} if $DEBUG;
delete $self->{sid};
}
=back
=cut
$url .= "&ain=" . $ain if $ain;
my $resp = $self->{ua}->get($url);
print ">>> $url\n" if $DEBUG;
die "Cannot execute ",$cmd,": ",$resp->status_line unless $resp->is_success;
my $c = $resp->content;
chomp $c;
print "<<< $c\n" if $DEBUG;
return $c;
}
# Return the cached SID or perform the login as described in
# http://www.avm.de/de/Extern/files/session_id/AVM_Technical_Note_-_Session_ID.pdf
sub _sid {
my $self = shift;
return $self->{sid} if $self->{sid};
# Get the challenge
my $resp = $self->{ua}->get($self->{login_url});
my $content = $resp->content();
my $challenge = ($content =~ /<Challenge>(.*?)<\/Challenge>/ && $1);
my $input = $challenge . '-' . $self->{password};
Encode::from_to($input, 'ascii', 'utf16le');
my $challengeresponse = $challenge . '-' . lc(Digest::MD5::md5_hex($input));
# Send the challenge back with encoded password
my $req = HTTP::Request->new(POST => $self->{login_url});
$req->content_type("application/x-www-form-urlencoded");
my $login = "response=$challengeresponse";
if ($self->{user}) {
$login .= "&username=" . $self->{user};
}
$req->content($login);
$resp = $self->{ua}->request($req);
if (! $resp->is_success()) {
die "Cannot login to ", $self->{host}, ": ",$resp->status_line();
}
$content = $resp->content();
$self->{sid} = ($content =~ /<SID>(.*?)<\/SID>/ && $1);
print "-- Login, received SID ",$self->{sid} if $DEBUG;
return $self->{sid};
}
# Initialize the reverse name -> AIN map
sub _init_ain_map {
my $self = shift;
( run in 1.003 second using v1.01-cache-2.11-cpan-49f99fa48dc )