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 38     38   6443645 use strict;
  38         72  
  38         1074  
4 38     38   214 use warnings;
  38         80  
  38         1231  
5 38     38   199 use base 'Exporter';
  38         176  
  38         3990  
6              
7 38     38   1010 use English qw(-no_match_vars);
  38         4329  
  38         348  
8 38     38   25048 use Memoize;
  38         14141  
  38         1672  
9              
10 38     38   3389 use FusionInventory::Agent::Tools;
  38         81  
  38         95752  
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 34     34 1 106388 my $infos = getDmidecodeInfos(@_);
86              
87 34 100       785 return unless $infos->{4};
88              
89 28         53 my @cpus;
90 28         49 foreach my $info (@{$infos->{4}}) {
  28         110  
91 187 100 100     1463 next if $info->{Status} && $info->{Status} =~ /Unpopulated|Disabled/i;
92              
93             my $manufacturer = $info->{'Manufacturer'} ||
94 41   66     147 $info->{'Processor Manufacturer'};
95             my $version = $info->{'Version'} ||
96 41   66     157 $info->{'Processor Version'};
97              
98             # VMware
99             next if
100 41 50 66     244 ($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 34   66     317 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 34   66     407 $info->{'Processor Version'};
116              
117 34 100       105 if ($cpu->{ID}) {
118              
119             # Split CPUID to get access to its content
120 32         246 my @id = split ("",$cpu->{ID});
121             # convert hexadecimal value
122 32         119 $cpu->{STEPPING} = hex $id[1];
123             # family number is composed of 3 hexadecimal number
124 32         85 $cpu->{FAMILYNUMBER} = hex $id[9] . $id[10] . $id[4];
125 32         150 $cpu->{MODEL} = hex $id[7] . $id[0];
126             }
127              
128 34 100       101 if ($info->{Version}) {
129 22 50       168 if ($info->{Version} =~ /([\d\.]+)MHz$/) {
    100          
130 0         0 $cpu->{SPEED} = $1;
131             } elsif ($info->{Version} =~ /([\d\.]+)GHz$/) {
132 16         81 $cpu->{SPEED} = $1 * 1000;
133             }
134             }
135              
136 34 100 66     153 if (!$cpu->{SPEED} && $info->{'Current Speed'}) {
137 16 50       88 if ($info->{'Current Speed'} =~ /^\s*(\d{3,4})\s*Mhz/i) {
    0          
138 16         54 $cpu->{SPEED} = $1;
139             } elsif ($info->{'Current Speed'} =~ /^\s*(\d+)\s*Ghz/i) {
140 0         0 $cpu->{SPEED} = $1 * 1000;
141             }
142             }
143              
144 34 100       96 if ($info->{'External Clock'}) {
145 27 50       124 if ($info->{'External Clock'} =~ /^\s*(\d+)\s*Mhz/i) {
    0          
146 27         75 $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 34         94 push @cpus, $cpu;
153             }
154              
155 28         127 return @cpus;
156             }
157              
158             sub getHdparmInfo {
159 1     1 1 20707 my (%params) = @_;
160              
161             my $handle = getFileHandle(
162             %params,
163 1 50       9 command => $params{device} ? "hdparm -I $params{device}" : undef,
164             );
165 1 50       8 return unless $handle;
166              
167 1         3 my $info;
168 1         35 while (my $line = <$handle>) {
169 90 100       191 $info->{model} = $1 if $line =~ /Model Number:\s+(\S.+\S)/;
170 90 100       203 $info->{firmware} = $1 if $line =~ /Firmware Revision:\s+(\S+)/;
171 90 100       189 $info->{serial} = $1 if $line =~ /Serial Number:\s+(\S*)/;
172 90 100       196 $info->{size} = $1 if $line =~ /1000:\s+(\d*)\sMBytes/;
173 90 100       187 $info->{transport} = $1 if $line =~ /Transport:.+(SCSI|SATA|USB)/;
174 90 100       351 $info->{wwn} = $1 if $line =~ /WWN Device Identifier:\s+(\S+)/;
175             }
176 1         43 close $handle;
177              
178 1         6 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 72 my (%params) = @_;
232              
233 24 100       56 _loadPCIDatabase(%params) if !$PCIVendors;
234              
235 24 50       57 return unless $params{id};
236 24         82 return $PCIVendors->{$params{id}};
237             }
238              
239             sub getPCIDeviceClass {
240 24     24 1 70 my (%params) = @_;
241              
242 24 50       50 _loadPCIDatabase(%params) if !$PCIClasses;
243              
244 24 50       44 return unless $params{id};
245 24         84 return $PCIClasses->{$params{id}};
246             }
247              
248             sub getUSBDeviceVendor {
249 18     18 1 94 my (%params) = @_;
250              
251 18 100       56 _loadUSBDatabase(%params) if !$USBVendors;
252              
253 18 50       52 return unless $params{id};
254 18         92 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 2572 my (%params) = @_;
268              
269 63 100       153 _loadEDIDDatabase(%params) if !$EDIDVendors;
270              
271 63 50       165 return unless $params{id};
272 63         501 return $EDIDVendors->{$params{id}};
273             }
274              
275             sub _loadPCIDatabase {
276 1     1   4 my (%params) = @_;
277              
278 1         5 ($PCIVendors, $PCIClasses) = _loadDatabase(
279             file => "$params{datadir}/pci.ids"
280             );
281             }
282              
283             sub _loadUSBDatabase {
284 2     2   8 my (%params) = @_;
285              
286 2         12 ($USBVendors, $USBClasses) = _loadDatabase(
287             file => "$params{datadir}/usb.ids"
288             );
289             }
290              
291             sub _loadDatabase {
292 3     3   18 my $handle = getFileHandle(@_);
293 3 50       15 return unless $handle;
294              
295 3         6 my ($vendors, $classes);
296 0         0 my ($vendor_id, $device_id, $class_id);
297 3         91 while (my $line = <$handle>) {
298              
299 65276 100       226866 if ($line =~ /^\t (\S{4}) \s+ (.*)/x) {
    100          
    100          
    100          
    100          
300             # Device ID
301 41924         62571 $device_id = $1;
302 41924         220533 $vendors->{$vendor_id}->{devices}->{$device_id}->{name} = $2;
303             } elsif ($line =~ /^\t\t (\S{4}) \s+ (\S{4}) \s+ (.*)/x) {
304             # Subdevice ID
305 11355         22645 my $subdevice_id = "$1:$2";
306 11355         61883 $vendors->{$vendor_id}->{devices}->{$device_id}->{subdevices}->{$subdevice_id}->{name} = $3;
307             } elsif ($line =~ /^(\S{4}) \s+ (.*)/x) {
308             # Vendor ID
309 7930         11776 $vendor_id = $1;
310 7930         40056 $vendors->{$vendor_id}->{name} = $2;
311             } elsif ($line =~ /^C \s+ (\S{2}) \s+ (.*)/x) {
312             # Class ID
313 59         102 $class_id = $1;
314 59         283 $classes->{$class_id}->{name} = $2;
315             } elsif ($line =~ /^\t (\S{2}) \s+ (.*)/x) {
316             # SubClass ID
317 373         576 my $subclass_id = $1;
318 373         1673 $classes->{$class_id}->{subclasses}->{$subclass_id}->{name} = $2;
319             }
320             }
321 3         149 close $handle;
322              
323 3         73 return ($vendors, $classes);
324             }
325              
326              
327             sub _loadEDIDDatabase {
328 2     2   8 my (%params) = @_;
329              
330 2         15 my $handle = getFileHandle(file => "$params{datadir}/edid.ids");
331 2 50       10 return unless $handle;
332              
333 2         2192 foreach my $line (<$handle>) {
334 4376 100       13912 next unless $line =~ /^([A-Z]{3}) __ (.*)$/;
335 4344         14610 $EDIDVendors->{$1} = $2;
336             }
337              
338 2         397 return;
339             }
340              
341             1;
342             __END__