diff options
Diffstat (limited to 'xpp/utils/zconf/Zaptel/Hardware/PCI.pm')
-rw-r--r-- | xpp/utils/zconf/Zaptel/Hardware/PCI.pm | 105 |
1 files changed, 105 insertions, 0 deletions
diff --git a/xpp/utils/zconf/Zaptel/Hardware/PCI.pm b/xpp/utils/zconf/Zaptel/Hardware/PCI.pm new file mode 100644 index 0000000..c6731dc --- /dev/null +++ b/xpp/utils/zconf/Zaptel/Hardware/PCI.pm @@ -0,0 +1,105 @@ +package Zaptel::Hardware::PCI; +# +# Written by Oron Peled <oron@actcom.co.il> +# Copyright (C) 2007, Xorcom +# This program is free software; you can redistribute and/or +# modify it under the same terms as Perl itself. +# +# $Id$ +# +use strict; +use Zaptel::Hardware; + +my @idlist = qw( + 1397:16B8 + 1397:08B4 + 1057:5608 + 10B5:3001 + 10B5:4000 + 10B5:9030 + 10B5:D00D + D161:0800 + D161:2400 + E159:0001 + ); + +$ENV{PATH} .= ":/usr/sbin:/sbin:/usr/bin:/bin"; +my $prog = 'lspci'; + +# Accessors (miniperl does not have Class:Accessor) +our $AUTOLOAD; +sub AUTOLOAD { + my $self = shift; + my $name = uc($AUTOLOAD); + $name =~ s/.*://; # strip fully-qualified portion + if (@_) { + return $self->{$name} = shift; + } else { + return $self->{$name}; + } +} + +my @devices; + +sub pci_sorter() { + return + sprintf("%03d/%03d", $a->bus, $a->dev) cmp + sprintf("%03d/%03d", $b->bus, $b->dev); +} + +sub new($$) { + my $pack = shift or die "Wasn't called as a class method\n"; + my $self = { @_ }; + bless $self, $pack; + my $hardware_name = sprintf("pci:%s:%s:%s", $self->{DOMAIN}, $self->{BUS}, $self->{DEV}); + $self->{HARDWARE_NAME} = $hardware_name; + Zaptel::Hardware::device_detected($self, $hardware_name); + my $sysfile = sprintf "/sys/bus/pci/devices/%s:%s:%s/driver/module", $self->{DOMAIN}, $self->{BUS}, $self->{DEV}; + my $module = readlink($sysfile); + if(defined $module) { + $module =~ s:^.*/::; + $self->{DRIVER} = $module; + } + return $self; +} + +sub devices($) { + my $pack = shift or die "Wasn't called as a class method\n"; + return sort pci_sorter @devices; +} + +my $domain_support = 1; # Optimistic... + +sub scan_devices($) { + my $pack = shift || die; + if(!open(F, "$prog -Dn 2> /dev/null |")) { + $domain_support = 0; + open(F, "$prog -n|") || die "$0: Failed running $prog: $!"; + } + while(<F>) { + chomp; + my ($phys,$id) = (split(/\s+/))[0,2]; + my $domain; + my $bus; + my $dev; + if($domain_support) { + ($domain,$bus,$dev) = split(/:/, $phys); + } else { + ($bus,$dev) = split(/:/, $phys); + $domain = '0000'; + } + next unless grep { uc($id) eq $_ } @idlist; + my($vendor,$product) = split(/:/, $id); + my $d = Zaptel::Hardware::PCI->new( + DOMAIN => $domain, + BUS => $bus, + DEV => $dev, + VENDOR => $vendor, + PRODUCT => $product, + ); + push(@devices, $d); + } + close F; +} + +1; |