File Coverage

blib/lib/Device/RadioThermostat.pm

Criterion	Covered	Total	%
statement	27	111	24.3
branch	0	30	0.0
condition	0	6	0.0
subroutine	9	29	31.0
pod	18	18	100.0
total	54	194	27.8

package Device::RadioThermostat;

use strict;
use warnings;

use 5.008_001;
our $VERSION = '0.03';

use Carp;
use JSON;
use Socket 'inet_aton';
use Time::HiRes 'usleep';
use LWP::UserAgent;
use IO::Socket::INET;

sub new {
    my ( $class, %args ) = @_;
    my $self = {
        address => $args{address},
        ua      => LWP::UserAgent->new() };
    croak 'Must pass address to new.' unless $self->{address};

    return bless $self, $class;
}

sub find_all {
    my ( $class, $low, $high ) = @_;
    croak 'Must pass two addresses to find_all.' unless $low && $high;

    my $lowint  = unpack( "N", inet_aton($low) );
    my $highint = unpack( "N", inet_aton($high) );

    my $s = IO::Socket::INET->new(Proto => 'udp') || croak @$;

    for ( 0 .. 4 ) { # retry 5 times
        for ( my $addr = $lowint; $addr <= $highint; $addr++ ) {
            my $hissockaddr = sockaddr_in( 1900, pack( "N", $addr ) );
            $s->send(
                "TYPE: WM-DISCOVER\r\n"
                    . "VERSION: 1.0\r\n\r\n"
                    . "services: com.marvell.wm.system*\r\n\r\n",
                0, $hissockaddr
            );
            usleep 10000;
        }

        my $rin = '';
        vec($rin, $s->fileno, 1) = 1;
        my ($rout, %result);
        while (select($rout = $rin, undef, undef, 1)) {
            my $response = '';
            my $hispaddr = $s->recv( $response, 1024, 0 );
            my ( $port, $hisiaddr ) = sockaddr_in($hispaddr);
            my ($hisaddr) = $response =~ m!location:\s*http://([0-9.]+)/sys!i;
            next unless $hisaddr;

            my $tstat = Device::RadioThermostat->new(
                address => 'http://' . $hisaddr );
            my $uuid = $tstat->get_uuid();
            next unless $uuid;

            $result{$uuid} = $tstat;
        }

        return \%result if %result;
    }

    return;
}

sub tstat {
    my $self = shift;
    return $self->_ua_get('/tstat');
}

sub sys {
    my $self = shift;
    return $self->_ua_get('/sys');
}

sub get_uuid {
    my $self = shift;
    return $self->sys()->{uuid};
}

sub set_mode {
    my ( $self, $mode ) = @_;
    return $self->_ua_post( '/tstat', { tmode => $mode } );
}

sub get_target {
    my ($self) = @_;
    my $mode = $self->tstat->{tmode};
    return if $mode == 0;
    my $targets = $self->get_targets();
    if ( $mode == 1 ) {
        return $targets->{t_heat};
    }
    elsif ( $mode == 2 ) {
        return $targets->{t_cool};
    }
    else {
        return [ $targets->{t_cool}, $targets->{t_heat} ];
    }
}

sub get_targets {
    my ($self) = @_;
    return $self->_ua_get('/tstat/ttemp');
}

sub temp_heat {
    my ( $self, $temp ) = @_;
    return $self->_ua_post( '/tstat', { t_heat => $temp } );
}

sub temp_cool {
    my ( $self, $temp ) = @_;
    return $self->_ua_post( '/tstat', { t_cool => $temp } );
}

sub remote_temp {
    my ($self) = @_;
    return $self->_ua_get('/tstat/remote_temp');
}

sub disable_remote_temp {
    my ($self) = @_;
    return $self->_ua_post( '/tstat/remote_temp', { rem_mode => 0 } );
}

sub set_remote_temp {
    my ( $self, $temp ) = @_;
    return $self->_ua_post( '/tstat/remote_temp', { rem_temp => 0 + sprintf("%d", $temp) } );
}

sub lock {
    my ($self, $mode) = @_;
    if ($mode) {
        return unless $self->_ua_post( '/tstat/lock', { lock_mode => $mode } );
    }
    return $self->_ua_get('/tstat/lock');
}

sub user_message {
    my ( $self, $line, $message ) = @_;
    return $self->_ua_post( '/tstat/uma', { line => $line, message => $message } );
}

sub price_message {
    my ( $self, $line, $message ) = @_;
    return $self->_ua_post( '/tstat/pma', { line => $line, message => $message } );
}

sub clear_message {
    my ($self) = @_;
    return $self->_ua_post( '/tstat/pma', { mode => 0 } );
}

sub datalog {
    my ($self) = @_;
    return $self->_ua_get('/tstat/datalog');
}

sub _ua_post {
    my ( $self, $path, $data ) = @_;
    my $response
        = $self->{ua}->post( $self->{address} . $path, content => encode_json $data );
    if ( $response->is_success ) {
        my $result = decode_json $response->decoded_content();

        # return $result;
        return exists( $result->{success} ) ? 1 : 0;
    }
    else {
        my ($code, $err) = ($response->code, $response->message);
        carp $code ? "$code response: $err" : "Connection error: $err";
        return;
    }
}

sub _ua_get {
    my ( $self, $path ) = @_;
    my $response = $self->{ua}->get( $self->{address} . $path );
    if ( $response->is_success ) {
        return decode_json $response->decoded_content();
    }
    else {
        my ($code, $err) = ($response->code, $response->message);
        carp $code ? "$code response: $err" : "Connection error: $err";
        return;
    }
}

1;
__END__