line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
######################################################################################### |
2
|
|
|
|
|
|
|
# Package HiPi::Device::I2C |
3
|
|
|
|
|
|
|
# Description: Wrapper for I2C communucation |
4
|
|
|
|
|
|
|
# Copyright : Copyright (c) 2013-2017 Mark Dootson |
5
|
|
|
|
|
|
|
# Copyright : Copyright (c) 2013-2017 Mark Dootson |
6
|
|
|
|
|
|
|
# License : This is free software; you can redistribute it and/or modify it under |
7
|
|
|
|
|
|
|
# the same terms as the Perl 5 programming language system itself. |
8
|
|
|
|
|
|
|
######################################################################################### |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
package HiPi::Device::I2C; |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
######################################################################################### |
13
|
|
|
|
|
|
|
|
14
|
1
|
|
|
1
|
|
1592
|
use strict; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
34
|
|
15
|
1
|
|
|
1
|
|
6
|
use warnings; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
32
|
|
16
|
1
|
|
|
1
|
|
13
|
use parent qw( HiPi::Device ); |
|
1
|
|
|
|
|
23
|
|
|
1
|
|
|
|
|
7
|
|
17
|
1
|
|
|
1
|
|
63
|
use HiPi qw( :i2c :rpi ); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
349
|
|
18
|
1
|
|
|
1
|
|
8
|
use HiPi::RaspberryPi; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
7
|
|
19
|
1
|
|
|
1
|
|
650
|
use IO::File; |
|
1
|
|
|
|
|
9356
|
|
|
1
|
|
|
|
|
119
|
|
20
|
1
|
|
|
1
|
|
9
|
use XSLoader; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
8
|
|
21
|
1
|
|
|
1
|
|
21
|
use Carp; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
45
|
|
22
|
1
|
|
|
1
|
|
6
|
use Try::Tiny; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
54
|
|
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
use constant { |
25
|
1
|
|
|
|
|
3660
|
I2C_BCM2708 => 1, |
26
|
|
|
|
|
|
|
I2C_BCM2835 => 2, |
27
|
1
|
|
|
1
|
|
5
|
}; |
|
1
|
|
|
|
|
2
|
|
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
our $VERSION ='0.81'; |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
__PACKAGE__->create_accessors( qw ( fh fno address busmode readmode ) ); |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
XSLoader::load('HiPi::Device::I2C', $VERSION) if HiPi::is_raspberry_pi(); |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
my $modvers = ( -e '/sys/module/i2c_bcm2708' ) ? I2C_BCM2708 : I2C_BCM2835; |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
my $combined_param_path = '/sys/module/i2c_bcm2708/parameters/combined'; |
38
|
|
|
|
|
|
|
my $baudrate_param_path = '/sys/module/i2c_bcm2708/parameters/baudrate'; |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
sub get_required_module_options { |
41
|
0
|
|
|
0
|
0
|
|
my $moduleoptions = [ |
42
|
|
|
|
|
|
|
[ qw( i2c_bcm2708 i2c_dev ) ], # older i2c modules |
43
|
|
|
|
|
|
|
[ qw( i2c_bcm2385 i2c_dev ) ], # recent i2c modules |
44
|
|
|
|
|
|
|
]; |
45
|
0
|
|
|
|
|
|
return $moduleoptions; |
46
|
|
|
|
|
|
|
} |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
sub get_device_list { |
49
|
|
|
|
|
|
|
# get the devicelist |
50
|
0
|
0
|
|
0
|
0
|
|
opendir my $dh, '/dev' or croak qq(Failed to open dev : $!); |
51
|
0
|
|
|
|
|
|
my @i2cdevs = grep { $_ =~ /^i2c-\d+$/ } readdir $dh; |
|
0
|
|
|
|
|
|
|
52
|
0
|
|
|
|
|
|
closedir($dh); |
53
|
0
|
|
|
|
|
|
for (my $i = 0; $i < @i2cdevs; $i++) { |
54
|
0
|
|
|
|
|
|
$i2cdevs[$i] = '/dev/' . $i2cdevs[$i]; |
55
|
|
|
|
|
|
|
} |
56
|
0
|
|
|
|
|
|
return @i2cdevs; |
57
|
|
|
|
|
|
|
} |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
sub get_baudrate { |
60
|
0
|
|
|
0
|
0
|
|
my ($class) = @_; |
61
|
0
|
0
|
|
|
|
|
if ( $modvers == I2C_BCM2835 ) { |
62
|
0
|
|
|
|
|
|
my $sysfile = '/sys/class/i2c-adapter/i2c-1/of_node/clock-frequency'; |
63
|
0
|
|
|
|
|
|
my $sysfile0 = '/sys/class/i2c-adapter/i2c-0/of_node/clock-frequency'; |
64
|
0
|
0
|
0
|
|
|
|
if( -e $sysfile0 && !-e $sysfile ) { |
65
|
0
|
|
|
|
|
|
$sysfile = $sysfile0; |
66
|
|
|
|
|
|
|
} |
67
|
0
|
0
|
|
|
|
|
if( -e $sysfile ) { |
68
|
0
|
|
|
|
|
|
my $baudrate = qx(xxd -ps $sysfile); |
69
|
0
|
|
|
|
|
|
chomp $baudrate; |
70
|
0
|
|
|
|
|
|
return hex($baudrate); |
71
|
|
|
|
|
|
|
} else { |
72
|
0
|
|
|
|
|
|
return 0; |
73
|
|
|
|
|
|
|
} |
74
|
|
|
|
|
|
|
} else { |
75
|
0
|
|
|
|
|
|
my $baudrate = qx(/bin/cat $baudrate_param_path); |
76
|
0
|
0
|
|
|
|
|
if($?) { |
77
|
0
|
|
|
|
|
|
carp q(Unable to determine baudrate); |
78
|
0
|
|
|
|
|
|
return 0; |
79
|
|
|
|
|
|
|
} |
80
|
0
|
|
|
|
|
|
chomp($baudrate); |
81
|
0
|
|
|
|
|
|
return $baudrate; |
82
|
|
|
|
|
|
|
} |
83
|
|
|
|
|
|
|
} |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
sub get_driver { |
86
|
0
|
0
|
|
0
|
0
|
|
return ( $modvers == I2C_BCM2835 ) ? 'i2c_bcm2835' : 'i2c_bcm2708'; |
87
|
|
|
|
|
|
|
} |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
sub get_combined { |
90
|
0
|
|
|
0
|
0
|
|
my ($class) = @_; |
91
|
0
|
0
|
|
|
|
|
return 'Y' if $modvers == I2C_BCM2835; |
92
|
0
|
|
|
|
|
|
my $combined = qx(/bin/cat $combined_param_path); |
93
|
0
|
0
|
|
|
|
|
if($?) { |
94
|
0
|
|
|
|
|
|
carp q(Unable to determine combined setting); |
95
|
0
|
|
|
|
|
|
return 'N'; |
96
|
|
|
|
|
|
|
} |
97
|
0
|
|
|
|
|
|
chomp($combined); |
98
|
0
|
|
|
|
|
|
return $combined; |
99
|
|
|
|
|
|
|
} |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
sub set_combined { |
102
|
0
|
|
|
0
|
0
|
|
my ($class, $newval) = @_; |
103
|
0
|
|
0
|
|
|
|
$newval //= 'N'; |
104
|
0
|
|
|
|
|
|
$newval = uc($newval); |
105
|
0
|
0
|
|
|
|
|
croak('Usage HiPi::Device::I2C->set_combined( "Y|N" )') unless ( $newval =~ /^Y|N$/ ); |
106
|
0
|
0
|
|
|
|
|
return 'Y' if $modvers == I2C_BCM2835; |
107
|
0
|
|
|
|
|
|
qx(/bin/echo $newval > $combined_param_path); |
108
|
0
|
|
|
|
|
|
return $newval; |
109
|
|
|
|
|
|
|
} |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
sub new { |
112
|
0
|
|
|
0
|
0
|
|
my ($class, %userparams) = @_; |
113
|
|
|
|
|
|
|
|
114
|
0
|
|
|
|
|
|
my $pi = HiPi::RaspberryPi->new(); |
115
|
|
|
|
|
|
|
|
116
|
0
|
0
|
|
|
|
|
my %params = ( |
117
|
|
|
|
|
|
|
devicename => ( $pi->board_type == RPI_BOARD_TYPE_1 ) ? '/dev/i2c-0' : '/dev/i2c-1', |
118
|
|
|
|
|
|
|
address => 0, |
119
|
|
|
|
|
|
|
fh => undef, |
120
|
|
|
|
|
|
|
fno => undef, |
121
|
|
|
|
|
|
|
busmode => 'smbus', |
122
|
|
|
|
|
|
|
readmode => I2C_READMODE_SYSTEM, |
123
|
|
|
|
|
|
|
); |
124
|
|
|
|
|
|
|
|
125
|
0
|
|
|
|
|
|
foreach my $key (sort keys(%userparams)) { |
126
|
0
|
|
|
|
|
|
$params{$key} = $userparams{$key}; |
127
|
|
|
|
|
|
|
} |
128
|
|
|
|
|
|
|
|
129
|
0
|
0
|
|
|
|
|
my $fh = IO::File->new( $params{devicename}, O_RDWR, 0 ) or croak qq(open error on $params{devicename}: $!\n); |
130
|
|
|
|
|
|
|
|
131
|
0
|
|
|
|
|
|
$params{fh} = $fh; |
132
|
0
|
|
|
|
|
|
$params{fno} = $fh->fileno(), |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
my $self = $class->SUPER::new(%params); |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
# select address if id provided |
137
|
0
|
0
|
|
|
|
|
$self->select_address( $self->address ) if $self->address; |
138
|
|
|
|
|
|
|
|
139
|
0
|
|
|
|
|
|
return $self; |
140
|
|
|
|
|
|
|
} |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
sub close { |
143
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
144
|
0
|
0
|
|
|
|
|
if( $self->fh ) { |
145
|
0
|
|
|
|
|
|
$self->fh->flush; |
146
|
0
|
|
|
|
|
|
$self->fh->close; |
147
|
0
|
|
|
|
|
|
$self->fh( undef ); |
148
|
0
|
|
|
|
|
|
$self->fno( undef ); |
149
|
0
|
|
|
|
|
|
$self->address( undef ); |
150
|
|
|
|
|
|
|
} |
151
|
|
|
|
|
|
|
} |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
sub select_address { |
154
|
0
|
|
|
0
|
0
|
|
my ($self, $address) = @_; |
155
|
0
|
|
|
|
|
|
$self->address( $address ); |
156
|
0
|
|
|
|
|
|
return $self->reset_ioctl; |
157
|
|
|
|
|
|
|
} |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
sub reset_ioctl { |
160
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
161
|
0
|
|
|
|
|
|
my $result = -1; |
162
|
0
|
0
|
|
|
|
|
if( $self->address ) { |
163
|
0
|
|
|
|
|
|
$result = $self->ioctl( I2C_SLAVE, $self->address + 0 ); |
164
|
|
|
|
|
|
|
} |
165
|
0
|
|
|
|
|
|
return $result; |
166
|
|
|
|
|
|
|
} |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
sub send_software_reset { |
169
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
170
|
0
|
|
|
|
|
|
my $devicename = $self->devicename; |
171
|
0
|
|
|
|
|
|
my $result = -1; |
172
|
|
|
|
|
|
|
try { |
173
|
0
|
0
|
|
0
|
|
|
my $fh = IO::File->new( $devicename, O_RDWR, 0 ) or croak qq(open error on $devicename $!\n); |
174
|
0
|
|
|
|
|
|
$fh->ioctl( I2C_SLAVE, 0 ); |
175
|
0
|
|
|
|
|
|
my $buffer = pack('C*', 0x06, 0); |
176
|
0
|
|
|
|
|
|
$result = _i2c_write( $fh->fileno, 0, $buffer, 1 ); |
177
|
0
|
|
|
|
|
|
$fh->close; |
178
|
|
|
|
|
|
|
} catch { |
179
|
0
|
|
|
0
|
|
|
warn $_; |
180
|
0
|
|
|
|
|
|
}; |
181
|
|
|
|
|
|
|
|
182
|
0
|
|
|
|
|
|
return $result; |
183
|
|
|
|
|
|
|
} |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
sub ioctl { |
186
|
0
|
|
|
0
|
0
|
|
my ($self, $ioctlconst, $data) = @_; |
187
|
0
|
|
|
|
|
|
$self->fh->ioctl( $ioctlconst, $data ); |
188
|
|
|
|
|
|
|
} |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
sub scan_bus { |
191
|
0
|
|
|
0
|
0
|
|
my( $self, $mode, $start, $end) = @_; |
192
|
0
|
|
0
|
|
|
|
$mode //= I2C_SCANMODE_AUTO; |
193
|
0
|
|
0
|
|
|
|
$start //= 0x03; |
194
|
0
|
|
0
|
|
|
|
$end //= 0x77; |
195
|
0
|
0
|
|
|
|
|
$start = 0x03 if $start < 0x03; |
196
|
0
|
0
|
|
|
|
|
$end = 0x77 if $end > 0x77; |
197
|
0
|
0
|
|
|
|
|
$end = $start if $end < $start; |
198
|
0
|
|
|
|
|
|
my @results = i2c_scan_bus($self->fno, $mode, $start, $end); |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
# need to reset the ioctl address |
201
|
0
|
|
|
|
|
|
$self->reset_ioctl; |
202
|
|
|
|
|
|
|
|
203
|
0
|
|
|
|
|
|
return @results; |
204
|
|
|
|
|
|
|
} |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
sub check_address { |
207
|
0
|
|
|
0
|
0
|
|
my($self, $checkaddress) = @_; |
208
|
0
|
|
0
|
|
|
|
$checkaddress //= $self->address; |
209
|
0
|
0
|
|
|
|
|
return 0 unless $checkaddress; |
210
|
0
|
|
|
|
|
|
my @result = $self->scan_bus(I2C_SCANMODE_AUTO, $checkaddress, $checkaddress ); |
211
|
0
|
0
|
|
|
|
|
return 0 unless @result; |
212
|
0
|
0
|
|
|
|
|
return ( $result[0] == $checkaddress ) ? 1 : 0; |
213
|
|
|
|
|
|
|
} |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
#------------------------------------------- |
216
|
|
|
|
|
|
|
# Methods that honour busmode (smbus or i2c) |
217
|
|
|
|
|
|
|
#------------------------------------------- |
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
sub bus_write { |
220
|
0
|
|
|
0
|
0
|
|
my ( $self, @bytes ) = @_; |
221
|
0
|
0
|
|
|
|
|
if( $self->busmode eq 'smbus' ) { |
222
|
0
|
|
|
|
|
|
return $self->smbus_write( @bytes ); |
223
|
|
|
|
|
|
|
} else { |
224
|
0
|
|
|
|
|
|
return $self->i2c_write( @bytes ); |
225
|
|
|
|
|
|
|
} |
226
|
|
|
|
|
|
|
} |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
sub bus_write_error { |
229
|
0
|
|
|
0
|
0
|
|
my ( $self, @bytes ) = @_; |
230
|
0
|
0
|
|
|
|
|
if( $self->busmode eq 'smbus' ) { |
231
|
0
|
|
|
|
|
|
return $self->smbus_write_error( @bytes ); |
232
|
|
|
|
|
|
|
} else { |
233
|
0
|
|
|
|
|
|
return $self->i2c_write_error( @bytes ); |
234
|
|
|
|
|
|
|
} |
235
|
|
|
|
|
|
|
} |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
sub bus_read { |
238
|
0
|
|
|
0
|
0
|
|
my ($self, $cmdval, $numbytes) = @_; |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
# check if we need to change read mode |
241
|
0
|
|
|
|
|
|
my $resetcombined = undef; |
242
|
|
|
|
|
|
|
|
243
|
0
|
0
|
|
|
|
|
if( $modvers == I2C_BCM2708 ) { |
244
|
0
|
0
|
|
|
|
|
if ($self->readmode == I2C_READMODE_START_STOP ) { |
|
|
0
|
|
|
|
|
|
245
|
0
|
|
|
|
|
|
my $combined = $self->get_combined; |
246
|
0
|
0
|
|
|
|
|
if ( $combined ne 'N') { |
247
|
0
|
|
|
|
|
|
$resetcombined = $combined; |
248
|
0
|
|
|
|
|
|
$self->set_combined('N'); |
249
|
|
|
|
|
|
|
} |
250
|
|
|
|
|
|
|
} elsif($self->readmode == I2C_READMODE_REPEATED_START ) { |
251
|
0
|
|
|
|
|
|
my $combined = $self->get_combined; |
252
|
0
|
0
|
|
|
|
|
if ( $combined ne 'Y') { |
253
|
0
|
|
|
|
|
|
$resetcombined = $combined; |
254
|
0
|
|
|
|
|
|
$self->set_combined('Y'); |
255
|
|
|
|
|
|
|
} |
256
|
|
|
|
|
|
|
} |
257
|
|
|
|
|
|
|
} |
258
|
|
|
|
|
|
|
|
259
|
0
|
|
|
|
|
|
my @arrayreturn = (); |
260
|
|
|
|
|
|
|
|
261
|
0
|
0
|
|
|
|
|
if( $self->busmode eq 'smbus' ) { |
|
|
0
|
|
|
|
|
|
262
|
0
|
|
|
|
|
|
@arrayreturn = $self->smbus_read( $cmdval, $numbytes ); |
263
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
# i2c modes |
265
|
|
|
|
|
|
|
} elsif( defined($cmdval) ) { |
266
|
0
|
|
|
|
|
|
@arrayreturn = $self->i2c_read_register($cmdval, $numbytes ); |
267
|
|
|
|
|
|
|
} else { |
268
|
|
|
|
|
|
|
# read without write |
269
|
0
|
|
|
|
|
|
@arrayreturn = $self->i2c_read( $numbytes ); |
270
|
|
|
|
|
|
|
} |
271
|
|
|
|
|
|
|
|
272
|
0
|
0
|
|
|
|
|
$self->set_combined($resetcombined) if $resetcombined; |
273
|
|
|
|
|
|
|
|
274
|
0
|
|
|
|
|
|
return @arrayreturn; |
275
|
|
|
|
|
|
|
} |
276
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
sub bus_read_bits { |
278
|
0
|
|
|
0
|
0
|
|
my($self, $regaddr, $numbytes) = @_; |
279
|
0
|
|
0
|
|
|
|
$numbytes ||= 1; |
280
|
0
|
|
|
|
|
|
my @bytes = $self->bus_read($regaddr, $numbytes); |
281
|
0
|
|
|
|
|
|
my @bits; |
282
|
0
|
|
|
|
|
|
while( defined(my $byte = shift @bytes )) { |
283
|
0
|
|
|
|
|
|
my $checkbits = 0b00000001; |
284
|
0
|
|
|
|
|
|
for( my $i = 0; $i < 8; $i++ ) { |
285
|
0
|
0
|
|
|
|
|
my $val = ( $byte & $checkbits ) ? 1 : 0; |
286
|
0
|
|
|
|
|
|
push( @bits, $val ); |
287
|
0
|
|
|
|
|
|
$checkbits *= 2; |
288
|
|
|
|
|
|
|
} |
289
|
|
|
|
|
|
|
} |
290
|
0
|
|
|
|
|
|
return @bits; |
291
|
|
|
|
|
|
|
} |
292
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
sub bus_write_bits { |
294
|
0
|
|
|
0
|
0
|
|
my($self, $register, @bits) = @_; |
295
|
0
|
|
|
|
|
|
my $bitcount = @bits; |
296
|
0
|
|
|
|
|
|
my $bytecount = $bitcount / 8; |
297
|
0
|
0
|
|
|
|
|
if( $bitcount % 8 ) { croak(qq(The number of bits $bitcount cannot be ordered into bytes)); } |
|
0
|
|
|
|
|
|
|
298
|
0
|
|
|
|
|
|
my @bytes; |
299
|
0
|
|
|
|
|
|
while( $bytecount ) { |
300
|
0
|
|
|
|
|
|
my $byte = 0; |
301
|
0
|
|
|
|
|
|
for(my $i = 0; $i < 8; $i++ ) { |
302
|
0
|
|
|
|
|
|
my $bit = shift @bits; |
303
|
0
|
|
|
|
|
|
$byte += ( $bit << $i ); |
304
|
|
|
|
|
|
|
} |
305
|
0
|
|
|
|
|
|
push(@bytes, $byte); |
306
|
0
|
|
|
|
|
|
$bytecount --; |
307
|
|
|
|
|
|
|
} |
308
|
0
|
|
|
|
|
|
$self->bus_write($register, @bytes); |
309
|
|
|
|
|
|
|
} |
310
|
|
|
|
|
|
|
|
311
|
|
|
|
|
|
|
#------------------------------------------- |
312
|
|
|
|
|
|
|
# I2C interface |
313
|
|
|
|
|
|
|
#------------------------------------------- |
314
|
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
sub i2c_write { |
316
|
0
|
|
|
0
|
0
|
|
my( $self, @bytes ) = @_; |
317
|
0
|
|
|
|
|
|
my $buffer = pack('C*', @bytes, '0'); |
318
|
0
|
|
|
|
|
|
my $len = @bytes; |
319
|
0
|
|
|
|
|
|
my $result = _i2c_write($self->fno, $self->address, $buffer, $len ); |
320
|
0
|
0
|
|
|
|
|
croak qq(i2c_write failed with return value $result) if $result; |
321
|
|
|
|
|
|
|
} |
322
|
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
sub i2c_write_error { |
324
|
0
|
|
|
0
|
0
|
|
my( $self, @bytes ) = @_; |
325
|
0
|
|
|
|
|
|
my $buffer = pack('C*', @bytes, '0'); |
326
|
0
|
|
|
|
|
|
my $len = @bytes; |
327
|
0
|
|
|
|
|
|
_i2c_write($self->fno, $self->address, $buffer, $len ); |
328
|
|
|
|
|
|
|
} |
329
|
|
|
|
|
|
|
|
330
|
|
|
|
|
|
|
sub i2c_read { |
331
|
0
|
|
|
0
|
0
|
|
my($self, $numbytes) = @_; |
332
|
0
|
|
0
|
|
|
|
$numbytes ||= 1; |
333
|
0
|
|
|
|
|
|
my $buffer = '0' x ( $numbytes + 1 ); |
334
|
0
|
|
|
|
|
|
my $result = _i2c_read($self->fno, $self->address, $buffer, $numbytes ); |
335
|
0
|
0
|
|
|
|
|
croak qq(i2c_read failed with return value $result) if $result; |
336
|
0
|
0
|
|
|
|
|
my $template = ( $numbytes > 1 ) ? 'C' . $numbytes : 'C'; |
337
|
0
|
|
|
|
|
|
my @vals = unpack($template, $buffer ); |
338
|
0
|
|
|
|
|
|
return @vals; |
339
|
|
|
|
|
|
|
} |
340
|
|
|
|
|
|
|
|
341
|
|
|
|
|
|
|
sub i2c_read_register { |
342
|
0
|
|
|
0
|
0
|
|
my($self, $register, $numbytes) = @_; |
343
|
0
|
|
0
|
|
|
|
$numbytes ||= 1; |
344
|
0
|
|
|
|
|
|
my $rbuffer = '0' x ( $numbytes + 1 ); |
345
|
0
|
|
|
|
|
|
my $wbuffer = pack('C', $register); |
346
|
0
|
|
|
|
|
|
my $result = _i2c_read_register($self->fno, $self->address, $wbuffer, $rbuffer, $numbytes ); |
347
|
0
|
0
|
|
|
|
|
croak qq(i2c_read_register failed with return value $result) if $result; |
348
|
0
|
0
|
|
|
|
|
my $template = ( $numbytes > 1 ) ? 'C' . $numbytes : 'C'; |
349
|
0
|
|
|
|
|
|
my @vals = unpack($template, $rbuffer ); |
350
|
0
|
|
|
|
|
|
return @vals; |
351
|
|
|
|
|
|
|
} |
352
|
|
|
|
|
|
|
|
353
|
|
|
|
|
|
|
#------------------------------------------- |
354
|
|
|
|
|
|
|
# SMBus interface |
355
|
|
|
|
|
|
|
#------------------------------------------- |
356
|
|
|
|
|
|
|
|
357
|
|
|
|
|
|
|
sub smbus_write { |
358
|
0
|
|
|
0
|
0
|
|
my ($self, @bytes) = @_; |
359
|
0
|
0
|
|
|
|
|
if( @bytes == 1) { |
|
|
0
|
|
|
|
|
|
360
|
0
|
|
|
|
|
|
$self->smbus_write_byte($bytes[0]); |
361
|
|
|
|
|
|
|
} elsif( @bytes == 2) { |
362
|
0
|
|
|
|
|
|
$self->smbus_write_byte_data( @bytes ); |
363
|
|
|
|
|
|
|
} else { |
364
|
0
|
|
|
|
|
|
my $command = shift @bytes; |
365
|
0
|
|
|
|
|
|
$self->smbus_write_i2c_block_data($command, \@bytes ); |
366
|
|
|
|
|
|
|
} |
367
|
|
|
|
|
|
|
} |
368
|
|
|
|
|
|
|
|
369
|
|
|
|
|
|
|
sub smbus_write_error { |
370
|
0
|
|
|
0
|
0
|
|
my ($self, @bytes) = @_; |
371
|
|
|
|
|
|
|
# we allow errors - so catch auto generated error |
372
|
|
|
|
|
|
|
try { |
373
|
0
|
0
|
|
0
|
|
|
if( @bytes == 1) { |
|
|
0
|
|
|
|
|
|
374
|
0
|
|
|
|
|
|
$self->smbus_write_byte($bytes[0]); |
375
|
|
|
|
|
|
|
} elsif( @bytes == 2) { |
376
|
0
|
|
|
|
|
|
$self->smbus_write_byte_data( @bytes ); |
377
|
|
|
|
|
|
|
} else { |
378
|
0
|
|
|
|
|
|
my $command = shift @bytes; |
379
|
0
|
|
|
|
|
|
$self->smbus_write_i2c_block_data($command, \@bytes ); |
380
|
|
|
|
|
|
|
} |
381
|
0
|
|
|
|
|
|
}; |
382
|
|
|
|
|
|
|
} |
383
|
|
|
|
|
|
|
|
384
|
|
|
|
|
|
|
sub smbus_read { |
385
|
0
|
|
|
0
|
0
|
|
my ($self, $cmdval, $numbytes) = @_; |
386
|
0
|
0
|
0
|
|
|
|
if(!defined($cmdval)) { |
|
|
0
|
|
|
|
|
|
387
|
0
|
|
|
|
|
|
return $self->smbus_read_byte; |
388
|
|
|
|
|
|
|
} elsif(!$numbytes || $numbytes <= 1 ) { |
389
|
0
|
|
|
|
|
|
return $self->smbus_read_byte_data( $cmdval ); |
390
|
|
|
|
|
|
|
} else { |
391
|
0
|
|
|
|
|
|
return $self->smbus_read_i2c_block_data($cmdval, $numbytes ); |
392
|
|
|
|
|
|
|
} |
393
|
|
|
|
|
|
|
} |
394
|
|
|
|
|
|
|
|
395
|
|
|
|
|
|
|
sub smbus_write_quick { |
396
|
0
|
|
|
0
|
0
|
|
my($self, $command ) = @_; |
397
|
0
|
|
|
|
|
|
my $result = i2c_smbus_write_quick($self->fno, $command); |
398
|
0
|
0
|
|
|
|
|
croak qq(smbus_write_quick failed with return value $result) if $result < 0; |
399
|
0
|
|
|
|
|
|
return $result; |
400
|
|
|
|
|
|
|
} |
401
|
|
|
|
|
|
|
|
402
|
|
|
|
|
|
|
sub smbus_read_byte { |
403
|
0
|
|
|
0
|
0
|
|
my( $self ) = @_; |
404
|
0
|
|
|
|
|
|
my $result = i2c_smbus_read_byte( $self->fno ); |
405
|
0
|
0
|
|
|
|
|
croak qq(smbus_read_byte failed with return value $result) if $result < 0; |
406
|
0
|
|
|
|
|
|
return ( $result ); |
407
|
|
|
|
|
|
|
} |
408
|
|
|
|
|
|
|
|
409
|
|
|
|
|
|
|
sub smbus_write_byte { |
410
|
0
|
|
|
0
|
0
|
|
my($self, $command) = @_; |
411
|
0
|
|
|
|
|
|
my $result = i2c_smbus_write_byte($self->fno, $command); |
412
|
0
|
0
|
|
|
|
|
croak qq(smbus_write_byte failed with return value $result) if $result < 0; |
413
|
0
|
|
|
|
|
|
return $result; |
414
|
|
|
|
|
|
|
} |
415
|
|
|
|
|
|
|
|
416
|
|
|
|
|
|
|
sub smbus_read_byte_data { |
417
|
0
|
|
|
0
|
0
|
|
my($self, $command) = @_; |
418
|
0
|
|
|
|
|
|
my $result = i2c_smbus_read_byte_data($self->fno, $command); |
419
|
0
|
0
|
|
|
|
|
croak qq(smbus_read_byte_data failed with return value $result) if $result < 0; |
420
|
0
|
|
|
|
|
|
return ( $result ); |
421
|
|
|
|
|
|
|
} |
422
|
|
|
|
|
|
|
|
423
|
|
|
|
|
|
|
sub smbus_write_byte_data { |
424
|
0
|
|
|
0
|
0
|
|
my($self, $command, $data) = @_; |
425
|
0
|
|
|
|
|
|
my $result = i2c_smbus_write_byte_data($self->fno, $command, $data); |
426
|
0
|
0
|
|
|
|
|
croak qq(smbus_write_byte_data failed with return value $result) if $result < 0; |
427
|
0
|
|
|
|
|
|
return $result; |
428
|
|
|
|
|
|
|
} |
429
|
|
|
|
|
|
|
|
430
|
|
|
|
|
|
|
sub smbus_read_word_data { |
431
|
0
|
|
|
0
|
0
|
|
my($self, $command) = @_; |
432
|
0
|
|
|
|
|
|
my $result = i2c_smbus_read_word_data($self->fno, $command); |
433
|
0
|
0
|
|
|
|
|
croak qq(smbus_read_word_data failed with return value $result) if $result < 0; |
434
|
0
|
|
|
|
|
|
return ( $result ); |
435
|
|
|
|
|
|
|
} |
436
|
|
|
|
|
|
|
|
437
|
|
|
|
|
|
|
sub smbus_write_word_data { |
438
|
0
|
|
|
0
|
0
|
|
my($self, $command, $data) = @_; |
439
|
0
|
|
|
|
|
|
my $result = i2c_smbus_write_word_data($self->fno, $command, $data); |
440
|
0
|
0
|
|
|
|
|
croak qq(smbus_write_word_data failed with return value $result) if $result < 0; |
441
|
0
|
|
|
|
|
|
return $result; |
442
|
|
|
|
|
|
|
} |
443
|
|
|
|
|
|
|
|
444
|
|
|
|
|
|
|
sub smbus_read_word_swapped { |
445
|
0
|
|
|
0
|
0
|
|
my($self, $command) = @_; |
446
|
0
|
|
|
|
|
|
my $result = i2c_smbus_read_word_swapped($self->fno, $command); |
447
|
0
|
0
|
|
|
|
|
croak qq(smbus_read_word_swapped failed with return value $result) if $result < 0; |
448
|
0
|
|
|
|
|
|
return ( $result ); |
449
|
|
|
|
|
|
|
} |
450
|
|
|
|
|
|
|
|
451
|
|
|
|
|
|
|
sub smbus_write_word_swapped { |
452
|
0
|
|
|
0
|
0
|
|
my($self, $command, $data) = @_; |
453
|
0
|
|
|
|
|
|
my $result = i2c_smbus_write_word_swapped($self->fno, $command, $data); |
454
|
0
|
0
|
|
|
|
|
croak qq(smbus_write_word_swapped failed with return value $result) if $result < 0; |
455
|
0
|
|
|
|
|
|
return $result; |
456
|
|
|
|
|
|
|
} |
457
|
|
|
|
|
|
|
|
458
|
|
|
|
|
|
|
sub smbus_process_call { |
459
|
0
|
|
|
0
|
0
|
|
my($self, $command, $data) = @_; |
460
|
0
|
|
|
|
|
|
my $result = i2c_smbus_process_call($self->fno, $command, $data); |
461
|
0
|
0
|
|
|
|
|
croak qq(smbus_process_call failed with return value $result) if $result < 0; |
462
|
0
|
|
|
|
|
|
return $result; |
463
|
|
|
|
|
|
|
} |
464
|
|
|
|
|
|
|
|
465
|
|
|
|
|
|
|
sub smbus_read_block_data { |
466
|
0
|
|
|
0
|
0
|
|
my($self, $command) = @_; |
467
|
0
|
|
|
|
|
|
my @result = i2c_smbus_read_block_data($self->fno, $command); |
468
|
0
|
0
|
|
|
|
|
croak qq(smbus_read_block_data failed ) unless @result; |
469
|
0
|
|
|
|
|
|
return @result; |
470
|
|
|
|
|
|
|
} |
471
|
|
|
|
|
|
|
|
472
|
|
|
|
|
|
|
sub smbus_read_i2c_block_data { |
473
|
0
|
|
|
0
|
0
|
|
my($self, $command, $numbytes) = @_; |
474
|
0
|
|
|
|
|
|
my @result = i2c_smbus_read_i2c_block_data($self->fno, $command, $numbytes); |
475
|
0
|
0
|
|
|
|
|
croak qq(smbus_read_i2c_block_data failed ) unless @result; |
476
|
0
|
|
|
|
|
|
return @result; |
477
|
|
|
|
|
|
|
} |
478
|
|
|
|
|
|
|
|
479
|
|
|
|
|
|
|
sub smbus_write_block_data { |
480
|
0
|
|
|
0
|
0
|
|
my($self, $command, $data) = @_; |
481
|
0
|
|
|
|
|
|
my $result = i2c_smbus_write_block_data($self->fno, $command, $data); |
482
|
0
|
0
|
|
|
|
|
croak qq(smbus_write_block_data failed with return value $result) if $result < 0; |
483
|
0
|
|
|
|
|
|
return $result; |
484
|
|
|
|
|
|
|
} |
485
|
|
|
|
|
|
|
|
486
|
|
|
|
|
|
|
sub smbus_write_i2c_block_data { |
487
|
0
|
|
|
0
|
0
|
|
my($self, $command, $data) = @_; |
488
|
0
|
|
|
|
|
|
my $result = i2c_smbus_write_i2c_block_data($self->fno, $command, $data); |
489
|
0
|
0
|
|
|
|
|
croak qq(smbus_write_i2c_block_data failed with return value $result) if $result < 0; |
490
|
0
|
|
|
|
|
|
return $result; |
491
|
|
|
|
|
|
|
} |
492
|
|
|
|
|
|
|
|
493
|
|
|
|
|
|
|
1; |
494
|
|
|
|
|
|
|
|
495
|
|
|
|
|
|
|
__END__ |