File Coverage

blib/lib/DDCCI.pm

Criterion	Covered	Total	%
statement	29	62	46.7
branch	5	20	25.0
condition	3	3	100.0
subroutine	9	16	56.2
pod	10	10	100.0
total	56	111	50.4

package DDCCI;

use strict;
use warnings;
use XSLoader;
use Exporter 5.57 'import';
use Carp;

our $VERSION = '0.003';
our %EXPORT_TAGS = ( 'all' => [ qw() ] );
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
our @EXPORT = qw(
	&list_vcp_names
	&get_vcp_name
	&get_vcp_addr
	&decode_edid
	&scan_devices
);

XSLoader::load('DDCCI', $VERSION);

sub list_vcp_names {

	my $ret = [];

	for my $i (0x00 .. 0xff) {
		my $n = _get_vcp_name($i);
		push @{$ret}, $n if ($n ne '???');
	}

	return $ret;
}

sub get_vcp_name {

	my ($vcp) = @_;

	return _get_vcp_name($vcp);
}

sub get_vcp_addr {

	my ($name) = @_;

	return _get_vcp_addr($name);
}

sub decode_edid {

	my ($edid) = @_;
	return undef if (!defined $edid || (length($edid) != 128));

	my @b = (
		unpack('@8C', $edid),
		unpack('@9C', $edid),
		unpack('@10S<', $edid),
		unpack('@12L', $edid),
		unpack('@20C', $edid)
	);
	return {
		id => sprintf(
			'%c%c%c%04X',
    		(($b[0] >> 2) & 0x1f) - 1 + ord('A'),
		    (($b[0] & 0x03) << 3) + ($b[1] >> 5) - 1 + ord('A'),
		    ($b[1] & 0x1f) - 1 + ord('A'),
		    $b[2]
		),
		sn => sprintf('%lu', $b[3]),
		type => ($b[4] & 0x80) ? 'digital' : 'analog',
	};
}

sub scan_devices {

	my $ret = [];

	opendir(my $dh, '/dev') || croak "cannot open /dev";
	my @devs = reverse grep { /^i2c-\d+$/ && (-c '/dev/' . $_) } readdir $dh;
	closedir $dh;

	for my $i (0 .. scalar @devs - 1) {
		my $fn = '/dev/' . $devs[$i];
		(my $fd = _open_dev($fn)) || next;
		my $edid = _read_edid($fd);
		my $de = decode_edid($edid);
		if (defined $de) {
			push @{$ret}, {
				dev => $fn,
				id => $de->{'id'},
				sn => $de->{'sn'},
				type => $de->{'type'}
			};
		}
		_close_dev($fd);
	}

	return $ret;
}

sub new {
	my ($class, $dev) = @_;
    defined($dev) || croak "usage: $class\->new(\$dev)";

	my $self = { fd => _open_dev($dev) };

	if ($self->{'fd'} < 0) {
		croak "unable to open device $dev";
		return undef;
	}

    bless $self, $class;
	return $self;
}

sub DESTROY {
	my ($self) = @_;

	_close_dev($self->{'fd'}) unless ($self->{'fd'} < 0);
}

sub read_edid {
	my ($self) = @_;

	return _read_edid($self->{'fd'});
}

sub read_caps {
	my ($self) = @_;

	return _read_caps($self->{'fd'});
}

sub read_vcp {
	my ($self, $addr) = @_;

	return _read_vcp($self->{'fd'}, $addr);
}

sub write_vcp {
	my ($self, $addr, $value) = @_;

	return _write_vcp($self->{'fd'}, $addr, $value);
}

1;

__END__