package Device::SMBus;

use 5.005;
use strict;
use warnings;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
require Exporter;

@Device::SMBus::ISA       = qw(Exporter);
@Device::SMBus::EXPORT_OK = qw( );
@Device::SMBus::EXPORT    = qw( );

use IO::File;
use Fcntl;

BEGIN
{
    $Device::SMBus::VERSION = '0.01';
}

use Inline(
    C => Config => INC => '-I/usr/local/include',
    AUTO_INCLUDE => '#include <linux/i2c.h>
            #include <linux/i2c-dev.h>',
    CCFLAGS => '-O2',    # necessary for inline functions
);

use Inline C => 'DATA' => NAME => 'Device::SMBus',
  VERSION => $VERSION;

use constant I2C_SLAVE => 0x0703;

sub new
{
    my $class  = shift;
    my $device = shift;
    my $fh     = IO::File->new( $device, O_RDWR );
    if ( !$fh )
    {
        warn "Device::SMBus open error on $device: $!\n";
        return undef;
    }
    my $self = {
        _fh         => $fh,
        _fn         => $fh->fileno(),
        _lastDevice => -1,
    };
    bless( $self, $class );
}

sub DESTROY
{
    my $self = shift;
    $self->{_fh}->close();
}

sub selectDevice
{
    my $self   = shift;
    my $devno  = shift;
    my $oldDev = $self->{_lastDevice};
    $self->{_lastDevice} = $devno;
    ( $oldDev != $devno ) ? $self->{_fh}->ioctl( I2C_SLAVE, $devno ) :
+ 1;
}

# return (data, errno) in array context,
# or just data (-1 for error).

sub readWordData
{
    my $self   = shift;
    my $cmd    = shift;
    my $retval = _readWordData( $self->{_fn}, $cmd );
    return wantarray ? ( $retval, ( ( $retval == -1 ) ? $! : 0 ) ) : $
+retval;
}

sub writeWordData
{
    my $self  = shift;
    my $cmd   = shift;
    my $value = shift;
    return _writeWordData( $self->{_fn}, $cmd, $value );
}

sub readBlockData
{
    my $self   = shift;
    my $cmd    = shift;
    my $data   = ' ' x 32;
    my $retval = _readBlockData( $self->{_fn}, $cmd, $data );
    return ( $retval < 0 ) ? undef: $data;
}

1;

__DATA__

__C__

int _writeQuick(int file, int value)
{
    return i2c_smbus_write_quick(file, value);
}

int _readByte(int file)
{
    return i2c_smbus_read_byte(file);
}

int _writeByte(int file, int value)
{
    return i2c_smbus_write_byte(file, value);
}

int _readByteData(int file, int command)
{
    return i2c_smbus_read_byte_data(file, command);
}

int _writeByteData(int file, int command, int value)
{
    return i2c_smbus_write_byte_data(file, command, value);
}

int _readWordData(int file, int command)
{
    return i2c_smbus_read_word_data(file, command);
}

int _writeWordData(int file, int command, int value)
{
    return i2c_smbus_write_word_data(file, command, value);
}

int _processCall(int file, int command, int value)
{
    return i2c_smbus_process_call(file, command, value);
}

int _readBlockData(int file, int command, SV* output)
{
    char buf[ 32 ];
    int retval;
    retval = i2c_smbus_read_block_data(file, command, buf);
    if (retval == -1)
        return retval;
    sv_setpvn(output, buf, retval);
    return retval;
}

int _writeBlockData(int file, int command, SV* value)
{
    STRLEN len;
    char *buf = SvPV(value, len);
    return i2c_smbus_write_block_data(file, command, len, buf);
}

int _writeI2CBlockData(int file, int command, SV* value)
{
    STRLEN len;
    char *buf = SvPV(value, len);
    return i2c_smbus_write_i2c_block_data(file, command, len, buf);
}

=pod

=head1 NAME

Device::SMBus - Perl extension to access the SMBus via Linux ioctls.

=head1 SYNOPSIS

  use Device::SMBus;
  my $smbus = Device::SMBus->new('/dev/i2c-0');
  $smbus->selectDevice( $deviceNumber );
  my $data = $smbus->readWordData( $command );
  $smbus->writeWordData( $command, $data );
  # etc.

=head1 DESCRIPTION

This provides a thin wrapper for the Linux I2C and SMBus ioctls.

=head2 EXPORT

None by default.

=head1 AUTHOR

Ned Konz, ned@bike-nomad.com

=head1 SEE ALSO

L<Inline>

L<perl>

=cut