| 20 | 
           rodolico | 
           1 | 
           #!/usr/bin/env perl
  | 
        
        
            | 
            | 
           2 | 
           use warnings;
  | 
        
        
           | 26 | 
           rodolico | 
           3 | 
           use strict;  
  | 
        
        
           | 2 | 
           rodolico | 
           4 | 
              | 
        
        
           | 37 | 
           rodolico | 
           5 | 
           # Description: Gets PCI information on Unix systems if lspci installed
  | 
        
        
           | 20 | 
           rodolico | 
           6 | 
              | 
        
        
           | 37 | 
           rodolico | 
           7 | 
           our $VERSION = '1.2';
  | 
        
        
            | 
            | 
           8 | 
              | 
        
        
           | 20 | 
           rodolico | 
           9 | 
           # pci information for sysinfo client
  | 
        
        
            | 
            | 
           10 | 
           # Author: R. W. Rodolico
  | 
        
        
            | 
            | 
           11 | 
           # Date:   2016-04-08
  | 
        
        
            | 
            | 
           12 | 
              | 
        
        
           | 2 | 
           rodolico | 
           13 | 
           # 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
  | 
        
        
           | 20 | 
           rodolico | 
           15 | 
           # into the hash (as done in v2), then print the hash. Unneccessarily wasteful of memory
  | 
        
        
           | 2 | 
           rodolico | 
           16 | 
              | 
        
        
            | 
            | 
           17 | 
           BEGIN {
  | 
        
        
            | 
            | 
           18 | 
              push @INC, shift;
  | 
        
        
            | 
            | 
           19 | 
           }
  | 
        
        
            | 
            | 
           20 | 
              | 
        
        
            | 
            | 
           21 | 
           use library;
  | 
        
        
            | 
            | 
           22 | 
              | 
        
        
            | 
            | 
           23 | 
           my $command = &validCommandOnSystem('lspci');
  | 
        
        
            | 
            | 
           24 | 
           exit 1 unless $command;
  | 
        
        
            | 
            | 
           25 | 
              | 
        
        
            | 
            | 
           26 | 
              | 
        
        
            | 
            | 
           27 | 
           my $CATEGORY = 'pci';
  | 
        
        
            | 
            | 
           28 | 
              | 
        
        
            | 
            | 
           29 | 
           my $pciInfo =  qx(lspci -Dvmm);
  | 
        
        
            | 
            | 
           30 | 
              | 
        
        
            | 
            | 
           31 | 
           # this is a regular expression to "find" the slot number, if one exists
  | 
        
        
            | 
            | 
           32 | 
           # Different versions of lspci use different keys for the name and the slot
  | 
        
        
            | 
            | 
           33 | 
           # in some cases, the key Device: is used for both the device name and the slot (Debian Etch lspci version 2.2.4-pre4)
  | 
        
        
            | 
            | 
           34 | 
           # so I have to use this kludge. I may rewrite it to just search the sys directory tree later.
  | 
        
        
            | 
            | 
           35 | 
           my $SLOT_REGEX = '^[0-9a-z]+[:.][0-9a-z]+';
  | 
        
        
            | 
            | 
           36 | 
           my @pciInfo = split ("\n\n", $pciInfo);
  | 
        
        
            | 
            | 
           37 | 
           my $i = 0;
  | 
        
        
           | 28 | 
           rodolico | 
           38 | 
           my %returnValue;
  | 
        
        
            | 
            | 
           39 | 
              | 
        
        
           | 2 | 
           rodolico | 
           40 | 
           while (my $test = shift (@pciInfo)) {
  | 
        
        
            | 
            | 
           41 | 
              foreach my $thisLine (sort split("\n", $test)) {
  | 
        
        
            | 
            | 
           42 | 
                 if ($thisLine =~ m/([a-z]+):\s*(\S.*)/i) {
  | 
        
        
            | 
            | 
           43 | 
                    my ($key, $value) = (lc $1,$2);
  | 
        
        
            | 
            | 
           44 | 
                    # remove any leading whitespace
  | 
        
        
            | 
            | 
           45 | 
                    $key =~ s/^\s*//g;
  | 
        
        
            | 
            | 
           46 | 
                    $value =~ s/^\s*//g;
  | 
        
        
            | 
            | 
           47 | 
                    while (defined($returnValue{$i}{$key})) { # dup key, so give it a unique value
  | 
        
        
            | 
            | 
           48 | 
                       $key .= '0'; # just add some 0's at the end
  | 
        
        
            | 
            | 
           49 | 
                    }
  | 
        
        
            | 
            | 
           50 | 
                    $returnValue{$i}{$key} = $value;
  | 
        
        
            | 
            | 
           51 | 
                 }
  | 
        
        
            | 
            | 
           52 | 
              }
  | 
        
        
            | 
            | 
           53 | 
              unless (defined $returnValue{$i}{'slot'}) { # no slot number, so see if we have one
  | 
        
        
            | 
            | 
           54 | 
                 $returnValue{$i}{'slot'} = 'Unknown';
  | 
        
        
            | 
            | 
           55 | 
                 for my $thisKey ( keys %{$returnValue{$i}} ) {
  | 
        
        
            | 
            | 
           56 | 
                       if ($returnValue{$i}{$thisKey} =~ m/$SLOT_REGEX/i) {
  | 
        
        
            | 
            | 
           57 | 
                       $returnValue{$i}{'slot'} = $returnValue{$i}{$thisKey}; # this puts it in two places, so remove the original
  | 
        
        
            | 
            | 
           58 | 
                       delete $returnValue{$i}{$thisKey};
  | 
        
        
            | 
            | 
           59 | 
                       last;
  | 
        
        
            | 
            | 
           60 | 
                       }
  | 
        
        
            | 
            | 
           61 | 
                    }
  | 
        
        
            | 
            | 
           62 | 
              }
  | 
        
        
            | 
            | 
           63 | 
              | 
        
        
            | 
            | 
           64 | 
              if (defined ($returnValue{$i}{'name'})) { # we need to not have this; it messes up the xml package
  | 
        
        
            | 
            | 
           65 | 
                 $returnValue{$i}{'device name'} = $returnValue{$i}{'name'};
  | 
        
        
            | 
            | 
           66 | 
                 delete $returnValue{$i}{'name'}
  | 
        
        
            | 
            | 
           67 | 
              }
  | 
        
        
            | 
            | 
           68 | 
              unless (defined ($returnValue{$i}{'name'})) { # no name, so see if we have one
  | 
        
        
            | 
            | 
           69 | 
                 $returnValue{$i}{'name'} = 'Unknown';
  | 
        
        
            | 
            | 
           70 | 
                 foreach my $thisKey ( 'slot', 'device', 'device0', 'sdevice', 'class', 'vendor', 'svendor' ) {
  | 
        
        
            | 
            | 
           71 | 
                    if (defined($returnValue{$i}{$thisKey}) && ($returnValue{$i} ne 'Unknown') ) {
  | 
        
        
            | 
            | 
           72 | 
                       $returnValue{$i}{'name'} = $returnValue{$i}{$thisKey};
  | 
        
        
            | 
            | 
           73 | 
                       last;
  | 
        
        
            | 
            | 
           74 | 
                    }
  | 
        
        
            | 
            | 
           75 | 
                 }
  | 
        
        
            | 
            | 
           76 | 
              }
  | 
        
        
            | 
            | 
           77 | 
              $i++;
  | 
        
        
            | 
            | 
           78 | 
           }
  | 
        
        
            | 
            | 
           79 | 
              | 
        
        
            | 
            | 
           80 | 
           foreach my $key ( keys %returnValue ) {
  | 
        
        
            | 
            | 
           81 | 
              my $name = $returnValue{$key}{'name'};
  | 
        
        
            | 
            | 
           82 | 
              my $temp = $returnValue{$key};
  | 
        
        
            | 
            | 
           83 | 
              foreach my $info ( keys %$temp ) {
  | 
        
        
            | 
            | 
           84 | 
                 print "$CATEGORY\t$name\t$info\t" . $$temp{$info} . "\n" unless $info eq 'name';
  | 
        
        
            | 
            | 
           85 | 
              }
  | 
        
        
            | 
            | 
           86 | 
           }
  |