| 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__ |