#!/usr/bin/perl
use Getopt::Long;
my %opt = ('acpi-dir' => "/proc/acpi/video");
my @common_options = ('verbose', 'try-in-console', 'no-vbe', 'acpi-dir=s');
if ($0 =~ /monitor-get-edid/) {
GetOptions_(@common_options) or die "usage: monitor-get-edid [-v] [--acpi-dir
] [--try-in-console]\n";
if (my @edids = get_edids(1)) {
print $edids[0][1];
exit 0;
} else {
exit 1;
}
} else {
GetOptions_(@common_options, 'MonitorsDB', 'perl')
or die "usage: monitor-edid [-v] [--acpi-dir ] [--perl] [--MonitorsDB] [--try-in-console]\n";
my $err = 1;
if (my @edids = get_edids()) {
print "(\n" if $opt{perl};
foreach (@edids) {
my ($f, $edid) = @$_;
warn "parsing EDID from $f\n" if $opt{verbose};
if ($f =~ m!^/!) {
system(parse_edid() . " $f");
$err = 0 if $? == 0;
} else {
open(my $F, '|' . parse_edid());
print $F $edid;
close $F and $err = 0;
}
print ",\n" if $opt{perl};
}
print ")\n" if $opt{perl};
}
exit $err;
}
sub GetOptions_ {
my (@l) = @_;
GetOptions('v' => \$opt{verbose}, map { $_ => \$opt{/([^=]*)/ && $1} } @l);
}
sub propagate_options {
my (@l) = @_;
map { $_ eq 'verbose' ? '-v' : "--$_" } grep { $opt{$_} } @l;
}
sub get_using_vbe() {
my $prog = '/usr/sbin/monitor-get-edid-using-vbe';
-x $prog && join(' ', $prog, propagate_options('verbose', 'try-in-console'));
}
sub parse_edid() {
join(' ', 'monitor-parse-edid', propagate_options('verbose', 'MonitorsDB', 'perl'));
}
sub get_edids {
my ($b_get_first) = @_;
my @l = map { my $s = slurp($_); $s ? [ $_ => $s ] : () } get_edid_files();
if (!@l || !$b_get_first && $< == 0) {
if (my $cmd = get_using_vbe()) {
warn "probind EDID using VBE\n" if $opt{verbose};
my $edid = `$cmd`;
if (grep { $_->[1] eq $edid } @l) {
# already found, forget it
} else {
push @l, [ vbe => $edid ];
}
}
}
@l;
}
sub get_edid_files() {
my @l1 = find_EDID("/proc/device-tree");
my @l2 = grep {
(my $state_f = $_) =~ s/EDID$/state/;
my ($state) = slurp($state_f) =~ /state:\s*0x(\w+)/;
hex($state) & 2; # bit 1 is "Output is activated"
} find_EDID($opt{'acpi-dir'});
(@l1, @l2);
}
sub find_EDID {
my ($dir) = @_;
my @l;
require File::Find;
File::Find::find(sub { $_ eq 'EDID' and push @l, $File::Find::name }, $dir);
@l;
}
sub slurp {
my ($f) = @_;
open(my $F, '<', $f) or return;
local $/;
scalar <$F>;
}