AHA

 view release on metacpan or  search on metacpan

README.md  view on Meta::CPAN

````bash
     perl ./Build.PL
     ./Build install
````

For more information, see the manpage to AHA.

### Example

````perl
    my $aha = new AHA({host: "fritz.box", password: "s!cr!t"});

    # Get all switches as array ref of AHA::Switch objects
    my $switches = $aha->list();

    # For all switches found
    for my $switch (@$switches) {
       say "Name:    ",$switch->name();
       say "State:   ",$switch->is_on();
       say "Present: ",$switch->is_present()
       say "Energy:  ",$switch->energy();

example/lava_lamp.pl  view on Meta::CPAN

# ===========================================================================
# Configuration section

# Configuration required for accessing the switch. 
my $SWITCH_CONFIG = 
    {
     # AVM AHA Host for controlling the devices 
     host => "fritz.box",
     
     # AVM AHA Password for connecting to the $AHA_HOST     
     password => "s!cr!t",
     
     # AVM AHA user role (undef if no roles are in use)
     user => undef,
     
     # Name of AVM AHA switch
     id => "Lava Lamp"
    };

# Time how long the lamp should be at least be kept switched off (seconds)
my $LAMP_REST_TIME = 60 * 60;

example/lava_lamp.pl  view on Meta::CPAN

}

# ==========================================================================
# Customize the following call and class in order to use a different 
# switch than AVM AHA's
sub open_lamp {
    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;
    my $password = shift;
    my $user = shift;

    my $aha = new AHA($host,$password,$user);
    my $switch = new AHA::Switch($aha,$name);
    
    my $self = {
                aha => $aha,
                switch => $switch
               };
    return bless $self,$class;
}

sub is_on {

lib/AHA.pm  view on Meta::CPAN

=head1 NAME

AHA - Simple access to the AHA interface for AVM based home automation

=head1 SYNOPSIS

    my $aha = new AHA({host: "fritz.box", password: "s!cr!t"});

    # Get all switches as array ref of AHA::Switch objects
    my $switches = $aha->list();

    # For all switches found
    for my $switch (@$switches) {
       say "Name:    ",$switch->name();
       say "State:   ",$switch->is_on();
       say "Present: ",$switch->is_present();
       say "Energy:  ",$switch->energy();

lib/AHA.pm  view on Meta::CPAN

use Encode;
use Digest::MD5;
use Data::Dumper;
use vars qw($VERSION);

$VERSION = "0.55";

# Set to one if some debugging should be printed
my $DEBUG = 0;

=item $aha = new AHA({host => "fritz.box", password => "s!cr!t", user => "admin"})

=item $aha = new AHA("fritz.box","s!cr!t","admin")

Create a new AHA object for accessing a Fritz Box via the HTTP interface. The
parameters can be given as a hashref (for named parameters) or in a simple form
with host, password and user (optional) as unnamed arguments.

The named arguments which can be used:

=over

=item host

Name or IP of the Fritz box to access

=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 {
    my $class = shift;
    my $self = {};
    my $arg1 = shift; 
    if (ref($arg1) ne "HASH") {
        $self->{host} = $arg1;
        $self->{password} = shift;
        $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;
}

lib/AHA.pm  view on Meta::CPAN

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();