File Coverage

blib/lib/HiPi/Device/I2C.pm

Criterion	Covered	Total	%
statement	30	278	10.7
branch	0	118	0.0
condition	0	23	0.0
subroutine	10	53	18.8
pod	0	40	0.0
total	40	512	7.8

#########################################################################################
# Package        HiPi::Device::I2C
# Description:   Wrapper for I2C communucation
# Copyright    : Copyright (c) 2013-2017 Mark Dootson
# Copyright    : Copyright (c) 2013-2017 Mark Dootson
# License      : This is free software; you can redistribute it and/or modify it under
#                the same terms as the Perl 5 programming language system itself.
#########################################################################################

package HiPi::Device::I2C;

#########################################################################################

use strict;
use warnings;
use parent qw( HiPi::Device );
use HiPi qw( :i2c :rpi );
use HiPi::RaspberryPi;
use IO::File;
use XSLoader;
use Carp;
use Try::Tiny;

use constant {
    I2C_BCM2708 => 1,
    I2C_BCM2835 => 2,
};

our $VERSION ='0.81';

__PACKAGE__->create_accessors( qw ( fh fno address busmode readmode ) );

XSLoader::load('HiPi::Device::I2C', $VERSION) if HiPi::is_raspberry_pi();

my $modvers = ( -e '/sys/module/i2c_bcm2708' ) ? I2C_BCM2708 : I2C_BCM2835;

my $combined_param_path = '/sys/module/i2c_bcm2708/parameters/combined';
my $baudrate_param_path = '/sys/module/i2c_bcm2708/parameters/baudrate';

sub get_required_module_options {
    my $moduleoptions = [
        [ qw( i2c_bcm2708 i2c_dev ) ], # older i2c modules
        [ qw( i2c_bcm2385 i2c_dev ) ], # recent i2c modules
    ];
    return $moduleoptions;
}

sub get_device_list {
    # get the devicelist
    opendir my $dh, '/dev' or croak qq(Failed to open dev : $!);
    my @i2cdevs = grep { $_ =~ /^i2c-\d+$/ } readdir $dh;
    closedir($dh);
    for (my $i = 0; $i < @i2cdevs; $i++) {
        $i2cdevs[$i] = '/dev/' . $i2cdevs[$i];
    }
    return @i2cdevs;
}

sub get_baudrate {
    my ($class) = @_;
    if ( $modvers == I2C_BCM2835 ) {
        my $sysfile = '/sys/class/i2c-adapter/i2c-1/of_node/clock-frequency';
        my $sysfile0 = '/sys/class/i2c-adapter/i2c-0/of_node/clock-frequency';
        if( -e $sysfile0 && !-e $sysfile ) {
            $sysfile = $sysfile0;
        }
        if( -e $sysfile ) {
            my $baudrate = qx(xxd -ps $sysfile);
            chomp $baudrate;
            return hex($baudrate);
        } else {
            return 0;
        }
    } else {
        my $baudrate = qx(/bin/cat $baudrate_param_path);
        if($?) {
            carp q(Unable to determine baudrate);
            return 0;
        }
        chomp($baudrate);
        return $baudrate;
    }
}

sub get_driver {
    return ( $modvers == I2C_BCM2835 ) ? 'i2c_bcm2835' : 'i2c_bcm2708';
}

sub get_combined {
    my ($class) = @_;
    return 'Y' if $modvers == I2C_BCM2835;
    my $combined = qx(/bin/cat $combined_param_path);
    if($?) {
        carp q(Unable to determine combined setting);
        return 'N';
    }
    chomp($combined);
    return $combined;
}

sub set_combined {
    my ($class, $newval) = @_;
    $newval //= 'N';
    $newval = uc($newval);
    croak('Usage HiPi::Device::I2C->set_combined( "Y|N" )') unless ( $newval =~ /^Y|N$/ );
    return 'Y' if $modvers == I2C_BCM2835;
    qx(/bin/echo $newval > $combined_param_path);
    return $newval;
}

sub new {
    my ($class, %userparams) = @_;

    my $pi = HiPi::RaspberryPi->new();

    my %params = (
        devicename   => ( $pi->board_type == RPI_BOARD_TYPE_1 ) ? '/dev/i2c-0' : '/dev/i2c-1',
        address      => 0,
        fh           => undef,
        fno          => undef,
        busmode      => 'smbus',
        readmode     => I2C_READMODE_SYSTEM,
    );

    foreach my $key (sort keys(%userparams)) {
        $params{$key} = $userparams{$key};
    }

    my $fh = IO::File->new( $params{devicename}, O_RDWR, 0 ) or croak qq(open error on $params{devicename}: $!\n);

    $params{fh}  = $fh;
    $params{fno} = $fh->fileno(),

    my $self = $class->SUPER::new(%params);

    # select address if id provided
    $self->select_address( $self->address ) if $self->address;

    return $self;
}

sub close {
    my $self = shift;
    if( $self->fh ) {
        $self->fh->flush;
        $self->fh->close;
        $self->fh( undef );
        $self->fno( undef );
        $self->address( undef );
    }
}

sub select_address {
    my ($self, $address) = @_;
    $self->address( $address );
    return $self->reset_ioctl;
}

sub reset_ioctl {
    my $self = shift;
    my $result = -1;
    if( $self->address ) {
        $result = $self->ioctl( I2C_SLAVE, $self->address + 0 );
    }
    return $result;
}

sub send_software_reset {
    my $self = shift;
    my $devicename = $self->devicename;
    my $result = -1;
    try {
        my $fh = IO::File->new( $devicename, O_RDWR, 0 ) or croak qq(open error on $devicename $!\n);
        $fh->ioctl( I2C_SLAVE, 0 );
        my $buffer = pack('C*', 0x06, 0);
        $result = _i2c_write( $fh->fileno, 0, $buffer, 1 );
        $fh->close;
    } catch {
        warn $_;
    };

    return $result;
}

sub ioctl {
    my ($self, $ioctlconst, $data) = @_;
    $self->fh->ioctl( $ioctlconst, $data );
}

sub scan_bus {
    my( $self, $mode, $start, $end) = @_;
    $mode //= I2C_SCANMODE_AUTO;
    $start //= 0x03;
    $end //= 0x77;
    $start = 0x03 if $start < 0x03;
    $end = 0x77 if $end > 0x77;
    $end = $start if $end < $start;
    my @results = i2c_scan_bus($self->fno, $mode, $start, $end);

    # need to reset the ioctl address
    $self->reset_ioctl;

    return @results;
}

sub check_address {
    my($self, $checkaddress) = @_;
    $checkaddress //= $self->address;
    return 0 unless $checkaddress;
    my @result = $self->scan_bus(I2C_SCANMODE_AUTO, $checkaddress, $checkaddress );
    return 0 unless @result;
    return (  $result[0] == $checkaddress ) ? 1 : 0;
}

#-------------------------------------------
# Methods that honour busmode (smbus or i2c)
#-------------------------------------------

sub bus_write {
    my ( $self, @bytes ) = @_;
    if( $self->busmode eq 'smbus' ) {
        return $self->smbus_write( @bytes );
    } else {
        return $self->i2c_write( @bytes );
    }
}

sub bus_write_error {
    my ( $self, @bytes ) = @_;
    if( $self->busmode eq 'smbus' ) {
        return $self->smbus_write_error( @bytes );
    } else {
        return $self->i2c_write_error( @bytes );
    }
}

sub bus_read {
    my ($self, $cmdval, $numbytes) = @_;

    # check if we need to change read mode
    my $resetcombined = undef;

    if( $modvers == I2C_BCM2708 ) {
        if ($self->readmode == I2C_READMODE_START_STOP  ) {
            my $combined = $self->get_combined;
            if ( $combined ne 'N') {
                $resetcombined = $combined;
                $self->set_combined('N');
            }
        } elsif($self->readmode == I2C_READMODE_REPEATED_START  ) {
            my $combined = $self->get_combined;
            if ( $combined ne 'Y') {
                $resetcombined = $combined;
                $self->set_combined('Y');
            }
        }
    }

    my @arrayreturn  = ();

    if( $self->busmode eq 'smbus' ) {
        @arrayreturn = $self->smbus_read( $cmdval, $numbytes );

    # i2c modes
    } elsif( defined($cmdval) ) {
        @arrayreturn = $self->i2c_read_register($cmdval, $numbytes );
    } else {
        # read without write
        @arrayreturn = $self->i2c_read( $numbytes );
    }

    $self->set_combined($resetcombined) if $resetcombined;

    return @arrayreturn;
}

sub bus_read_bits {
    my($self, $regaddr, $numbytes) = @_;
    $numbytes ||= 1;
    my @bytes = $self->bus_read($regaddr, $numbytes);
    my @bits;
    while( defined(my $byte = shift @bytes )) {
        my $checkbits = 0b00000001;
        for( my $i = 0; $i < 8; $i++ ) {
            my $val = ( $byte & $checkbits ) ? 1 : 0;
            push( @bits, $val );
            $checkbits *= 2;
        }
    }
    return @bits;
}

sub bus_write_bits {
    my($self, $register, @bits) = @_;
    my $bitcount  = @bits;
    my $bytecount = $bitcount / 8;
    if( $bitcount % 8 ) { croak(qq(The number of bits $bitcount cannot be ordered into bytes)); }
    my @bytes;
    while( $bytecount ) {
        my $byte = 0;
        for(my $i = 0; $i < 8; $i++ ) {
            my $bit = shift @bits;
            $byte += ( $bit << $i );
        }
        push(@bytes, $byte);
        $bytecount --;
    }
    $self->bus_write($register, @bytes);
}

#-------------------------------------------
# I2C interface
#-------------------------------------------

sub i2c_write {
    my( $self, @bytes ) = @_;
    my $buffer = pack('C*', @bytes, '0');
    my $len = @bytes;
    my $result = _i2c_write($self->fno, $self->address, $buffer, $len );
    croak qq(i2c_write failed with return value $result) if $result;
}

sub i2c_write_error {
    my( $self, @bytes ) = @_;
    my $buffer = pack('C*', @bytes, '0');
    my $len = @bytes;
    _i2c_write($self->fno, $self->address, $buffer, $len );
}

sub i2c_read {
    my($self, $numbytes) = @_;
    $numbytes ||= 1;
    my $buffer = '0' x ( $numbytes + 1 );
    my $result = _i2c_read($self->fno, $self->address, $buffer, $numbytes );
    croak qq(i2c_read failed with return value $result) if $result;
    my $template = ( $numbytes > 1 ) ? 'C' . $numbytes : 'C';
    my @vals = unpack($template, $buffer );
    return @vals;
}

sub i2c_read_register {
    my($self, $register, $numbytes) = @_;
    $numbytes ||= 1;
    my $rbuffer = '0' x ( $numbytes + 1 );
    my $wbuffer = pack('C', $register);
    my $result = _i2c_read_register($self->fno, $self->address, $wbuffer, $rbuffer, $numbytes );
    croak qq(i2c_read_register failed with return value $result) if $result;
    my $template = ( $numbytes > 1 ) ? 'C' . $numbytes : 'C';
    my @vals = unpack($template, $rbuffer );
    return @vals;
}

#-------------------------------------------
# SMBus interface
#-------------------------------------------

sub smbus_write {
    my ($self, @bytes) = @_;
    if( @bytes == 1) {
        $self->smbus_write_byte($bytes[0]);
    } elsif( @bytes == 2) {
        $self->smbus_write_byte_data( @bytes );
    } else {
        my $command = shift @bytes;
        $self->smbus_write_i2c_block_data($command, \@bytes );
    }
}

sub smbus_write_error {
    my ($self, @bytes) = @_;
    # we allow errors - so catch auto generated error
    try {
        if( @bytes == 1) {
            $self->smbus_write_byte($bytes[0]);
        } elsif( @bytes == 2) {
            $self->smbus_write_byte_data( @bytes );
        } else {
            my $command = shift @bytes;
            $self->smbus_write_i2c_block_data($command, \@bytes );
        }
    };
}

sub smbus_read {
    my ($self, $cmdval, $numbytes) = @_;
    if(!defined($cmdval)) {
        return $self->smbus_read_byte;
    } elsif(!$numbytes || $numbytes <= 1 ) {
        return $self->smbus_read_byte_data( $cmdval );
    } else {
        return $self->smbus_read_i2c_block_data($cmdval, $numbytes );
    }
}

sub smbus_write_quick {
    my($self, $command ) = @_;
    my $result = i2c_smbus_write_quick($self->fno, $command);
    croak qq(smbus_write_quick failed with return value $result) if $result < 0;
    return $result;
}

sub smbus_read_byte {
    my( $self ) = @_;
    my $result = i2c_smbus_read_byte( $self->fno );
    croak qq(smbus_read_byte failed with return value $result) if $result < 0;
    return ( $result );
}

sub smbus_write_byte {
    my($self, $command) = @_;
    my $result = i2c_smbus_write_byte($self->fno, $command);
    croak qq(smbus_write_byte failed with return value $result) if $result < 0;
    return $result;
}

sub smbus_read_byte_data {
    my($self, $command) = @_;
    my $result = i2c_smbus_read_byte_data($self->fno, $command);
    croak qq(smbus_read_byte_data failed with return value $result) if $result < 0;
    return ( $result );
}

sub smbus_write_byte_data {
    my($self, $command, $data) = @_;
    my $result = i2c_smbus_write_byte_data($self->fno,  $command, $data);
    croak qq(smbus_write_byte_data failed with return value $result) if $result < 0;
    return $result;
}

sub smbus_read_word_data {
    my($self, $command) = @_;
    my $result = i2c_smbus_read_word_data($self->fno, $command);
    croak qq(smbus_read_word_data failed with return value $result) if $result < 0;
    return ( $result );
}

sub smbus_write_word_data {
    my($self, $command, $data) = @_;
    my $result = i2c_smbus_write_word_data($self->fno, $command, $data);
    croak qq(smbus_write_word_data failed with return value $result) if $result < 0;
    return $result;
}

sub smbus_read_word_swapped {
    my($self, $command) = @_;
    my $result = i2c_smbus_read_word_swapped($self->fno, $command);
    croak qq(smbus_read_word_swapped failed with return value $result) if $result < 0;
    return ( $result );
}

sub smbus_write_word_swapped {
    my($self, $command, $data) = @_;
    my $result = i2c_smbus_write_word_swapped($self->fno, $command, $data);
    croak qq(smbus_write_word_swapped failed with return value $result) if $result < 0;
    return $result;
}

sub smbus_process_call {
    my($self, $command, $data) = @_;
    my $result = i2c_smbus_process_call($self->fno, $command, $data);
    croak qq(smbus_process_call failed with return value $result) if $result < 0;
    return $result;
}

sub smbus_read_block_data {
    my($self, $command) = @_;
    my @result = i2c_smbus_read_block_data($self->fno, $command);
    croak qq(smbus_read_block_data failed ) unless @result;
    return @result;
}

sub smbus_read_i2c_block_data {
    my($self, $command, $numbytes) = @_;
    my @result = i2c_smbus_read_i2c_block_data($self->fno, $command, $numbytes);
    croak qq(smbus_read_i2c_block_data failed ) unless @result;
    return @result;
}

sub smbus_write_block_data {
    my($self, $command, $data) = @_;
    my $result = i2c_smbus_write_block_data($self->fno, $command, $data);
    croak qq(smbus_write_block_data failed with return value $result) if $result < 0;
    return $result;
}

sub smbus_write_i2c_block_data {
    my($self, $command, $data) = @_;
    my $result = i2c_smbus_write_i2c_block_data($self->fno, $command, $data);
    croak qq(smbus_write_i2c_block_data failed with return value $result) if $result < 0;
    return $result;
}

1;

__END__