File Coverage

blib/lib/FusionInventory/Agent/Tools/Generic.pm
Criterion Covered Total %
statement 102 110 92.7
branch 57 78 73.0
condition 18 27 66.6
subroutine 16 17 94.1
pod 7 7 100.0
total 200 239 83.6


line stmt bran cond sub pod time code
1             package FusionInventory::Agent::Tools::Generic;
2              
3 32     32   4524103 use strict;
  32         34  
  32         751  
4 32     32   128 use warnings;
  32         38  
  32         740  
5 32     32   99 use base 'Exporter';
  32         91  
  32         2331  
6              
7 32     32   749 use English qw(-no_match_vars);
  32         3074  
  32         176  
8 32     32   11579 use Memoize;
  32         5340  
  32         1230  
9              
10 32     32   1337 use FusionInventory::Agent::Tools;
  32         45  
  32         54975  
11              
12             our @EXPORT = qw(
13             getDmidecodeInfos
14             getCpusFromDmidecode
15             getHdparmInfo
16             getPCIDevices
17             getPCIDeviceVendor
18             getPCIDeviceClass
19             getUSBDeviceVendor
20             getUSBDeviceClass
21             getEDIDVendor
22             );
23              
24             my $PCIVendors;
25             my $PCIClasses;
26             my $USBVendors;
27             my $USBClasses;
28             my $EDIDVendors;
29              
30             memoize('getDmidecodeInfos');
31             memoize('getPCIDevices');
32              
33             sub getDmidecodeInfos {
34             my (%params) = (
35             command => 'dmidecode',
36             @_
37             );
38              
39             my $handle = getFileHandle(%params);
40             return unless $handle;
41             my ($info, $block, $type);
42              
43             while (my $line = <$handle>) {
44             chomp $line;
45              
46             if ($line =~ /DMI type (\d+)/) {
47             # start of block
48              
49             # push previous block in list
50             if ($block) {
51             push(@{$info->{$type}}, $block);
52             undef $block;
53             }
54              
55             # switch type
56             $type = $1;
57              
58             next;
59             }
60              
61             next unless defined $type;
62              
63             next unless $line =~ /^\s+ ([^:]+) : \s (.*\S)/x;
64              
65             next if
66             $2 eq 'N/A' ||
67             $2 eq 'Not Specified' ||
68             $2 eq 'Not Present' ||
69             $2 eq 'Unknown' ||
70             $2 eq '' ||
71             $2 eq '' ||
72             $2 eq '' ;
73              
74             $block->{$1} = trimWhitespace($2);
75             }
76             close $handle;
77              
78             # do not return anything if dmidecode output is obviously truncated
79             return if keys %$info < 2;
80              
81             return $info;
82             }
83              
84             sub getCpusFromDmidecode {
85 32     32 1 74084 my $infos = getDmidecodeInfos(@_);
86              
87 32 100       466 return unless $infos->{4};
88              
89 26         26 my @cpus;
90 26         23 foreach my $info (@{$infos->{4}}) {
  26         64  
91 185 100 100     825 next if $info->{Status} && $info->{Status} =~ /Unpopulated|Disabled/i;
92              
93             my $manufacturer = $info->{'Manufacturer'} ||
94 39   66     86 $info->{'Processor Manufacturer'};
95             my $version = $info->{'Version'} ||
96 39   66     73 $info->{'Processor Version'};
97              
98             # VMware
99             next if
100 39 50 66     140 ($manufacturer && $manufacturer eq '000000000000') &&
      33        
      66        
101             ($version && $version eq '00000000000000000000000000000000');
102              
103             my $cpu = {
104             SERIAL => $info->{'Serial Number'},
105             ID => $info->{ID},
106             CORE => $info->{'Core Count'} || $info->{'Core Enabled'},
107             THREAD => $info->{'Thread Count'},
108 32   66     172 FAMILYNAME => $info->{'Family'},
109             MANUFACTURER => $manufacturer
110             };
111             $cpu->{NAME} =
112             ($cpu->{MANUFACTURER} =~ /Intel/ ? $info->{'Family'} : undef) ||
113             $info->{'Version'} ||
114             $info->{'Processor Family'} ||
115 32   66     154 $info->{'Processor Version'};
116              
117 32 100       48 if ($cpu->{ID}) {
118              
119             # Split CPUID to get access to its content
120 30         167 my @id = split ("",$cpu->{ID});
121             # convert hexadecimal value
122 30         70 $cpu->{STEPPING} = hex $id[1];
123             # family number is composed of 3 hexadecimal number
124 30         49 $cpu->{FAMILYNUMBER} = hex $id[9] . $id[10] . $id[4];
125 30         71 $cpu->{MODEL} = hex $id[7] . $id[0];
126             }
127              
128 32 100       52 if ($info->{Version}) {
129 21 50       108 if ($info->{Version} =~ /([\d\.]+)MHz$/) {
    100          
130 0         0 $cpu->{SPEED} = $1;
131             } elsif ($info->{Version} =~ /([\d\.]+)GHz$/) {
132 15         62 $cpu->{SPEED} = $1 * 1000;
133             }
134             }
135              
136 32 100 66     80 if (!$cpu->{SPEED} && $info->{'Current Speed'}) {
137 15 50       50 if ($info->{'Current Speed'} =~ /^\s*(\d{3,4})\s*Mhz/i) {
    0          
138 15         31 $cpu->{SPEED} = $1;
139             } elsif ($info->{'Current Speed'} =~ /^\s*(\d+)\s*Ghz/i) {
140 0         0 $cpu->{SPEED} = $1 * 1000;
141             }
142             }
143              
144 32 100       52 if ($info->{'External Clock'}) {
145 25 50       65 if ($info->{'External Clock'} =~ /^\s*(\d+)\s*Mhz/i) {
    0          
146 25         39 $cpu->{EXTERNAL_CLOCK} = $1;
147             } elsif ($info->{'External Clock'} =~ /^\s*(\d+)\s*Ghz/i) {
148 0         0 $cpu->{EXTERNAL_CLOCK} = $1 * 1000;
149             }
150             }
151              
152 32         54 push @cpus, $cpu;
153             }
154              
155 26         71 return @cpus;
156             }
157              
158             sub getHdparmInfo {
159 1     1 1 10438 my (%params) = @_;
160              
161             my $handle = getFileHandle(
162             %params,
163 1 50       6 command => $params{device} ? "hdparm -I $params{device}" : undef,
164             );
165 1 50       4 return unless $handle;
166              
167 1         2 my $info;
168 1         20 while (my $line = <$handle>) {
169 90 100       103 $info->{model} = $1 if $line =~ /Model Number:\s+(\S.+\S)/;
170 90 100       102 $info->{firmware} = $1 if $line =~ /Firmware Revision:\s+(\S+)/;
171 90 100       97 $info->{serial} = $1 if $line =~ /Serial Number:\s+(\S*)/;
172 90 100       101 $info->{size} = $1 if $line =~ /1000:\s+(\d*)\sMBytes/;
173 90 100       112 $info->{transport} = $1 if $line =~ /Transport:.+(SCSI|SATA|USB)/;
174 90 100       173 $info->{wwn} = $1 if $line =~ /WWN Device Identifier:\s+(\S+)/;
175             }
176 1         7 close $handle;
177              
178 1         5 return $info;
179             }
180              
181             sub getPCIDevices {
182             my (%params) = (
183             command => 'lspci -v -nn',
184             @_
185             );
186             my $handle = getFileHandle(%params);
187              
188             my (@controllers, $controller);
189              
190             while (my $line = <$handle>) {
191             chomp $line;
192              
193             if ($line =~ /^
194             (\S+) \s # slot
195             ([^[]+) \s # name
196             \[([a-f\d]+)\]: \s # class
197             (\S.+) \s # manufacturer
198             \[([a-f\d]+:[a-f\d]+)\] # id
199             (?:\s \(rev \s (\d+)\))? # optional version
200             /x) {
201              
202             $controller = {
203             PCISLOT => $1,
204             NAME => $2,
205             PCICLASS => $3,
206             MANUFACTURER => $4,
207             PCIID => $5,
208             REV => $6
209             };
210             next;
211             }
212              
213             next unless defined $controller;
214              
215             if ($line =~ /^$/) {
216             push(@controllers, $controller);
217             undef $controller;
218             } elsif ($line =~ /^\tKernel driver in use: (\w+)/) {
219             $controller->{DRIVER} = $1;
220             } elsif ($line =~ /^\tSubsystem: ([a-f\d]{4}:[a-f\d]{4})/) {
221             $controller->{PCISUBSYSTEMID} = $1;
222             }
223             }
224              
225             close $handle;
226              
227             return @controllers;
228             }
229              
230             sub getPCIDeviceVendor {
231 24     24 1 321 my (%params) = @_;
232              
233 24 100       40 _loadPCIDatabase(%params) if !$PCIVendors;
234              
235 24 50       28 return unless $params{id};
236 24         48 return $PCIVendors->{$params{id}};
237             }
238              
239             sub getPCIDeviceClass {
240 24     24 1 34 my (%params) = @_;
241              
242 24 50       30 _loadPCIDatabase(%params) if !$PCIClasses;
243              
244 24 50       26 return unless $params{id};
245 24         45 return $PCIClasses->{$params{id}};
246             }
247              
248             sub getUSBDeviceVendor {
249 6     6 1 15 my (%params) = @_;
250              
251 6 100       14 _loadUSBDatabase(%params) if !$USBVendors;
252              
253 6 50       11 return unless $params{id};
254 6         15 return $USBVendors->{$params{id}};
255             }
256              
257             sub getUSBDeviceClass {
258 0     0 1 0 my (%params) = @_;
259              
260 0 0       0 _loadUSBDatabase(%params) if !$USBClasses;
261              
262 0 0       0 return unless $params{id};
263 0         0 return $USBClasses->{$params{id}};
264             }
265              
266             sub getEDIDVendor {
267 63     63 1 1222 my (%params) = @_;
268              
269 63 100       119 _loadEDIDDatabase(%params) if !$EDIDVendors;
270              
271 63 50       94 return unless $params{id};
272 63         363 return $EDIDVendors->{$params{id}};
273             }
274              
275             sub _loadPCIDatabase {
276 1     1   2 my (%params) = @_;
277              
278 1         4 ($PCIVendors, $PCIClasses) = _loadDatabase(
279             file => "$params{datadir}/pci.ids"
280             );
281             }
282              
283             sub _loadUSBDatabase {
284 1     1   2 my (%params) = @_;
285              
286 1         4 ($USBVendors, $USBClasses) = _loadDatabase(
287             file => "$params{datadir}/usb.ids"
288             );
289             }
290              
291             sub _loadDatabase {
292 2     2   6 my $handle = getFileHandle(@_);
293 2 50       8 return unless $handle;
294              
295 2         3 my ($vendors, $classes);
296 0         0 my ($vendor_id, $device_id, $class_id);
297 2         24 while (my $line = <$handle>) {
298              
299 46043 100       87937 if ($line =~ /^\t (\S{4}) \s+ (.*)/x) {
    100          
    100          
    100          
    100          
300             # Device ID
301 27336         20939 $device_id = $1;
302 27336         76749 $vendors->{$vendor_id}->{devices}->{$device_id}->{name} = $2;
303             } elsif ($line =~ /^\t\t (\S{4}) \s+ (\S{4}) \s+ (.*)/x) {
304             # Subdevice ID
305 11354         12798 my $subdevice_id = "$1:$2";
306 11354         35727 $vendors->{$vendor_id}->{devices}->{$device_id}->{subdevices}->{$subdevice_id}->{name} = $3;
307             } elsif ($line =~ /^(\S{4}) \s+ (.*)/x) {
308             # Vendor ID
309 5005         3903 $vendor_id = $1;
310 5005         15084 $vendors->{$vendor_id}->{name} = $2;
311             } elsif ($line =~ /^C \s+ (\S{2}) \s+ (.*)/x) {
312             # Class ID
313 40         35 $class_id = $1;
314 40         115 $classes->{$class_id}->{name} = $2;
315             } elsif ($line =~ /^\t (\S{2}) \s+ (.*)/x) {
316             # SubClass ID
317 240         185 my $subclass_id = $1;
318 240         579 $classes->{$class_id}->{subclasses}->{$subclass_id}->{name} = $2;
319             }
320             }
321 2         33 close $handle;
322              
323 2         20 return ($vendors, $classes);
324             }
325              
326              
327             sub _loadEDIDDatabase {
328 2     2   4 my (%params) = @_;
329              
330 2         8 my $handle = getFileHandle(file => "$params{datadir}/edid.ids");
331 2 50       7 return unless $handle;
332              
333 2         1239 foreach my $line (<$handle>) {
334 4376 100       7845 next unless $line =~ /^([A-Z]{3}) __ (.*)$/;
335 4344         8089 $EDIDVendors->{$1} = $2;
336             }
337              
338 2         171 return;
339             }
340              
341             1;
342             __END__