#!/usr/bin/perl

# monitor-edid
# Copyright (C) 2005-2010 Mandriva
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.

use Getopt::Long;

my %opt = ('acpi-dir' => "/proc/acpi/video");
my @common_options = ('verbose', 'try-in-console', 'no-vbe', 'acpi-dir=s', 'vbe-port=i', 'max-vbe-port=i');
my $common_options_usage = '[-v] [--acpi-dir <dir>] [--try-in-console] [--vbe-port <0-3>] [--max-vbe-port <0-3>]';

if ($0 =~ /monitor-get-edid/) {
    GetOptions_(@common_options) or die "usage: monitor-get-edid $common_options_usage\n";

    if (my @edids = get_edids(1)) {
	print $edids[0][1];
	exit 0;
    } else {
	exit 1;
    }
} else {
    GetOptions_(@common_options, 'first', 'MonitorsDB', 'perl')
      or die "usage: monitor-edid $common_options_usage [--first] [--perl] [--MonitorsDB]\n";

    my $err = 1;

    if (my @edids = get_edids($opt{first})) {
	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 %seen;
    my @l = map { 
	my $s = slurp($_); 
	(is_edid_possibly_valid($s) && !$seen{ $_[1] }++) ? [ $_ => $s ] : ();
    } get_edid_files();

    # Don't try to run monitor-get-edid-using-vbe when booted in UEFI mode.
    # It may overwrite a memory region being used by the UEFI BIOS (mga#28124)
    return @l if -e '/sys/firmware/efi';

    if (!@l || !$b_get_first && $< == 0) {
	if (my $cmd = get_using_vbe()) {
	    my $min_port = $opt{'vbe-port'} || 0;
	    my $max_port = $opt{'max-vbe-port'} || $opt{'vbe-port'} || 2;
	    my $skip_vbe;
	    foreach my $port ($min_port .. $max_port) {
		warn "probing EDID using VBE (port $port)\n" if $opt{verbose};
		my $edid = `$cmd --port $port $skip_vbe`;
		my $status = $? >> 8;
		if ($status == 1) {
		    warn "VBE info call failed, skipping all ports\n" if $opt{verbose};
		    last;
		}
		# skip VBE check for other ports if it was OK
		$skip_vbe = "--skip-vbe-check" if $status == 0 || $status == 2;

		is_edid_possibly_valid($edid) or next;
		next if grep { $_->[1] eq $edid } @l;
		push @l, [ "vbe$port" => $edid ];
		last if $b_get_first;
	    }
	}
    }
    @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'});
    my @l3 = grep {
	(my $state_f = $_) =~ s/edid$/enabled/;
	slurp($state_f) =~ /enabled/;
    } glob("/sys/class/drm/card*-*/edid");
    (@l1, @l2, @l3);
}

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 is_edid_possibly_valid {
    my ($edid) = @_;
    length($edid) >= 128;
}

sub slurp { 
    my ($f) = @_; 
    open(my $F, '<', $f) or return;
    local $/;
    scalar <$F>;
}