1 #! /usr/perl5/bin/perl -w
4 # Copyright (c) 2010, 2018, Oracle and/or its affiliates. All rights reserved.
6 # Permission is hereby granted, free of charge, to any person obtaining a
7 # copy of this software and associated documentation files (the "Software"),
8 # to deal in the Software without restriction, including without limitation
9 # the rights to use, copy, modify, merge, publish, distribute, sublicense,
10 # and/or sell copies of the Software, and to permit persons to whom the
11 # Software is furnished to do so, subject to the following conditions:
13 # The above copyright notice and this permission notice (including the next
14 # paragraph) shall be included in all copies or substantial portions of the
17 # THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
18 # IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
19 # FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
20 # THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
21 # LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
22 # FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
23 # DEALINGS IN THE SOFTWARE.
27 require 5.005; # minimal Perl version required
31 use File
::Spec
; # pathname manipulation routines
32 use English
qw( -nomatchvars );
42 my $result = GetOptions
('p|protodir=s' => \
$proto_dir,
43 'm|manifest=s' => \
$manifest);
45 if (!defined($proto_dir)) {
46 print STDERR
"Missing required protodir argument\n";
50 if (!defined($manifest)) {
51 print STDERR
"Missing required manifest argument\n";
55 # Directories containing font files
58 open my $MANIFEST, '<', $manifest
59 or die "Cannot open manifest $manifest: $!\n";
61 while (my $man = <$MANIFEST>) {
62 if ($man =~ m{path=(\S+)/fonts.dir}) {
68 foreach my $fd (keys %fontdirs) {
69 my $protofontpath = join('/', $proto_dir, $fd);
70 my $protometafile = join('/', $proto_dir, $fd, 'fonts.dir');
73 if (! -f
$protometafile) {
74 # mkfontscale -b -s -l is equivalent to mkfontdir
75 run_cmd
("/usr/bin/mkfontscale", "-b", "-s", "-l",
79 open my $XFILE, '<', $protometafile
80 or die "Cannot open $protometafile: $!\n";
82 while (my $x = <$XFILE>) {
85 my ($fontfile, $fontxlfd) = split(/\s+/, $x, 2);
86 $xlfds{$fontxlfd} = $fontfile;
88 qq(<transform file path
="$fd/%s" -> add info
.file
.font
.xlfd
"%s">\n),
94 $protometafile = join('/', $proto_dir, $fd, 'fonts.alias');
96 if (-f
$protometafile) {
98 open my $XFILE, '<', $protometafile
99 or die "Cannot open $protometafile: $!\n";
101 while (my $x = <$XFILE>) {
104 my ($fontalias, $fontxlfd) = split(/\s+/, $x, 2);
105 $fontxlfd =~ s{^"(.*)"$}{$1};
106 if (exists $xlfds{$fontxlfd}) {
107 my $fontfile = $xlfds{$fontxlfd};
109 qq(<transform file path
="$fd/%s" -> add info
.file
.font
.xlfd
"%s">\n),
110 $fontfile, $fontalias;
112 # print STDERR qq(No match found for "$fontxlfd" in $protometafile\n);
121 my $fc_scan = "/usr/bin/fc-scan";
123 # See FcPatternFormat(3) for the full definition of the format syntax
124 # %{file} => print the named value for this font
125 # %{fullname|cescape} => print the named value with C-style string escapes
126 # (adds \ in front of \ or " characters)
127 # %{?fullname{..A..}{..B..}} => if fullname is defined, then print A, else B
128 # []fullname,fullnamelang{..A..} => for each pair of fullname & fullnamelang,
129 # print A with those values substituted
130 my $fc_scan_format = q
(--format
=%{?fullname
{%{[]fullname
,fullnamelang
{<transform file path
="%{file}" -> add info
.file
.font
.name
:%{fullnamelang
} "%{fullname|cescape}">\n}}}{%{[]family
,style
{<transform file path
="%{file}" -> add info
.file
.font
.name
"%{family|cescape} %{style|cescape} %{pixelsize}">\n}}}});
134 run_cmd
($fc_scan, $fc_scan_format, keys %fontdirs);
141 print STDERR
"failed to execute $cmd: $!\n";
144 printf STDERR
"$cmd died with signal %d, %s coredump\n",
145 ($?
& 127), ($?
& 128) ?
'with' : 'without';
148 my $exit_code = $?
>> 8;
149 if ($exit_code != 1) {
150 printf STDERR
"$cmd exited with value %d\n", $exit_code;