File Coverage

blib/lib/Device/WebIO.pm

Criterion	Covered	Total	%
statement	311	311	100.0
branch	26	30	86.6
condition	17	27	62.9
subroutine	67	67	100.0
pod	54	59	91.5
total	475	494	96.1

# Copyright (c) 2014  Timm Murray
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions are met:
#
#     * Redistributions of source code must retain the above copyright notice,
#       this list of conditions and the following disclaimer.
#     * Redistributions in binary form must reproduce the above copyright
#       notice, this list of conditions and the following disclaimer in the
#       documentation and/or other materials provided with the distribution.
#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.
package Device::WebIO;
$Device::WebIO::VERSION = '0.022';
# ABSTRACT: Duct Tape for the Internet of Things
use v5.12;
use Moo;
use namespace::clean;
use Device::WebIO::Exceptions;

has '_device_by_name' => (
    is      => 'ro',
    default => sub {{
    }},
);


sub register
{
    my ($self, $name, $device) = @_;
    $self->_device_by_name->{$name} = $device;
    return 1;
}

sub device_names
{
    my ($self) = @_;
    return keys %{ $self->_device_by_name };
}


sub pin_desc
{
    my ($self, $name) = @_;
    my $obj = $self->_get_obj( $name );
    return $obj->pin_desc;
}

sub all_desc
{
    my ($self, $name) = @_;
    my $obj = $self->_get_obj( $name );
    return $obj->all_desc;
}


sub set_as_input
{
    my ($self, $name, $pin) = @_;
    my $obj = $self->_get_obj( $name );
    $self->_role_check( $obj, 'DigitalInput' );
    $self->_pin_count_check( $name, $obj, $pin, 'DigitalInput' );
    $obj->set_as_input( $pin );
    return 1;
}

sub set_as_output
{
    my ($self, $name, $pin) = @_;
    my $obj = $self->_get_obj( $name );
    $self->_role_check( $obj, 'DigitalOutput' );
    $self->_pin_count_check( $name, $obj, $pin, 'DigitalOutput' );
    $obj->set_as_output( $pin );
    return 1;
}

sub is_set_input
{
    my ($self, $name, $pin) = @_;
    my $obj = $self->_get_obj( $name );
    $self->_role_check( $obj, 'DigitalInput' );
    $self->_pin_count_check( $name, $obj, $pin, 'DigitalInput' );
    return $obj->is_set_input( $pin );
}

sub is_set_output
{
    my ($self, $name, $pin) = @_;
    my $obj = $self->_get_obj( $name );
    $self->_role_check( $obj, 'DigitalOutput' );
    $self->_pin_count_check( $name, $obj, $pin, 'DigitalOutput' );
    return $obj->is_set_output( $pin );
}

sub digital_input_pin_count
{
    my ($self, $name) = @_;
    my $obj = $self->_get_obj( $name );
    $self->_role_check( $obj, 'DigitalInput' );
    my $count = $obj->input_pin_count;
    return $count;
}

sub digital_output_pin_count
{
    my ($self, $name) = @_;
    my $obj = $self->_get_obj( $name );
    $self->_role_check( $obj, 'DigitalOutput' );
    my $count = $obj->output_pin_count;
    return $count;
}

sub digital_input
{
    my ($self, $name, $pin) = @_;
    my $obj = $self->_get_obj( $name );
    $self->_role_check( $obj, 'DigitalInput' );
    $self->_pin_count_check( $name, $obj, $pin, 'DigitalInput' );
    return $obj->input_pin( $pin );
}

sub digital_input_port
{
    my ($self, $name) = @_;
    my $obj = $self->_get_obj( $name );
    $self->_role_check( $obj, 'DigitalInput' );
    return $obj->input_port;
}

sub digital_input_callback
{
    my ($self, $name, $pin, $type, $callback) = @_;
    my $obj = $self->_get_obj( $name );
    $self->_role_check( $obj, 'DigitalInputCallback' );
    $self->_pin_count_check( $name, $obj, $pin, 'DigitalInputCallback' );
    return $obj->input_callback_pin( $pin, $type, $callback );
}

sub digital_input_begin_loop
{
    my ($self, $name) = @_;
    my $obj = $self->_get_obj( $name );
    $self->_role_check( $obj, 'DigitalInputCallback' );
    return $obj->input_begin_loop();
}

sub set_anyevent_condvar
{
    my ($self, $name, $pin, $cv) = @_;
    my $obj = $self->_get_obj( $name );
    $self->_role_check( $obj, 'DigitalInputAnyEvent' );

    $obj->set_anyevent_condvar( $pin, $cv );

    return;
}

sub digital_output_port
{
    my ($self, $name, $out) = @_;
    my $obj = $self->_get_obj( $name );
    $self->_role_check( $obj, 'DigitalOutput' );
    $obj->output_port( $out );
    return 1;
}

sub digital_output
{
    my ($self, $name, $pin, $val) = @_;
    my $obj = $self->_get_obj( $name );
    $self->_role_check( $obj, 'DigitalOutput' );
    $self->_pin_count_check( $name, $obj, $pin, 'DigitalOutput' );
    $obj->output_pin( $pin, $val );
    return 1;
}

sub adc_count
{
    my ($self, $name) = @_;
    my $obj = $self->_get_obj( $name );
    $self->_role_check( $obj, 'ADC' );
    return $obj->adc_pin_count;
}

sub adc_resolution
{
    my ($self, $name, $pin) = @_;
    my $obj = $self->_get_obj( $name );
    $self->_role_check( $obj, 'ADC' );
    return $obj->adc_bit_resolution( $pin );
}

sub adc_max_int
{
    my ($self, $name, $pin) = @_;
    my $obj = $self->_get_obj( $name );
    $self->_role_check( $obj, 'ADC' );
    return $obj->adc_max_int( $pin );
}

sub adc_volt_ref
{
    my ($self, $name, $pin) = @_;
    my $obj = $self->_get_obj( $name );
    $self->_role_check( $obj, 'ADC' );
    return $obj->adc_volt_ref( $pin );
}

sub adc_input_int
{
    my ($self, $name, $pin) = @_;
    my $obj = $self->_get_obj( $name );
    $self->_role_check( $obj, 'ADC' );
    $self->_pin_count_check( $name, $obj, $pin, 'ADC' );
    return $obj->adc_input_int( $pin );
}

sub adc_input_float
{
    my ($self, $name, $pin) = @_;
    my $obj = $self->_get_obj( $name );
    $self->_role_check( $obj, 'ADC' );
    $self->_pin_count_check( $name, $obj, $pin, 'ADC' );
    return $obj->adc_input_float( $pin );
}

sub adc_input_volts
{
    my ($self, $name, $pin) = @_;
    my $obj = $self->_get_obj( $name );
    $self->_role_check( $obj, 'ADC' );
    $self->_pin_count_check( $name, $obj, $pin, 'ADC' );
    return $obj->adc_input_volts( $pin );
}

sub pwm_count
{
    my ($self, $name) = @_;
    my $obj = $self->_get_obj( $name );
    $self->_role_check( $obj, 'PWM' );
    return $obj->pwm_pin_count;
}

sub pwm_resolution
{
    my ($self, $name, $pin) = @_;
    my $obj = $self->_get_obj( $name );
    $self->_role_check( $obj, 'PWM' );
    return $obj->pwm_bit_resolution( $pin );
}

sub pwm_max_int
{
    my ($self, $name, $pin) = @_;
    my $obj = $self->_get_obj( $name );
    $self->_role_check( $obj, 'PWM' );
    return $obj->pwm_max_int( $pin );
}

sub pwm_output_int
{
    my ($self, $name, $pin, $value) = @_;
    my $obj = $self->_get_obj( $name );
    $self->_role_check( $obj, 'PWM' );
    $self->_pin_count_check( $name, $obj, $pin, 'PWM' );
    return $obj->pwm_output_int( $pin, $value );
}

sub pwm_output_float
{
    my ($self, $name, $pin, $value) = @_;
    my $obj = $self->_get_obj( $name );
    $self->_role_check( $obj, 'PWM' );
    $self->_pin_count_check( $name, $obj, $pin, 'PWM' );
    return $obj->pwm_output_float( $pin, $value );
}

sub vid_channels
{
    my ($self, $name) = @_;
    my $obj = $self->_get_obj( $name );
    $self->_role_check( $obj, 'VideoOutput' );
    return $obj->vid_channels;
}

sub vid_width
{
    my ($self, $name, $pin) = @_;
    my $obj = $self->_get_obj( $name );
    $self->_pin_count_check( $name, $obj, $pin, 'VideoOutput' );
    $self->_role_check( $obj, 'VideoOutput' );
    return $obj->vid_width( $pin );
}

sub vid_height
{
    my ($self, $name, $pin) = @_;
    my $obj = $self->_get_obj( $name );
    $self->_pin_count_check( $name, $obj, $pin, 'VideoOutput' );
    $self->_role_check( $obj, 'VideoOutput' );
    return $obj->vid_height( $pin );
}

sub vid_fps
{
    my ($self, $name, $pin) = @_;
    my $obj = $self->_get_obj( $name );
    $self->_pin_count_check( $name, $obj, $pin, 'VideoOutput' );
    $self->_role_check( $obj, 'VideoOutput' );
    return $obj->vid_fps( $pin );
}

sub vid_kbps
{
    my ($self, $name, $pin) = @_;
    my $obj = $self->_get_obj( $name );
    $self->_pin_count_check( $name, $obj, $pin, 'VideoOutput' );
    $self->_role_check( $obj, 'VideoOutput' );
    return $obj->vid_kbps( $pin );
}

sub vid_set_width
{
    my ($self, $name, $pin, $value) = @_;
    my $obj = $self->_get_obj( $name );
    $self->_pin_count_check( $name, $obj, $pin, 'VideoOutput' );
    $self->_role_check( $obj, 'VideoOutput' );
    return $obj->vid_set_width( $pin, $value );
}

sub vid_set_height
{
    my ($self, $name, $pin, $value) = @_;
    my $obj = $self->_get_obj( $name );
    $self->_pin_count_check( $name, $obj, $pin, 'VideoOutput' );
    $self->_role_check( $obj, 'VideoOutput' );
    return $obj->vid_set_height( $pin, $value );
}

sub vid_set_fps
{
    my ($self, $name, $pin, $value) = @_;
    my $obj = $self->_get_obj( $name );
    $self->_pin_count_check( $name, $obj, $pin, 'VideoOutput' );
    $self->_role_check( $obj, 'VideoOutput' );
    return $obj->vid_set_fps( $pin, $value );
}

sub vid_set_kbps
{
    my ($self, $name, $pin, $value) = @_;
    my $obj = $self->_get_obj( $name );
    $self->_pin_count_check( $name, $obj, $pin, 'VideoOutput' );
    $self->_role_check( $obj, 'VideoOutput' );
    return $obj->vid_set_kbps( $pin, $value );
}

sub vid_allowed_content_types
{
    my ($self, $name, $pin) = @_;
    my $obj = $self->_get_obj( $name );
    $self->_pin_count_check( $name, $obj, $pin, 'VideoOutput' );
    $self->_role_check( $obj, 'VideoOutput' );
    return $obj->vid_allowed_content_types( $pin );
}

sub vid_stream
{
    my ($self, $name, $pin, $type) = @_;
    my $obj = $self->_get_obj( $name );
    $self->_pin_count_check( $name, $obj, $pin, 'VideoOutput' );
    $self->_role_check( $obj, 'VideoOutput' );
    return $obj->vid_stream( $pin, $type );
}

sub vid_stream_callback
{
    my ($self, $name, $pin, $type, $callback) = @_;
    my $obj = $self->_get_obj( $name );
    $self->_pin_count_check( $name, $obj, $pin, 'VideoOutput' );
    $self->_role_check( $obj, 'VideoOutputCallback' );
    return $obj->vid_stream_callback( $pin, $type, $callback );
}

sub vid_stream_begin_loop
{
    my ($self, $name, $pin) = @_;
    my $obj = $self->_get_obj( $name );
    $self->_pin_count_check( $name, $obj, $pin, 'VideoOutput' );
    $self->_role_check( $obj, 'VideoOutputCallback' );
    return $obj->vid_stream_begin_loop( $pin );
}

sub img_channels
{
    my ($self, $name) = @_;
    my $obj = $self->_get_obj( $name );
    $self->_role_check( $obj, 'StillImageOutput' );
    return $obj->img_channels;
}

sub img_width
{
    my ($self, $name, $pin) = @_;
    my $obj = $self->_get_obj( $name );
    $self->_role_check( $obj, 'StillImageOutput' );
    $self->_pin_count_check( $name, $obj, $pin, 'StillImageOutput' );
    return $obj->img_width( $pin );
}

sub img_height
{
    my ($self, $name, $pin) = @_;
    my $obj = $self->_get_obj( $name );
    $self->_role_check( $obj, 'StillImageOutput' );
    $self->_pin_count_check( $name, $obj, $pin, 'StillImageOutput' );
    return $obj->img_height( $pin );
}

sub img_quality
{
    my ($self, $name, $pin) = @_;
    my $obj = $self->_get_obj( $name );
    $self->_role_check( $obj, 'StillImageOutput' );
    $self->_pin_count_check( $name, $obj, $pin, 'StillImageOutput' );
    return $obj->img_quality( $pin );
}

sub img_set_width
{
    my ($self, $name, $pin, $value) = @_;
    my $obj = $self->_get_obj( $name );
    $self->_role_check( $obj, 'StillImageOutput' );
    $self->_pin_count_check( $name, $obj, $pin, 'StillImageOutput' );
    return $obj->img_set_width( $pin, $value );
}

sub img_set_height
{
    my ($self, $name, $pin, $value) = @_;
    my $obj = $self->_get_obj( $name );
    $self->_role_check( $obj, 'StillImageOutput' );
    $self->_pin_count_check( $name, $obj, $pin, 'StillImageOutput' );
    return $obj->img_set_height( $pin, $value );
}

sub img_set_quality
{
    my ($self, $name, $pin, $value) = @_;
    my $obj = $self->_get_obj( $name );
    $self->_role_check( $obj, 'StillImageOutput' );
    $self->_pin_count_check( $name, $obj, $pin, 'StillImageOutput' );
    return $obj->img_set_quality( $pin, $value );
}

sub img_allowed_content_types
{
    my ($self, $name, $pin) = @_;
    my $obj = $self->_get_obj( $name );
    $self->_pin_count_check( $name, $obj, $pin, 'StillImageOutput' );
    return $obj->img_allowed_content_types( $pin );
}

sub img_stream
{
    my ($self, $name, $pin, $type) = @_;
    my $obj = $self->_get_obj( $name );
    $self->_pin_count_check( $name, $obj, $pin, 'StillImageOutput' );
    return $obj->img_stream( $pin, $type );
}

sub i2c_read
{
    my ($self, $name, $pin, $addr, $register, $num_bytes) = @_;
    my $obj = $self->_get_obj( $name );
    $self->_pin_count_check( $name, $obj, $pin, 'I2CProvider' );
    return $obj->i2c_read( $pin, $addr, $register, $num_bytes );
}

sub i2c_write
{
    my ($self, $name, $pin, $addr, $register, @bytes) = @_;
    my $obj = $self->_get_obj( $name );
    $self->_pin_count_check( $name, $obj, $pin, 'I2CProvider' );
    return $obj->i2c_write( $pin, $addr, $register, @bytes );
}

sub temp_celsius
{
    my ($self, $name) = @_;
    my $obj = $self->_get_obj( $name );
    Device::WebIO::FunctionNotSupportedException->throw(
        message => "Asked for temperature, but $name does not do the"
            . " TempSensor role"
    ) if ! $obj->does( 'Device::WebIO::Device::TempSensor' );
    return $obj->temp_celsius;
}

sub temp_kelvins
{
    my ($self, $name) = @_;
    my $obj = $self->_get_obj( $name );
    Device::WebIO::FunctionNotSupportedException->throw(
        message => "Asked for temperature, but $name does not do the"
            . " TempSensor role"
    ) if ! $obj->does( 'Device::WebIO::Device::TempSensor' );
    return $obj->temp_kelvins;
}

sub temp_fahrenheit
{
    my ($self, $name) = @_;
    my $obj = $self->_get_obj( $name );
    Device::WebIO::FunctionNotSupportedException->throw(
        message => "Asked for temperature, but $name does not do the"
            . " TempSensor role"
    ) if ! $obj->does( 'Device::WebIO::Device::TempSensor' );
    return $obj->temp_fahrenheit;
}

sub spi_set_speed
{
    my ($self, $name, $pin, $speed) = @_;
    my $obj = $self->_get_obj( $name );
    $self->_pin_count_check( $name, $obj, $pin, 'SPI' );
    return $obj->spi_set_speed( $pin, $speed );
}

sub spi_read
{
    my ($self, $name, $pin, $len) = @_;
    my $obj = $self->_get_obj( $name );
    $self->_pin_count_check( $name, $obj, $pin, 'SPI' );
    return $obj->spi_read( $pin, $len );
}

sub spi_write
{
    my ($self, $name, $pin, $data) = @_;
    my $obj = $self->_get_obj( $name );
    $self->_pin_count_check( $name, $obj, $pin, 'SPI' );
    return $obj->spi_write( $pin, $data );
}


sub _get_obj
{
    my ($self, $name) = @_;
    my $obj = $self->_device_by_name->{$name};
    return $obj;
}

sub _pin_count_check
{
    my ($self, $name, $obj, $pin, $type) = @_;
    my $pin_count = $self->_pin_count_for_obj( $obj, $type );

    if( $pin_count <= $pin ) {
        Device::WebIO::PinDoesNotExistException->throw(
            message => "Asked for $type pin $pin, but device $name"
                . " only has $pin_count pins",
        );
    }

    return 1;
}

sub _pin_count_for_obj
{
    my ($self, $obj, $type) = @_;

    my $count;
    if( $type eq 'DigitalInput' &&
        $obj->does( 'Device::WebIO::Device::DigitalInput' ) ) {
        $count = $obj->input_pin_count;
    }
    elsif( $type eq 'DigitalInputCallback' &&
        $obj->does( 'Device::WebIO::Device::DigitalInputCallback' ) ) {
        $count = $obj->input_pin_count;
    }
    elsif( $type eq 'DigitalOutput' &&
        $obj->does( 'Device::WebIO::Device::DigitalOutput' ) ) {
        $count = $obj->output_pin_count;
    }
    elsif( $type eq 'ADC' &&
        $obj->does( 'Device::WebIO::Device::ADC' ) ) {
        $count = $obj->adc_pin_count;
    }
    elsif( $type eq 'PWM' &&
        $obj->does( 'Device::WebIO::Device::PWM' ) ) {
        $count = $obj->pwm_pin_count;
    }
    elsif( $type eq 'VideoOutput' &&
        $obj->does( 'Device::WebIO::Device::VideoOutput' ) ) {
        $count = $obj->vid_channels;
    }
    elsif( $type eq 'StillImageOutput' &&
        $obj->does( 'Device::WebIO::Device::StillImageOutput' ) ) {
        $count = $obj->img_channels;
    }
    elsif( $type eq 'I2CProvider' &&
        $obj->does( 'Device::WebIO::Device::I2CProvider' ) ) {
        $count = $obj->i2c_channels;
    }
    elsif( $type eq 'SPI' &&
        $obj->does( 'Device::WebIO::Device::SPI' ) ) {
        $count = $obj->spi_channels;
    }

    return $count;
}

sub _role_check
{
    my ($self, $obj, @want_types) = @_;

    my $does = 0;
    for (@want_types) {
        my $full_type = 'Device::WebIO::Device::' . $_;
        if( $obj->does( $full_type ) ) {
            $does = 1;
            last;
        }
    }
    if(! $does ) {
        Device::WebIO::FunctionNotSupportedException->throw( message =>
            "Object of type " . ref($obj)
                . " does not any of the " . join( ', ', @want_types ) . " roles"
        );
    }

    return 1;
}


1;
__END__