1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
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;
|
