line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package DDCCI; |
2
|
|
|
|
|
|
|
|
3
|
7
|
|
|
7
|
|
467739
|
use strict; |
|
7
|
|
|
|
|
63
|
|
|
7
|
|
|
|
|
231
|
|
4
|
7
|
|
|
7
|
|
36
|
use warnings; |
|
7
|
|
|
|
|
16
|
|
|
7
|
|
|
|
|
166
|
|
5
|
7
|
|
|
7
|
|
33
|
use XSLoader; |
|
7
|
|
|
|
|
12
|
|
|
7
|
|
|
|
|
222
|
|
6
|
7
|
|
|
7
|
|
36
|
use Exporter 5.57 'import'; |
|
7
|
|
|
|
|
161
|
|
|
7
|
|
|
|
|
263
|
|
7
|
7
|
|
|
7
|
|
41
|
use Carp; |
|
7
|
|
|
|
|
13
|
|
|
7
|
|
|
|
|
6749
|
|
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
our $VERSION = '0.003'; |
10
|
|
|
|
|
|
|
our %EXPORT_TAGS = ( 'all' => [ qw() ] ); |
11
|
|
|
|
|
|
|
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); |
12
|
|
|
|
|
|
|
our @EXPORT = qw( |
13
|
|
|
|
|
|
|
&list_vcp_names |
14
|
|
|
|
|
|
|
&get_vcp_name |
15
|
|
|
|
|
|
|
&get_vcp_addr |
16
|
|
|
|
|
|
|
&decode_edid |
17
|
|
|
|
|
|
|
&scan_devices |
18
|
|
|
|
|
|
|
); |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
XSLoader::load('DDCCI', $VERSION); |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
sub list_vcp_names { |
23
|
|
|
|
|
|
|
|
24
|
1
|
|
|
1
|
1
|
2
|
my $ret = []; |
25
|
|
|
|
|
|
|
|
26
|
1
|
|
|
|
|
4
|
for my $i (0x00 .. 0xff) { |
27
|
256
|
|
|
|
|
440
|
my $n = _get_vcp_name($i); |
28
|
256
|
100
|
|
|
|
433
|
push @{$ret}, $n if ($n ne '???'); |
|
76
|
|
|
|
|
132
|
|
29
|
|
|
|
|
|
|
} |
30
|
|
|
|
|
|
|
|
31
|
1
|
|
|
|
|
4
|
return $ret; |
32
|
|
|
|
|
|
|
} |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
sub get_vcp_name { |
35
|
|
|
|
|
|
|
|
36
|
258
|
|
|
258
|
1
|
575
|
my ($vcp) = @_; |
37
|
|
|
|
|
|
|
|
38
|
258
|
|
|
|
|
437
|
return _get_vcp_name($vcp); |
39
|
|
|
|
|
|
|
} |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
sub get_vcp_addr { |
42
|
|
|
|
|
|
|
|
43
|
5
|
|
|
5
|
1
|
561
|
my ($name) = @_; |
44
|
|
|
|
|
|
|
|
45
|
5
|
|
|
|
|
63
|
return _get_vcp_addr($name); |
46
|
|
|
|
|
|
|
} |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
sub decode_edid { |
49
|
|
|
|
|
|
|
|
50
|
3
|
|
|
3
|
1
|
830
|
my ($edid) = @_; |
51
|
3
|
100
|
100
|
|
|
31
|
return undef if (!defined $edid || (length($edid) != 128)); |
52
|
|
|
|
|
|
|
|
53
|
1
|
|
|
|
|
11
|
my @b = ( |
54
|
|
|
|
|
|
|
unpack('@8C', $edid), |
55
|
|
|
|
|
|
|
unpack('@9C', $edid), |
56
|
|
|
|
|
|
|
unpack('@10S<', $edid), |
57
|
|
|
|
|
|
|
unpack('@12L', $edid), |
58
|
|
|
|
|
|
|
unpack('@20C', $edid) |
59
|
|
|
|
|
|
|
); |
60
|
|
|
|
|
|
|
return { |
61
|
1
|
50
|
|
|
|
15
|
id => sprintf( |
62
|
|
|
|
|
|
|
'%c%c%c%04X', |
63
|
|
|
|
|
|
|
(($b[0] >> 2) & 0x1f) - 1 + ord('A'), |
64
|
|
|
|
|
|
|
(($b[0] & 0x03) << 3) + ($b[1] >> 5) - 1 + ord('A'), |
65
|
|
|
|
|
|
|
($b[1] & 0x1f) - 1 + ord('A'), |
66
|
|
|
|
|
|
|
$b[2] |
67
|
|
|
|
|
|
|
), |
68
|
|
|
|
|
|
|
sn => sprintf('%lu', $b[3]), |
69
|
|
|
|
|
|
|
type => ($b[4] & 0x80) ? 'digital' : 'analog', |
70
|
|
|
|
|
|
|
}; |
71
|
|
|
|
|
|
|
} |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
sub scan_devices { |
74
|
|
|
|
|
|
|
|
75
|
0
|
|
|
0
|
1
|
|
my $ret = []; |
76
|
|
|
|
|
|
|
|
77
|
0
|
0
|
|
|
|
|
opendir(my $dh, '/dev') || croak "cannot open /dev"; |
78
|
0
|
0
|
|
|
|
|
my @devs = reverse grep { /^i2c-\d+$/ && (-c '/dev/' . $_) } readdir $dh; |
|
0
|
|
|
|
|
|
|
79
|
0
|
|
|
|
|
|
closedir $dh; |
80
|
|
|
|
|
|
|
|
81
|
0
|
|
|
|
|
|
for my $i (0 .. scalar @devs - 1) { |
82
|
0
|
|
|
|
|
|
my $fn = '/dev/' . $devs[$i]; |
83
|
0
|
0
|
|
|
|
|
(my $fd = _open_dev($fn)) || next; |
84
|
0
|
|
|
|
|
|
my $edid = _read_edid($fd); |
85
|
0
|
|
|
|
|
|
my $de = decode_edid($edid); |
86
|
0
|
0
|
|
|
|
|
if (defined $de) { |
87
|
0
|
|
|
|
|
|
push @{$ret}, { |
88
|
|
|
|
|
|
|
dev => $fn, |
89
|
|
|
|
|
|
|
id => $de->{'id'}, |
90
|
|
|
|
|
|
|
sn => $de->{'sn'}, |
91
|
0
|
|
|
|
|
|
type => $de->{'type'} |
92
|
|
|
|
|
|
|
}; |
93
|
|
|
|
|
|
|
} |
94
|
0
|
|
|
|
|
|
_close_dev($fd); |
95
|
|
|
|
|
|
|
} |
96
|
|
|
|
|
|
|
|
97
|
0
|
|
|
|
|
|
return $ret; |
98
|
|
|
|
|
|
|
} |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
sub new { |
101
|
0
|
|
|
0
|
1
|
|
my ($class, $dev) = @_; |
102
|
0
|
0
|
|
|
|
|
defined($dev) || croak "usage: $class\->new(\$dev)"; |
103
|
|
|
|
|
|
|
|
104
|
0
|
|
|
|
|
|
my $self = { fd => _open_dev($dev) }; |
105
|
|
|
|
|
|
|
|
106
|
0
|
0
|
|
|
|
|
if ($self->{'fd'} < 0) { |
107
|
0
|
|
|
|
|
|
croak "unable to open device $dev"; |
108
|
0
|
|
|
|
|
|
return undef; |
109
|
|
|
|
|
|
|
} |
110
|
|
|
|
|
|
|
|
111
|
0
|
|
|
|
|
|
bless $self, $class; |
112
|
0
|
|
|
|
|
|
return $self; |
113
|
|
|
|
|
|
|
} |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
sub DESTROY { |
116
|
0
|
|
|
0
|
|
|
my ($self) = @_; |
117
|
|
|
|
|
|
|
|
118
|
0
|
0
|
|
|
|
|
_close_dev($self->{'fd'}) unless ($self->{'fd'} < 0); |
119
|
|
|
|
|
|
|
} |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
sub read_edid { |
122
|
0
|
|
|
0
|
1
|
|
my ($self) = @_; |
123
|
|
|
|
|
|
|
|
124
|
0
|
|
|
|
|
|
return _read_edid($self->{'fd'}); |
125
|
|
|
|
|
|
|
} |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
sub read_caps { |
128
|
0
|
|
|
0
|
1
|
|
my ($self) = @_; |
129
|
|
|
|
|
|
|
|
130
|
0
|
|
|
|
|
|
return _read_caps($self->{'fd'}); |
131
|
|
|
|
|
|
|
} |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
sub read_vcp { |
134
|
0
|
|
|
0
|
1
|
|
my ($self, $addr) = @_; |
135
|
|
|
|
|
|
|
|
136
|
0
|
|
|
|
|
|
return _read_vcp($self->{'fd'}, $addr); |
137
|
|
|
|
|
|
|
} |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
sub write_vcp { |
140
|
0
|
|
|
0
|
1
|
|
my ($self, $addr, $value) = @_; |
141
|
|
|
|
|
|
|
|
142
|
0
|
|
|
|
|
|
return _write_vcp($self->{'fd'}, $addr, $value); |
143
|
|
|
|
|
|
|
} |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
1; |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
__END__ |