File Coverage

blib/lib/Device/PCDuino.pm

Criterion	Covered	Total	%
statement	15	48	31.2
branch	0	8	0.0
condition			n/a
subroutine	5	12	41.6
pod	5	6	83.3
total	25	74	33.7

# 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::PCDuino;
$Device::PCDuino::VERSION = '0.001';
use v5.14;

# ABSTRACT: Control the pcDuino with Perl

use base 'Exporter';
our @EXPORT_OK = qw{
    set_input
    input
    set_output
    output
    input_adc
    output_pwm
};
our @EXPORT = @EXPORT_OK;

use constant MODE_FILE_PATH => '/sys/devices/virtual/misc/gpio/mode/gpio';
use constant PIN_FILE_PATH  => '/sys/devices/virtual/misc/gpio/pin/gpio';
use constant ADC_PIN_FILE_PATH => '/proc/adc';


sub set_input
{
    my ($pin) = @_;
    return _set_pin( $pin, 0 );
}

sub set_output
{
    my ($pin) = @_;
    return _set_pin( $pin, 1 );
}

sub input
{
    my ($pin) = @_;
    my $file = PIN_FILE_PATH . $pin;
    open( my $in, '<', $file, ) or die "Can't open '$file': $!\n";

    my $input = '';
    read( $in, $input, 4 );

    close $in;

    chomp $input;
    return $input;
}

sub output
{
    my ($pin, $output) = @_;
    my $file = PIN_FILE_PATH . $pin;
    open( my $out, '>', $file, ) or die "Can't open '$file': $!\n";
    print $out "$output";
    close $out;
    return 1;
}

sub input_adc
{
    my ($pin) = @_;
    my $path = ADC_PIN_FILE_PATH . $pin;

    open( my $in, '<', $path ) or die "Can't open '$path': $!\n";
    my $input = <$in>;
    close $in;

    my ($val) = $input =~ /\A [^:]* : ([0-9]+) /x;
    return $val;
}

sub output_pwm
{
    my ($pin, $output) = @_;

    return 1;
}

sub _set_pin
{
    my ($pin, $type) = @_;
    my $file = MODE_FILE_PATH . $pin;
    open( my $out, '>', $file, ) or die "Can't open '$file': $!\n";
    print $out "$type";
    close $out;
    return 1;
}


1;
__END__