OpenIndiana Userland
view | history | commit | commitdiff
Andreas Wacknitz
2024-04-02 4355950cfef841b7bae0a3e1c2d58f596b21955a
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 }