home *** CD-ROM | disk | FTP | other *** search
/ tusportal.tus.k12.pa.us / tusportal.tus.k12.pa.us.tar / tusportal.tus.k12.pa.us / Wyse / latest-image.raw / 0.img / usr / sbin / xpdf-cjk-config < prev    next >
Text File  |  2009-07-27  |  4KB  |  136 lines
  1. #! /usr/bin/perl -w                        # -*- mode: perl coding: utf-8 -*-
  2. #
  3. # Wed May  5 14:57:49 2004  Mike FABIAN  <mfabian@suse.de>
  4. #
  5. ########################################################################
  6.  
  7. use strict;
  8. use utf8;
  9. use English;
  10. use Getopt::Long;
  11.  
  12. my $OPT_VERBOSITY = 0;
  13.  
  14. sub usage {
  15.   print "Usage: xpdf-cjk-config [option] ...\n";
  16.   print "--verbosity i      if i >= 1, print some messages to standard output.\n";
  17.   exit 1;
  18. }
  19.  
  20. # Process command line options
  21. my %opt;
  22. unless (GetOptions(\%opt,
  23.            'verbosity=i',   \$OPT_VERBOSITY,
  24.           )) {
  25.   &usage ();
  26.   exit 1;
  27. }
  28.  
  29. if (!defined $OPT_VERBOSITY) { $OPT_VERBOSITY = 1; }
  30.  
  31. my $fclist_binary = "/usr/bin/fc-list";
  32. my $ftdump_binary = "/usr/bin/ftdump";
  33. my $config_file   = "/etc/xpdfrc-cjk-auto";
  34.  
  35. if (!-x $fclist_binary || !-x $ftdump_binary) {
  36.   if ($OPT_VERBOSITY >= 1) {
  37.     print "fc-list or ftdump missing, exiting.\n";
  38.   }
  39.   exit 1;
  40. }
  41.  
  42. my %fonts = ();
  43. get_fonts(("ja", "ko", "zh-CN", "zh-TW", "zh-HK"));
  44. my %displayNamedCIDFontTT = ();
  45. for my $font (keys %fonts) {
  46.   generate_config_entries($font);
  47. }
  48.  
  49. open (CONFIG_FILE, ">$config_file") || die "can't open file $config_file: $!";
  50. print CONFIG_FILE "# autogenerated by /usr/sbin/xpdf-cjk-config:\n";
  51. for my $entry (sort (keys %displayNamedCIDFontTT)) {
  52.   print CONFIG_FILE "$displayNamedCIDFontTT{$entry}\n";
  53. }
  54. close (CONFIG_FILE);
  55.  
  56. exit 0;
  57.  
  58. ######################################################################
  59. sub get_fonts {
  60.   my @langs = @_;
  61.   for my $lang (@langs) {
  62.     if ($OPT_VERBOSITY >= 1) {
  63.       print "listing fonts for $lang\n";
  64.     }
  65.     open (FONTLIST, "$fclist_binary \":lang=$lang:outline=true\" file |") || die "Can't open fc-list output: $!\n";
  66.     binmode FONTLIST, ":bytes";
  67.     while (<FONTLIST>) {
  68.       chomp($ARG);
  69.       $ARG =~ s/([^:]+):.*/$1/;
  70.       if ($ARG !~ /\.ttf$|\.ttc$/i) { # only .ttf and .ttc is supported
  71.     next;
  72.       }
  73.       $fonts{"$ARG"} = 1;
  74.     }
  75.     close (FONTLIST);
  76.   }
  77. }
  78.  
  79. sub generate_config_entries {
  80.   my ($font) = @_;
  81.  
  82.   if ($OPT_VERBOSITY >=1 ) {
  83.     print "parsing font $font ...\n";
  84.   }
  85.   # quote " in font names:
  86.   $font =~ s/\"/\\\"/g;
  87.   open (FONT, "$ftdump_binary \"$font\" 2>/dev/null |") || die  "Can't open ftdump output: $!\n";
  88.   # Apparently there are some fonts which have non-ASCII PostScript names.
  89.   # If we are running in a UTF-8 locale, Perl will complain
  90.   #    "Malformed UTF-8 character"
  91.   # when reading the ftdump output of such a font.
  92.   # Avoid that error by using the layer ":bytes" for this file handle.
  93.   binmode FONT, ":bytes";
  94.  
  95.   my $postscript = "";
  96.   my $family = "";
  97.   my $style = "";
  98.   my $face_number = -1;
  99.  
  100.   while (<FONT>) {
  101.     if ($ARG =~ /face.*number.*:\s*([0-9]+)\s*/i) {
  102.       $face_number = $1;
  103.       $postscript = "";
  104.       $family = "";
  105.       $style = "";
  106.     }
  107.     # the following regexp should work with ftdump from either Freetype-1 or Freetype-2
  108.     if ($ARG =~ /postscript.*:\s+([[:alnum:]\-]+?)\s*$/i) {
  109.       $postscript = $1;
  110.       if ($postscript eq "UNAVAILABLE") {
  111.     $postscript = "";
  112.       }
  113.     }
  114.     if ($ARG =~ /family.*:\s+([[:alnum:]].*[[:alnum:]])\s*$/i) {
  115.       $family = $1;
  116.     }
  117.     if ($ARG =~ /style.*:\s+([[:alnum:]].*[[:alnum:]])\s*$/i) {
  118.       $style = $1;
  119.     }
  120.     if ($face_number >= 0 && $postscript ne "" && $family ne "" && $style ne "") {
  121.       my $entry = "displayNamedCIDFontTT $postscript $font";
  122.       if ($font =~ /\.ttc$/i) {
  123.     $entry .= " $face_number";
  124.       }
  125.       if ($OPT_VERBOSITY >= 1) {
  126.     print "entry: $entry\n";
  127.       }
  128.       $displayNamedCIDFontTT{$postscript} = $entry;
  129.       $face_number = -1;
  130.     }
  131.   }
  132.   close (FONT);
  133. }
  134.  
  135.  
  136.