dejavu-fonts/scripts/status.pl

   1 #!/usr/bin/perl -w
   2
   3 # $Id$
   4
   5 # status.txt file generator
   6 # (c)2004 Stepan Roh (PUBLIC DOMAIN)
   7 # usage: ./status.pl version_tag status_file sfd_files+
   8 #   will print new status file on standard output
   9
  10 sub parse_status_file(\%$);
  11 sub parse_sfd_file(\%$$);
  12 sub print_status_file(\%);
  13 sub parse_versions($);
  14 sub format_versions(\%);
  15 sub normalize_version($);
  16 sub denormalize_version($);
  17 sub detect_full_typefaces_support(@);
  18
  19 # internal parsed format:
  20 # _ => ( header lines* )
  21 # hexadecimal character encoding => ( 'name' => name, 'versions' => ( version => ( typefaces* ) ) )
  22
  23 $debug = 0;
  24
  25 $name_width = 20;
  26
  27 if ($debug) {
  28   use Data::Dumper;
  29
  30   $Data::Dumper::Indent = 1;
  31   $Data::Dumper::Sortkeys = 1;
  32   $Data::Dumper::Purity = 1;
  33 }
  34
  35 %parsed_typefaces = ();
  36
  37 sub normalize_version($) {
  38   my ($version) = @_;
  39
  40   if ($version eq 'original') {
  41     $version = '0.0';
  42   }
  43   return join ('_', map { sprintf ("%02s", $_) } split (/\./, $version));
  44 }
  45
  46 sub denormalize_version($) {
  47   my ($version) = @_;
  48
  49   $version = join ('.', map { $_ + 0 } split (/_/, $version));
  50   if ($version eq '0.0') {
  51     $version = 'original';
  52   }
  53   return $version;
  54 }
  55
  56 sub parse_versions($) {
  57   my ($versions) = @_;
  58
  59   my %ret = ();
  60   while ($versions =~ s,^\s*(\S+)\s*(?:\((.*?)\)|),,) {
  61     my ($version, $typefaces) = ($1, $2);
  62     $version = normalize_version($version);
  63     if ($typefaces) {
  64       my @typefaces = split (/\s*,\s*/, $typefaces);
  65       $ret{$version} = \@typefaces;
  66     } else {
  67       $ret{$version} = [];
  68     }
  69   }
  70   return %ret;
  71 }
  72
  73 sub parse_status_file(\%$) {
  74   my ($parsed_ref, $status_file) = @_;
  75
  76   open (STATUS, $status_file) || die "Unable to open $status_file : $!\n";
  77   while (<STATUS>) {
  78     if (/^U+/) {
  79       my ($hex_enc, $name, $versions) = ($_ =~ /^U\+(\S+)\s+(\S+)\s+(.*?)\s*$/);
  80       my %versions = parse_versions ($versions);
  81       $$parsed_ref{$hex_enc}{'name'} = $name;
  82       $$parsed_ref{$hex_enc}{'versions'} = \%versions;
  83     } else {
  84       push (@{$$parsed_ref{'_'}}, $_);
  85     }
  86   }
  87   close (STATUS);
  88 }
  89
  90 sub parse_sfd_file(\%$$) {
  91   my ($parsed_ref, $version_tag, $sfd_file) = @_;
  92
  93   open (SFD, $sfd_file) || die "Unable to open $sfd_file : $!\n";
  94   my $typeface = '';
  95   my $curchar = '';
  96   my $hex_enc = '';
  97   my $empty = 0;
  98   $version_tag = normalize_version($version_tag);
  99   while (<SFD>) {
 100     if (/^FullName:\s+\S+\s+(.*?)\s*$/) {
 101       # DejaVu is not included in typeface
 102       $typeface = $1;
 103       $parsed_typefaces{$typeface} = 1;
 104     } elsif (/^StartChar:\s*(\S+)\s*$/) {
 105       $curchar = $1;
 106       $hex_enc = '';
 107       $empty = 0;
 108     } elsif (/^Colour:/) {
 109       # XXX this is quick'n'dirty hack to detect non-empty glyphs
 110       $empty = 1;
 111     } elsif (/^Encoding:\s*\d+\s*(\d+)\s*\d+\s*$/) {
 112       $hex_enc = sprintf ('%04x', $1);
 113     } elsif ($hex_enc && !$empty && /^EndChar\s*$/) {
 114       $$parsed_ref{$hex_enc}{'name'} = $curchar;
 115       push (@{$$parsed_ref{$hex_enc}{'versions'}{$version_tag}}, $typeface);
 116     }
 117   }
 118   close (SFD);
 119 }
 120
 121 sub detect_full_typefaces_support(@) {
 122   my %typefaces = ();
 123   foreach $typeface (@_) {
 124     $typefaces{$typeface} = 1;
 125   }
 126   foreach $typeface (keys %parsed_typefaces) {
 127     return 0 if (!exists $typefaces{$typeface});
 128   }
 129   return 1;
 130 }
 131
 132 sub format_versions(\%) {
 133   my ($versions_ref) = @_;
 134
 135   my @ret = ();
 136   my %done_typefaces = ();
 137   foreach $version (sort keys %{$versions_ref}) {
 138     my ($str) = denormalize_version ($version);
 139     my $do_last = 1;
 140     if (@{$$versions_ref{$version}}) {
 141       my @print_typefaces = ();
 142       foreach $typeface (@{$$versions_ref{$version}}) {
 143         if (!exists ($done_typefaces{$typeface})) {
 144           $done_typefaces{$typeface} = 1;
 145           push (@print_typefaces, $typeface);
 146         }
 147       }
 148       next if (!@print_typefaces);
 149       if (!detect_full_typefaces_support(@print_typefaces)) {
 150         $str .= ' (' . join (', ', sort @print_typefaces) . ')';
 151         $do_last = 0;
 152       }
 153     }
 154     push (@ret, $str);
 155     last if ($do_last);
 156   }
 157   return join (' ', @ret);
 158 }
 159
 160 sub print_status_file(\%) {
 161   my ($parsed_ref) = @_;
 162
 163   print @{$$parsed_ref{'_'}};
 164   delete $$parsed_ref{'_'};
 165   foreach $hex_enc (sort {hex($a) <=> hex($b)} keys %{$parsed_ref}) {
 166     my ($versions) = format_versions (%{$$parsed_ref{$hex_enc}{'versions'}});
 167     printf ('U+%s %-'.$name_width.'s %s'."\n", $hex_enc, $$parsed_ref{$hex_enc}{'name'}, $versions);
 168   }
 169 }
 170
 171 if (@ARGV < 3) {
 172   print STDERR "usage: version_tag status_file sfd_files+\n";
 173   exit 1;
 174 }
 175
 176 $version_tag = shift @ARGV;
 177 $status_file = shift @ARGV;
 178 @sfd_files = @ARGV;
 179
 180 %parsed = ();
 181
 182 parse_status_file (%parsed, $status_file);
 183 foreach $sfd_file (@sfd_files) {
 184   parse_sfd_file (%parsed, $version_tag, $sfd_file);
 185 }
 186
 187 if ($debug) {
 188   print STDERR Data::Dumper->Dump([\%parsed], ['*parsed']);
 189   print STDERR "Parsed typefaces: ", join (', ', @parsed_typefaces), "\n";
 190 }
 191
 192 print_status_file (%parsed);
 193
 194 1;