tools/parse_companies.pl

   1 #!/usr/bin/perl
   2
   3 # parse companies from
   4 # https://www.bluetooth.com/specifications/assigned-numbers/company-identifiers
   5
   6 use strict;
   7 # use URI::Encode qw(uri_decode);
   8
   9 my %known_entities = (
  10     'nbsp' => ' ',
  11     'aacute' => 'á',
  12     'eacute' => 'é',
  13     'iacute' => 'í',
  14     'oacute' => 'ó',
  15     'uacute' => 'ú',
  16     'auml' => 'ä',
  17     'uuml' => 'ü',
  18     'Uuml' => 'Ü',
  19 );
  20
  21 # better to use URI::Encode if you have it
  22 sub uri_decode {
  23     my $name = $_[0];
  24     foreach my $entity (keys %known_entities) {
  25         my $to = $known_entities{$entity};
  26         $name =~ s/&$entity;/$to/g;
  27     }
  28     foreach my $entity (map { lc $_ } $name =~ /&([^;]+);/g) {
  29         if ($entity ne 'amp') {
  30             die "\nparse_companies.pl: Unable to convert &$entity; giving up\n";
  31         }
  32     }
  33     $name =~ s/&amp;/&/ig;
  34     $name =~ s/&nbsp;/ /ig;
  35     return $name;
  36 }
  37
  38 # never parse HTML with regex!
  39 # except when you should
  40
  41 my $identifier;
  42 my $next_is_name = 0;
  43
  44 while (<>) {
  45     s/\xe2\x80\x8b//g; # kill zero width space
  46
  47     # grab identifier (in hex)
  48     if (/\<td.*(0x[0-9A-F]{4})/i) {
  49         $identifier = $1;
  50         $next_is_name = 1;
  51
  52     # next <td> should be company name
  53     } elsif ($next_is_name && m|\<td.*\>(.*)\<|) {
  54         my $name = uri_decode($1);
  55         $name =~ s/^\s+//g; # kill leading
  56         $name =~ s/\s+$//g; # and trailing space
  57         $name =~ s/"/\\"/g; # escape double quotes
  58         my $id = hex($identifier);
  59         if ($id != 65535) {
  60             print "\tcase $id:\n";
  61             print "\t\treturn \"$name\";\n";
  62         }
  63         $next_is_name = 0;
  64     }
  65 }