| Line 1... |
Line 1... |
| 1 |
#!/usr/bin/env perl
|
1 |
#!/usr/bin/env perl
|
| 2 |
use warnings;
|
2 |
use warnings;
|
| 3 |
use strict;
|
3 |
use strict;
|
| 4 |
|
4 |
|
| 5 |
# Description: Gets PCI information on Unix systems if lspci installed
|
- |
|
| 6 |
|
- |
|
| 7 |
our $VERSION = '1.2';
|
5 |
use version ; our $VERSION = '1.2';
|
| 8 |
|
6 |
|
| 9 |
# pci information for sysinfo client
|
7 |
# pci information for sysinfo client
|
| 10 |
# Author: R. W. Rodolico
|
8 |
# Author: R. W. Rodolico
|
| 11 |
# Date: 2016-04-08
|
9 |
# Date: 2016-04-08
|
| 12 |
|
10 |
|
| 13 |
# gets information on pci information assuming lspci is installed
|
11 |
# gets information on pci information assuming lspci is installed
|
| 14 |
# I really don't remember how I wrote this originally, so I just put everything
|
12 |
# I really don't remember how I wrote this originally, so I just put everything
|
| 15 |
# into the hash (as done in v2), then print the hash. Unneccessarily wasteful of memory
|
13 |
# into the hash (as done in v2), then print the hash. Unneccessarily wasteful of memory
|
| - |
|
14 |
#
|
| - |
|
15 |
# Revision History
|
| 16 |
|
16 |
|
| 17 |
# find our location and use it for searching for libraries
|
17 |
# find our location and use it for searching for libraries. library.pm must be in the same directory as the calling script
|
| - |
|
18 |
# or, if run interactively, in the parent of the modules
|
| 18 |
BEGIN {
|
19 |
BEGIN {
|
| 19 |
use FindBin;
|
20 |
use FindBin;
|
| 20 |
use File::Spec;
|
21 |
use File::Spec;
|
| 21 |
use lib File::Spec->catdir($FindBin::Bin);
|
22 |
# prepend the bin directory and its parent
|
| 22 |
eval( 'use library;' ); die "Could not find library.pm in the code directory\n" if $@;
|
23 |
use lib File::Spec->catdir($FindBin::Bin), File::Spec->catdir("$FindBin::Bin/..");
|
| 23 |
eval( 'use Data::Dumper;' );
|
24 |
eval( 'use library;' );
|
| - |
|
25 |
die sprintf( "Could not find library.pm in %s, INC is %s\n", __FILE__, join( "\n", @INC ) ) if $@;
|
| 24 |
}
|
26 |
}
|
| 25 |
|
27 |
|
| - |
|
28 |
#####
|
| 26 |
# check for valid OS.
|
29 |
##### Change these to match your needs
|
| - |
|
30 |
#####
|
| - |
|
31 |
|
| - |
|
32 |
# Make this a list of all the modules we are going to use. You can replace undef with the version you need, if you like
|
| - |
|
33 |
my $modulesList = {
|
| 27 |
exit 1 unless &checkOS( { 'linux' => undef } );
|
34 |
'Data::Dumper' => undef,
|
| - |
|
35 |
};
|
| 28 |
|
36 |
|
| 29 |
# check for required commands, return 2 if they don't exist. Enter an full list of all commands required. If one doesn't exist
|
37 |
# hash of commands that are needed for the system. key is the name of the command and, in some cases, the value will become
|
| 30 |
# script returns a 2
|
38 |
# the full path (from which or where)
|
| 31 |
foreach my $command ( 'lspci' ) {
|
39 |
my $commandsList = {
|
| 32 |
exit 2 unless &validCommandOnSystem( $command );
|
40 |
'lspci' => undef,
|
| - |
|
41 |
};
|
| 33 |
}
|
42 |
|
| - |
|
43 |
# list of operating systems this module can be used on.
|
| - |
|
44 |
my $osList = {
|
| - |
|
45 |
# 'mswin32' => undef,
|
| - |
|
46 |
# 'freebsd' => undef,
|
| - |
|
47 |
'linux' => undef,
|
| - |
|
48 |
};
|
| 34 |
|
49 |
|
| - |
|
50 |
# the category the return data should go into. See sysinfo for a list
|
| 35 |
my $CATEGORY = 'pci';
|
51 |
my $CATEGORY = 'pci';
|
| 36 |
|
52 |
|
| - |
|
53 |
#####
|
| - |
|
54 |
##### End of required
|
| - |
|
55 |
#####
|
| - |
|
56 |
|
| - |
|
57 |
# some variables needed for our system
|
| - |
|
58 |
my $errorPrepend = 'error: in ' . __FILE__; # this is prepended to any error messages
|
| - |
|
59 |
my @out; # temporary location for each line of output
|
| - |
|
60 |
|
| - |
|
61 |
# Try to load the modules we need. If we can not, then make a list of missing modules for error message.
|
| - |
|
62 |
for my $module ( keys %$modulesList ) {
|
| 37 |
my $pciInfo = qx(lspci -Dvmm);
|
63 |
eval ( "use $module;" );
|
| - |
|
64 |
push @out, "$errorPrepend Could not load $module" if $@;
|
| - |
|
65 |
}
|
| 38 |
|
66 |
|
| - |
|
67 |
if ( ! @out && ! checkOS ( $osList ) ) { # check if we are on an acceptible operating system
|
| - |
|
68 |
push @out, "$errorPrepend Invalid Operating System";
|
| - |
|
69 |
}
|
| - |
|
70 |
if ( !@out && ! validCommandOnSystem ( $commandsList ) ) {
|
| - |
|
71 |
push @out, "$errorPrepend Can not find some commands needed";
|
| - |
|
72 |
}
|
| - |
|
73 |
if ( !@out ) { # we made it, we have everything, so do the processing
|
| - |
|
74 |
#####
|
| - |
|
75 |
##### Your code starts here. Remember to push all output onto @out
|
| - |
|
76 |
#####
|
| - |
|
77 |
|
| - |
|
78 |
my $pciInfo = qx(lspci -Dvmm);
|
| - |
|
79 |
|
| 39 |
# this is a regular expression to "find" the slot number, if one exists
|
80 |
# this is a regular expression to "find" the slot number, if one exists
|
| 40 |
# Different versions of lspci use different keys for the name and the slot
|
81 |
# Different versions of lspci use different keys for the name and the slot
|
| 41 |
# in some cases, the key Device: is used for both the device name and the slot (Debian Etch lspci version 2.2.4-pre4)
|
82 |
# in some cases, the key Device: is used for both the device name and the slot (Debian Etch lspci version 2.2.4-pre4)
|
| 42 |
# so I have to use this kludge. I may rewrite it to just search the sys directory tree later.
|
83 |
# so I have to use this kludge. I may rewrite it to just search the sys directory tree later.
|
| 43 |
my $SLOT_REGEX = '^[0-9a-z]+[:.][0-9a-z]+';
|
84 |
my $SLOT_REGEX = '^[0-9a-z]+[:.][0-9a-z]+';
|
| 44 |
my @pciInfo = split ("\n\n", $pciInfo);
|
85 |
my @pciInfo = split ("\n\n", $pciInfo);
|
| 45 |
my $i = 0;
|
86 |
my $i = 0;
|
| 46 |
my %returnValue;
|
87 |
my %returnValue;
|
| 47 |
|
88 |
|
| 48 |
while (my $test = shift (@pciInfo)) {
|
89 |
while (my $test = shift (@pciInfo)) {
|
| 49 |
foreach my $thisLine (sort split("\n", $test)) {
|
90 |
foreach my $thisLine (sort split("\n", $test)) {
|
| 50 |
if ($thisLine =~ m/([a-z]+):\s*(\S.*)/i) {
|
91 |
if ($thisLine =~ m/([a-z]+):\s*(\S.*)/i) {
|
| 51 |
my ($key, $value) = (lc $1,$2);
|
92 |
my ($key, $value) = (lc $1,$2);
|
| 52 |
# remove any leading whitespace
|
93 |
# remove any leading whitespace
|
| 53 |
$key =~ s/^\s*//g;
|
94 |
$key =~ s/^\s*//g;
|
| 54 |
$value =~ s/^\s*//g;
|
95 |
$value =~ s/^\s*//g;
|
| 55 |
while (defined($returnValue{$i}{$key})) { # dup key, so give it a unique value
|
96 |
while (defined($returnValue{$i}{$key})) { # dup key, so give it a unique value
|
| 56 |
$key .= '0'; # just add some 0's at the end
|
97 |
$key .= '0'; # just add some 0's at the end
|
| - |
|
98 |
}
|
| - |
|
99 |
$returnValue{$i}{$key} = $value;
|
| 57 |
}
|
100 |
}
|
| 58 |
$returnValue{$i}{$key} = $value;
|
- |
|
| 59 |
}
|
101 |
}
|
| 60 |
}
|
- |
|
| 61 |
unless (defined $returnValue{$i}{'slot'}) { # no slot number, so see if we have one
|
102 |
unless (defined $returnValue{$i}{'slot'}) { # no slot number, so see if we have one
|
| 62 |
$returnValue{$i}{'slot'} = 'Unknown';
|
103 |
$returnValue{$i}{'slot'} = 'Unknown';
|
| 63 |
for my $thisKey ( keys %{$returnValue{$i}} ) {
|
104 |
for my $thisKey ( keys %{$returnValue{$i}} ) {
|
| 64 |
if ($returnValue{$i}{$thisKey} =~ m/$SLOT_REGEX/i) {
|
105 |
if ($returnValue{$i}{$thisKey} =~ m/$SLOT_REGEX/i) {
|
| 65 |
$returnValue{$i}{'slot'} = $returnValue{$i}{$thisKey}; # this puts it in two places, so remove the original
|
106 |
$returnValue{$i}{'slot'} = $returnValue{$i}{$thisKey}; # this puts it in two places, so remove the original
|
| 66 |
delete $returnValue{$i}{$thisKey};
|
107 |
delete $returnValue{$i}{$thisKey};
|
| - |
|
108 |
last;
|
| - |
|
109 |
}
|
| - |
|
110 |
}
|
| - |
|
111 |
}
|
| - |
|
112 |
|
| - |
|
113 |
if (defined ($returnValue{$i}{'name'})) { # we need to not have this; it messes up the xml package
|
| - |
|
114 |
$returnValue{$i}{'device name'} = $returnValue{$i}{'name'};
|
| - |
|
115 |
delete $returnValue{$i}{'name'}
|
| - |
|
116 |
}
|
| - |
|
117 |
unless (defined ($returnValue{$i}{'name'})) { # no name, so see if we have one
|
| - |
|
118 |
$returnValue{$i}{'name'} = 'Unknown';
|
| - |
|
119 |
foreach my $thisKey ( 'slot', 'device', 'device0', 'sdevice', 'class', 'vendor', 'svendor' ) {
|
| - |
|
120 |
if (defined($returnValue{$i}{$thisKey}) && ($returnValue{$i} ne 'Unknown') ) {
|
| - |
|
121 |
$returnValue{$i}{'name'} = $returnValue{$i}{$thisKey};
|
| 67 |
last;
|
122 |
last;
|
| 68 |
}
|
123 |
}
|
| 69 |
}
|
- |
|
| 70 |
}
|
- |
|
| 71 |
|
- |
|
| 72 |
if (defined ($returnValue{$i}{'name'})) { # we need to not have this; it messes up the xml package
|
- |
|
| 73 |
$returnValue{$i}{'device name'} = $returnValue{$i}{'name'};
|
- |
|
| 74 |
delete $returnValue{$i}{'name'}
|
- |
|
| 75 |
}
|
- |
|
| 76 |
unless (defined ($returnValue{$i}{'name'})) { # no name, so see if we have one
|
- |
|
| 77 |
$returnValue{$i}{'name'} = 'Unknown';
|
- |
|
| 78 |
foreach my $thisKey ( 'slot', 'device', 'device0', 'sdevice', 'class', 'vendor', 'svendor' ) {
|
- |
|
| 79 |
if (defined($returnValue{$i}{$thisKey}) && ($returnValue{$i} ne 'Unknown') ) {
|
- |
|
| 80 |
$returnValue{$i}{'name'} = $returnValue{$i}{$thisKey};
|
- |
|
| 81 |
last;
|
- |
|
| 82 |
}
|
124 |
}
|
| 83 |
}
|
125 |
}
|
| - |
|
126 |
$i++;
|
| 84 |
}
|
127 |
}
|
| 85 |
$i++;
|
- |
|
| 86 |
}
|
- |
|
| 87 |
|
128 |
|
| 88 |
foreach my $key ( keys %returnValue ) {
|
129 |
foreach my $key ( keys %returnValue ) {
|
| 89 |
my $name = $returnValue{$key}{'name'};
|
130 |
my $name = $returnValue{$key}{'name'};
|
| 90 |
my $temp = $returnValue{$key};
|
131 |
my $temp = $returnValue{$key};
|
| 91 |
foreach my $info ( keys %$temp ) {
|
132 |
foreach my $info ( keys %$temp ) {
|
| 92 |
print "$CATEGORY\t$name\t$info\t" . $$temp{$info} . "\n" unless $info eq 'name';
|
133 |
push @out, "$CATEGORY\t$name\t$info\t" . $$temp{$info} unless $info eq 'name';
|
| - |
|
134 |
}
|
| 93 |
}
|
135 |
}
|
| - |
|
136 |
#####
|
| - |
|
137 |
##### Your code ends here.
|
| - |
|
138 |
#####
|
| 94 |
}
|
139 |
}
|
| - |
|
140 |
|
| - |
|
141 |
# If we are testing from the command line (caller is undef), print the results for debugging
|
| - |
|
142 |
print join( "\n", @out ) . "\n" unless caller;
|
| - |
|
143 |
# called by do, which has a value of the last assignment made, so make the assignment. The equivilent of a return
|
| - |
|
144 |
my $return = join( "\n", @out );
|
| - |
|
145 |
|