File xpdf-cjk-config of Package xpdf

#! /usr/bin/perl -w                        # -*- mode: perl coding: utf-8 -*-
#
# Wed May  5 14:57:49 2004  Mike FABIAN  <mfabian@suse.de>
#
########################################################################

use strict;
use utf8;
use English;
use Getopt::Long;

my $OPT_VERBOSITY = 0;

sub usage {
  print "Usage: xpdf-cjk-config [option] ...\n";
  print "--verbosity i      if i >= 1, print some messages to standard output.\n";
  exit 1;
}

# Process command line options
my %opt;
unless (GetOptions(\%opt,
		   'verbosity=i',   \$OPT_VERBOSITY,
		  )) {
  &usage ();
  exit 1;
}

if (!defined $OPT_VERBOSITY) { $OPT_VERBOSITY = 1; }

my $fclist_binary = "/usr/bin/fc-list";
my $ftdump_binary = "/usr/bin/ftdump";
my $config_file   = "/etc/xpdfrc-cjk-auto";

if (!-x $fclist_binary || !-x $ftdump_binary) {
  if ($OPT_VERBOSITY >= 1) {
    print "fc-list or ftdump missing, exiting.\n";
  }
  exit 1;
}

my %fonts = ();
get_fonts(("ja", "ko", "zh-CN", "zh-TW", "zh-HK"));
my %displayNamedCIDFontTT = ();
for my $font (keys %fonts) {
  generate_config_entries($font);
}

open (CONFIG_FILE, ">$config_file") || die "can't open file $config_file: $!";
print CONFIG_FILE "# autogenerated by /usr/sbin/xpdf-cjk-config:\n";
for my $entry (sort (keys %displayNamedCIDFontTT)) {
  print CONFIG_FILE "$displayNamedCIDFontTT{$entry}\n";
}
close (CONFIG_FILE);

exit 0;

######################################################################
sub get_fonts {
  my @langs = @_;
  for my $lang (@langs) {
    if ($OPT_VERBOSITY >= 1) {
      print "listing fonts for $lang\n";
    }
    open (FONTLIST, "$fclist_binary \":lang=$lang:outline=true\" file |") || die "Can't open fc-list output: $!\n";
    binmode FONTLIST, ":bytes";
    while (<FONTLIST>) {
      chomp($ARG);
      $ARG =~ s/([^:]+):.*/$1/;
      if ($ARG !~ /\.ttf$|\.ttc$/i) { # only .ttf and .ttc is supported
	next;
      }
      $fonts{"$ARG"} = 1;
    }
    close (FONTLIST);
  }
}

sub generate_config_entries {
  my ($font) = @_;

  if ($OPT_VERBOSITY >=1 ) {
    print "parsing font $font ...\n";
  }
  # quote " in font names:
  $font =~ s/\"/\\\"/g;
  open (FONT, "$ftdump_binary \"$font\" 2>/dev/null |") || die  "Can't open ftdump output: $!\n";
  # Apparently there are some fonts which have non-ASCII PostScript names.
  # If we are running in a UTF-8 locale, Perl will complain
  #    "Malformed UTF-8 character"
  # when reading the ftdump output of such a font.
  # Avoid that error by using the layer ":bytes" for this file handle.
  binmode FONT, ":bytes";

  my $postscript = "";
  my $family = "";
  my $style = "";
  my $face_number = -1;

  while (<FONT>) {
    if ($ARG =~ /face.*number.*:\s*([0-9]+)\s*/i) {
      $face_number = $1;
      $postscript = "";
      $family = "";
      $style = "";
    }
    # the following regexp should work with ftdump from either Freetype-1 or Freetype-2
    if ($ARG =~ /postscript.*:\s+([[:alnum:]\-]+?)\s*$/i) {
      $postscript = $1;
      if ($postscript eq "UNAVAILABLE") {
	$postscript = "";
      }
    }
    if ($ARG =~ /family.*:\s+([[:alnum:]].*[[:alnum:]])\s*$/i) {
      $family = $1;
    }
    if ($ARG =~ /style.*:\s+([[:alnum:]].*[[:alnum:]])\s*$/i) {
      $style = $1;
    }
    if ($face_number >= 0 && $postscript ne "" && $family ne "" && $style ne "") {
      my $entry = "displayNamedCIDFontTT $postscript $font";
      if ($font =~ /\.ttc$/i) {
	$entry .= " $face_number";
      }
      if ($OPT_VERBOSITY >= 1) {
	print "entry: $entry\n";
      }
      $displayNamedCIDFontTT{$postscript} = $entry;
      $face_number = -1;
    }
  }
  close (FONT);
}