home *** CD-ROM | disk | FTP | other *** search
/ Inter.Net 55-2 / Inter.Net 55-2.iso / Mandrake / mdkinst / usr / bin / perl-install / pci_probing / main.pm next >
Encoding:
Perl POD Document  |  2000-01-12  |  1.1 KB  |  43 lines
  1. package pci_probing::main;
  2.  
  3. use pci_probing::pcitable;
  4. use pci_probing::pci_class;
  5.  
  6. 1;
  7.  
  8. sub get_type($) {
  9.     my ($first_num) = @_;
  10.     my ($bus) = $first_num >> 8;
  11.     $first_num &= 0xff;
  12.     my ($device) = $first_num >> 3;
  13.     my ($function) = $first_num & 0x7;
  14.  
  15.     local *F;
  16.     open F, sprintf("/proc/bus/pci/%02x/%02x.%x", $bus, $device, $function) or die '';
  17.     seek F, 10, 0 or die '';
  18.     my $a; read(F, $a, 2) or die '';
  19.     $pci_probing::pci_class::classes{unpack "S", $a} || 'unknown';
  20. }
  21.  
  22. sub probe($;$) {
  23.     my ($type, $more) = @_;
  24.     my @l;
  25.     my $f = "/proc/bus/pci/devices";
  26.     local *F;
  27.     open F, $f or die "can't open $f";
  28.     foreach (<F>) {
  29.     my ($a, $b) = /(\S+)\s+(\S+)/ or next;
  30.     my $t = $type ? get_type(hex $a) : '.';
  31.     !$type || $t =~ /$type/i or next;
  32.         if (my $i = $pci_probing::pcitable::ids{hex $b}) {
  33.         push @l, $type eq '.' ? [ $t, @$i ] : $more ? [ $_, @$i ] : $i;
  34.     } elsif ($type eq '.') {
  35.         $b =~ /(.{4})(.{4})/;
  36.         push @l, [ "unknown", $t eq "unknown" ? $t : "Vendor=0x$1 Device=0x$2", "unknown" ];
  37.     }
  38.     }
  39.     @l;
  40. }
  41.  
  42. sub list { map { "$_->[1] ($_->[0] $_->[2])" } probe('.'); }
  43.