#!/usr/bin/perl

# (c) 1999 Software in the Public Interest
# Initial script written by Randolph Chung <tausq@debian.org>
# SBUS support written by Eric Delaunay <delaunay@lix.polytechnique.fr>

use strict vars;

my $pcidevice = '/proc/bus/pci/devices';
my $oldpcidev = '/proc/pci';
my $videoidfile = '/usr/share/xviddetect/video.ids';
my $pciidfile = '/usr/share/xviddetect/pci.ids';

my %videoids;
my %pciids;
my @devices;
my $arch;

sub GetArch {
  my $arch = `uname -m`;
  chomp($arch);
  
  $arch = 'i386' if ($arch =~ /^i\d86/);
  return $arch;
}

sub ReadVideoIDs {
  my ($driver, $arch, $devid, $company, $desc);
  open (F, "<$videoidfile") || die "open $videoidfile: $!";
  while (<F>) {
    chomp;
    next if (/^\s*#/);
    next if (/^\s*$/);
    s/\s*#.*//; # remove comments
    ($driver, $arch, $devid, $company, $desc) = split(/\|/, $_, 5);
    $videoids{$devid}{$arch}{driver} = $driver;
    $videoids{$devid}{$arch}{company} = $company;
    $videoids{$devid}{$arch}{description} = $desc;
  }    
  close F;
}

sub ReadPCIIDs {
  my ($vendid, $company, $devid);
  open (F, "<$pciidfile") || die "open $pciidfile: $!";
  while (<F>) {
    chomp;
    if (/^([0-9a-f]{4})\s+(.*)/) {
      $vendid = $1; $company = $2;
    } elsif (/^\s+([0-9a-f]{4})\s+(.*)/) {
      $devid = $1;
      $pciids{"$vendid$devid"}{company} = $company;
      $pciids{"$vendid$devid"}{description} = $2;
    }
  }
  close F;
}

sub ReadPCI {
  my $vend;
  
  open (F, "<$pcidevice") || goto oldpci;
  while (<F>) {
    /^[0-9a-f]{4}\s+([0-9a-f]{8})/i;
    $vend = $1;
    push @devices, $vend;        
  }
  close F;
  return;
  
oldpci:
  return if ($arch eq "sparc"); # try SBUS detection  
  print "Cannot open $pcidevice. You probably have an old kernel. Support\n";
  print "for the old Linux PCI interface should be coming soon\n\n";
  exit 0;

# TO FIX:
  print "Cannot open $pcidevice, attempting to use old PCI interface\n";
  print "Because of the way the old PCI interface works, the results\n";
  print "are more likely to be incorrect\n\n";
  
  open(F, "<$oldpcidev") || die "Cannot open PCI device file: $!; does your computer have PCI?";
  while (<F>) {
    if (/VGA.*: (.*)/) {
      my $devname = $1;
      print "Guessing device ID for $devname... ";
      my $id;
      
      foreach $id (keys(%pciids)) {
#        print "\ttrying to match $pciids{$id}{description}...\n";
        if ($devname =~ /\Q$pciids{$id}{description}\E/) {
	  print "$id\n";
          push @devices, $id;
	}
      }
      print "\n";
    }
  }
  close F;
}

# Read the SPARC SBus configuration to fill the device list with detected
# display devices.
sub SBUSlookup {
  my $dir=shift;
  my $dev;
  # Process through all subdirs to find entries with device_type=display.
  # Reports such entries in @devices.
  # Note: to know whether a dir entry is a device subdir, we cannot use -d $_.
  # It simply doesn't work with openpromfs :(  One alternative is to looking
  # for an '@' in the name (device@x,y)
  if (opendir(D, $dir)) {
    my @contents = grep { s:(.*@):$dir/\1: } readdir(D);
    closedir D;
    foreach $dev (@contents) {
      # Each device subdir may contains 2 files named device_type & name. The
      # former is telling the type of device (eg. 'display' for a graphic card)
      # and the latter gives his name ('cgthree', ...).
      if (open(G, "<$dev/device_type")) {
	my $id = <G>;
	chop $id;
	close G;
	# a display device is refered as such in the device_type file
	if ($id eq "'display'") {
	  if (open(G, "<$dev/name")) {
	    # get the name of the device (remove surrounding quotes)
	    $id = <G>;
	    chop $id;
	    $id =~ s/'//g; #'
	    # register this device in the database
	    push @devices, $id;
	  }
	}
      }
      &SBUSlookup($dev);
    }
  }
}

sub ReadSBUS {
  my $dir;
  my $dev;
  # first check for openpromfs
  -f "/proc/openprom/.node" || die "This system is lacking openpromfs support.";
  # then parse the tree to looking at display type entries
  SBUSlookup("/proc/openprom");
}

sub Help {
  print <<EOF;
xviddetect [--quiet] [--arch <architecture>] [--help]
xviddetect [-q] [-a <architecture>] [-h]
  -h, --help  : shows this help message
  -q, --quiet : only prints the final result
  -a, --arch  : forces a particular architecture
EOF
  exit 0;
}

# main
my ($help, $forcearch, $quiet) = undef;

foreach (@ARGV) {
  if (($_ eq "-q") || ($_ eq "--quiet")) {
    $quiet = 1;
  } elsif (($_ eq "-a") || ($_ eq "--arch")) {
    $arch = shift(@ARGV);
  } else {
    &Help;
  }
}

$arch = $forcearch || &GetArch;
&ReadVideoIDs;
&ReadPCIIDs;
&ReadPCI;
&ReadSBUS if ($arch eq "sparc");

#if (!$quiet) {
#  print "Your architecture seems to be $arch.\n";
#  print "You can override this by using the --arch option\n" if (!$forcearch);
#  print "\n";
#}

my $device;
foreach $device (@devices) {
  if ($videoids{$device}{$arch}{driver}) {
    if (!$quiet) {
      print "The XFree86 server for $videoids{$device}{$arch}{company} $videoids{$device}{$arch}{description} is $videoids{$device}{$arch}{driver} ($arch specific)\n";
    } else {
      print "$videoids{$device}{$arch}{driver}\n";
    }
    exit;
  } elsif ($videoids{$device}{all}{driver}) {
    if (!$quiet) {
      print "The XFree86 server for $videoids{$device}{all}{company} $videoids{$device}{all}{description} is\n\t $videoids{$device}{all}{driver}\n";
    } else {
      print "$videoids{$device}{all}{driver}\n";
    }
    exit;
  }
}

# if we get here, we can't figure it out
if ($quiet) {
  print "unknown\n";
  exit 1;
}
# else
print <<EOF;
Sorry, I wasn't able to determine a driver for your video card. This script
only detects PCI and some SBUS devices. If you know, or figure out, which X 
driver to use, please submit a *wishlist* bug against this package with the 
appropriate info. Please see http://bugs.debian.org/ for information about
submitting bugs.

I will now display a list of PCI devices I found on your computer. Please
send the line associated with your video device if you do find a driver.

EOF
foreach $device (@devices) {
  if ($pciids{$device}{description}) {
    print "$device|$arch|$pciids{$device}{company}|$pciids{$device}{description}\n";
  } else {
    print "$device|$arch|unknown manufacturer|unknown model\n";
  }
}
