The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#########################################################################################
# Package       HiPi::Interface::MCP23017
# Description:  Control MCP23017 Port Extender via I2C
# Created       Sun Dec 02 01:42:27 2012
# SVN Id        $Id: MCP23017.pm 77 2016-03-29 13:37:05Z Mark Dootson $
# Copyright:    Copyright (c) 2012-2016 Mark Dootson
# Licence:      This work is free software; you can redistribute it and/or modify it 
#               under the terms of the GNU General Public License as published by the 
#               Free Software Foundation; either version 3 of the License, or any later 
#               version.
#########################################################################################

package HiPi::Interface::MCP23017;

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

use strict;
use warnings;
use parent qw( HiPi::Interface::MCP23X17 );
use HiPi::Constant qw( :raspberry );
use Carp;

our $VERSION = '0.25';

our @EXPORT = ();
our @EXPORT_OK = ();
our %EXPORT_TAGS = ( all => \@EXPORT_OK );

use constant $HiPi::Interface::MCP23X17::mcp23S17const;
use constant $HiPi::Interface::MCP23X17::mcp23017const;
use constant $HiPi::Interface::MCP23X17::mcpPinConst;

{
    # allow use of constants with both naming conventions
    my @const23S17 = ( keys %$HiPi::Interface::MCP23X17::mcp23S17const );
    push( @EXPORT_OK, @const23S17 );
    $EXPORT_TAGS{mcp23S17} = \@const23S17;
    
    my @const23017 = ( keys %$HiPi::Interface::MCP23X17::mcp23017const );
    push( @EXPORT_OK, @const23017 );
    $EXPORT_TAGS{mcp23017} = \@const23017;
    
    my @constMCPpin = ( keys %$HiPi::Interface::MCP23X17::mcpPinConst );
    push( @EXPORT_OK, @constMCPpin );
    $EXPORT_TAGS{mcppin} = \@constMCPpin;
}

sub new {
    my ($class, %userparams) = @_;
    
    my %params = (
        devicename  => ( RPI_BOARD_REVISION == 1 ) ? '/dev/i2c-0' : '/dev/i2c-1',
        address     => 0x20,
        device      => undef,
        backend     => 'smbus',
     _function_mode => 'hipi',
    );
    
    # get user params
    foreach my $key( keys (%userparams) ) {
        $params{$key} = $userparams{$key};
    }
    
    unless( defined($params{device}) ) {
        
        if ( $params{backend} eq 'bcm2835' ) {
            require HiPi::BCM2835::I2C;
            $params{device} = HiPi::BCM2835::I2C->new(
                address    => $params{address},
                peripheral => ( $params{devicename} eq '/dev/i2c-0' ) ? HiPi::BCM2835::I2C::BB_I2C_PERI_0() : HiPi::BCM2835::I2C::BB_I2C_PERI_1(),
            _function_mode => $params{_function_mode},
            );
        } else {
            require HiPi::Device::I2C;
            $params{device} = HiPi::Device::I2C->new(
                devicename  => $params{devicename},
                address     => $params{address},
                busmode     => $params{backend},
            );
        }
    }
    
    my $self = $class->SUPER::new(%params);
    
    # get current register address config so correct settings are loaded
    
    $self->read_register_bytes('IOCON');
    
    return $self;
}

sub do_write_register_bytes {
    my($self, $regaddress, @bytes) = @_;
    my $rval = $self->device->bus_write($regaddress, @bytes);
    return $rval;
}

sub do_read_register_bytes {
    my($self, $regaddress, $numbytes) = @_;
    my @vals = $self->device->bus_read($regaddress, $numbytes);
    return @vals;
}

1;

__END__