commit | author | age
|
a49d4f
|
1 |
#! /usr/perl5/bin/perl -w |
AL |
2 |
|
|
3 |
# |
|
4 |
# Copyright (c) 2010, 2018, Oracle and/or its affiliates. All rights reserved. |
|
5 |
# |
|
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: |
|
12 |
# |
|
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 |
|
15 |
# Software. |
|
16 |
# |
|
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. |
|
24 |
# |
|
25 |
# |
|
26 |
|
|
27 |
require 5.005; # minimal Perl version required |
|
28 |
use strict; # |
|
29 |
use diagnostics; # |
|
30 |
use integer; # |
|
31 |
use File::Spec; # pathname manipulation routines |
|
32 |
use English qw( -nomatchvars ); |
|
33 |
use Getopt::Long; |
|
34 |
|
|
35 |
# Required arguments: |
|
36 |
# -p <proto_area> |
|
37 |
# -m <manifest> |
|
38 |
|
|
39 |
my $proto_dir; |
|
40 |
my $manifest; |
|
41 |
|
|
42 |
my $result = GetOptions('p|protodir=s' => \$proto_dir, |
|
43 |
'm|manifest=s' => \$manifest); |
|
44 |
|
|
45 |
if (!defined($proto_dir)) { |
|
46 |
print STDERR "Missing required protodir argument\n"; |
|
47 |
exit(1); |
|
48 |
} |
|
49 |
|
|
50 |
if (!defined($manifest)) { |
|
51 |
print STDERR "Missing required manifest argument\n"; |
|
52 |
exit(1); |
|
53 |
} |
|
54 |
|
|
55 |
# Directories containing font files |
|
56 |
my %fontdirs = (); |
|
57 |
|
|
58 |
open my $MANIFEST, '<', $manifest |
|
59 |
or die "Cannot open manifest $manifest: $!\n"; |
|
60 |
|
|
61 |
while (my $man = <$MANIFEST>) { |
|
62 |
if ($man =~ m{path=(\S+)/fonts.dir}) { |
|
63 |
$fontdirs{$1} = $1; |
|
64 |
} |
|
65 |
} |
|
66 |
close $MANIFEST; |
|
67 |
|
|
68 |
foreach my $fd (keys %fontdirs) { |
|
69 |
my $protofontpath = join('/', $proto_dir, $fd); |
|
70 |
my $protometafile = join('/', $proto_dir, $fd, 'fonts.dir'); |
|
71 |
my %xlfds = (); |
|
72 |
|
|
73 |
if (! -f $protometafile) { |
|
74 |
# mkfontscale -b -s -l is equivalent to mkfontdir |
|
75 |
run_cmd("/usr/bin/mkfontscale", "-b", "-s", "-l", |
|
76 |
$protofontpath); |
|
77 |
} |
|
78 |
|
|
79 |
open my $XFILE, '<', $protometafile |
|
80 |
or die "Cannot open $protometafile: $!\n"; |
|
81 |
|
|
82 |
while (my $x = <$XFILE>) { |
|
83 |
chomp($x); |
|
84 |
if ($x =~ m{\s+}) { |
|
85 |
my ($fontfile, $fontxlfd) = split(/\s+/, $x, 2); |
|
86 |
$xlfds{$fontxlfd} = $fontfile; |
|
87 |
printf |
|
88 |
qq(<transform file path="$fd/%s" -> add info.file.font.xlfd "%s">\n), |
|
89 |
$fontfile, $fontxlfd; |
|
90 |
} |
|
91 |
} |
|
92 |
close $XFILE; |
|
93 |
|
|
94 |
$protometafile = join('/', $proto_dir, $fd, 'fonts.alias'); |
|
95 |
|
|
96 |
if (-f $protometafile) { |
|
97 |
|
|
98 |
open my $XFILE, '<', $protometafile |
|
99 |
or die "Cannot open $protometafile: $!\n"; |
|
100 |
|
|
101 |
while (my $x = <$XFILE>) { |
|
102 |
chomp($x); |
|
103 |
if ($x =~ m{\s+}) { |
|
104 |
my ($fontalias, $fontxlfd) = split(/\s+/, $x, 2); |
|
105 |
$fontxlfd =~ s{^"(.*)"$}{$1}; |
|
106 |
if (exists $xlfds{$fontxlfd}) { |
|
107 |
my $fontfile = $xlfds{$fontxlfd}; |
|
108 |
printf |
|
109 |
qq(<transform file path="$fd/%s" -> add info.file.font.xlfd "%s">\n), |
|
110 |
$fontfile, $fontalias; |
|
111 |
} else { |
|
112 |
# print STDERR qq(No match found for "$fontxlfd" in $protometafile\n); |
|
113 |
} |
|
114 |
} |
|
115 |
} |
|
116 |
close $XFILE; |
|
117 |
} |
|
118 |
|
|
119 |
} |
|
120 |
|
|
121 |
my $fc_scan = "/usr/bin/fc-scan"; |
|
122 |
|
|
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}}}}); |
|
131 |
|
|
132 |
|
|
133 |
chdir($proto_dir); |
|
134 |
run_cmd($fc_scan, $fc_scan_format, keys %fontdirs); |
|
135 |
exit(0); |
|
136 |
|
|
137 |
sub run_cmd { |
|
138 |
my $cmd = $_[0]; |
|
139 |
system(@_); |
|
140 |
if ($? == -1) { |
|
141 |
print STDERR "failed to execute $cmd: $!\n"; |
|
142 |
} |
|
143 |
elsif ($? & 127) { |
|
144 |
printf STDERR "$cmd died with signal %d, %s coredump\n", |
|
145 |
($? & 127), ($? & 128) ? 'with' : 'without'; |
|
146 |
} |
|
147 |
elsif ($? != 0) { |
|
148 |
my $exit_code = $? >> 8; |
|
149 |
if ($exit_code != 1) { |
|
150 |
printf STDERR "$cmd exited with value %d\n", $exit_code; |
|
151 |
exit($exit_code); |
|
152 |
} |
|
153 |
} |
|
154 |
} |