summaryrefslogtreecommitdiff
path: root/Master/tlpkg/bin/check-files-by-format
blob: 150b8b21d313d6bab2c83ab2b6dc12f14d9b5b67 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
#!/usr/bin/env perl
# $Id$
#
# Check that files in various formats are in good shape.
#
# The following formats are checked currently: pdf, pfb, tfm, vf, otf.
#
# For each format, there is one routine &check_<format> and an exclusion
# 'list' (hash reference) $exclude_<format>: the keys are either a
# directory name if they have a trailing slash, or a file name. If a key
# named '*base*' is present, then the paths are relative to this base,
# otherwise to $tlroot. The values of the keys may be free or have a
# special meaning depending on the associated check_<format> routine.
#
# Formats that might be added:
# - afm with (afm2pl?)
#
# Manuel P\'egouri\'e-Gonnard, 2010-2013. WTFPL v2.

BEGIN {
#  $^W = 1;
  ($mydir = $0) =~ s,/[^/]*$,,;
  $tlroot = "$mydir/../..";
  unshift (@INC, "$tlroot/tlpkg");
}

use File::Basename;
use File::Temp;
use Pod::Usage;
use Getopt::Long;

use TeXLive::TLPDB;


# Most of these breakages need to be reported upstream, or documented
# that they are unavoidable.  Add comments if you pursue any of them.

# value has no meaning here
my $exclude_otf = { '*base*' => 'texmf-dist/fonts/opentype',
  'texmf-dist/doc/fonts/cm-unicode/Fontmap.CMU.otf' => 1,
};

# 1 means pdfinfo issues errors but still exits successfully
# 2 means pdfinfo exits non-zero
my $exclude_pdf = {
     # 14nov11 author cannot fix:
  'texmf-dist/doc/fonts/frcursive/frcursive.pdf' => 1,
     # 15dec12 derekn says will be fixed in next xpdf after 3.03:
     # (causes seg fault now):
  'texmf-dist/doc/latex/ocgx/demo-ocgx.pdf' => -1,
  'texmf-dist/dvips/tetex/config.pdf' => -1, # not a PDF file
};

# the value has no meaning here
my $exclude_pfb = { '*base*' => 'texmf-dist/fonts/type1',
  'adobe/courier/' => 1,
  'adobe/sourcecodepro/' => 1, # SourceCodePro-Regular.pfb, 10nov12 contacted
  'arabi/arabeyes/' => 1,
  'arabi/farsiweb/' => 1,
  'arkandis/adfsymbols/' => 1,
  'arkandis/libris/' => 1,
  'arkandis/venturis/' => 1,
  'arphic/bkaiu/' => 1,
  'arphic/bsmiu/' => 1,
  'arphic/gbsnu/' => 1,
  'arphic/gkaiu/' => 1,
  'gust/poltawski/' => 1,
  'nowacki/iwona/' => 1,
  'nowacki/kurier/' => 1,
  'public/allrunes/' => 1,
  'public/amsfonts/cm/' => 1,
  'public/amsfonts/cmextra/' => 1,
  'public/arev/' => 1,
  'public/ascii-font/' => 1,
  'public/aspectratio/' => 1, # 11feb12 reported to author
  'public/augie/' => 1,
  'public/aurical/' => 1,
  'public/bbold-type1/' => 1, # old y&y fonts, won't be changing
  'public/belleek/' => 1,
  'public/bera/' => 1,
  'public/brushscr/' => 1,
  'public/burmese/' => 1,
  'public/carolmin-ps/' => 1,
  'public/chemarrow/' => 1,
  'public/cjhebrew/' => 1,
  'public/cmcyr/' => 1,
  'public/cm-super/' => 1,
  'texmf-dist/doc/fonts/cm-unicode/Fontmap.CMU.pfb' => 1,
  'public/cm-unicode/cmunobi.pfb' => 1,
  'public/countriesofeurope/' => 1, # 22apr12 not reported
  'public/cs/' => 1,
  'public/doublestroke/' => 1,
  'public/epiolmec/' => 1,
  'public/esstix/' => 1,  # 12may11 author fixed some, others will remain
  'public/ethiop-t1/' => 1,
  'public/eurosym/' => 1,
  'public/fbb/' => 1,		# 23aug13 bluevalues, not fixable
  'public/foekfont/' => 1,
  'public/fonetika/' => 1,
  'public/fourier/' => 1,
  'public/gfsartemisia/' => 1,
  'public/gfsbaskerville/' => 1,
  'public/gfsbodoni/' => 1,
  'public/gfscomplutum/' => 1,
  'public/gfsdidot/' => 1,
  'public/gfsneohellenic/' => 1,
  'public/gfssolomos/' => 1,
  'public/hacm/' => 1,
  'public/initials/' => 1,
  'public/ipaex-type1/' => 1,	# 20may13 too many to bother reporting
  'public/itrans/' => 1,
  'public/kerkis/' => 1,
  'public/kpfonts/' => 1,
  'public/libertine/' => 1,	# 5jan13 maintainer declines to fix triviality
  'public/linearA/' => 1,
  'public/lm/' => 1,
  'public/lxfonts/' => 1,
  'public/mathabx-type1/' => 1,  # 14jan11 wrote bnb/preining --karl
  'public/marvosym/' => 1,
  'public/mathpazo/' => 1,
  'public/musixtex-fonts/' => 1, # 2nov11 wrote tennent --karl
  'public/newtx/' => 1,          # 12may12 author will fix in next release
  'public/ocherokee/' => 1,
  'public/oinuit/' => 1,
  'public/omega/' => 1,
  'public/phaistos/' => 1,
  'public/playfair/' => 1,	# 15mar14 known hinting issues
  'public/pl/' => 1,
  'public/pxfonts/' => 1,
  'public/rsfs/' => 1,
  'public/starfont/' => 1,	# 4oct10 reported to author 
  'public/staves/' => 1,
  'public/stmaryrd/' => 1,	# blue values not defined, not maintained
  'public/tabvar/' => 1,
  'public/tex-gyre/' => 1,
  'public/txfonts/' => 1,
  'public/txfontsb/' => 1,
  'public/wasy/' => 1,
  'public/xypic/' => 1,
  'public/yhmath/' => 1,
  'uhc/umj/' => 1,
  'urw/avantgar/' => 1,
  'urw/bookman/' => 1,
  'urw/courier/' => 1,
  'urw/helvetic/' => 1,
  'urw/ncntrsbk/' => 1,
  'urw/palatino/' => 1,
  'urw/symbol/' => 1,
  'urw/times/' => 1,
  'urw/zapfding/' => 1,
  'vntex/arevvn/' => 1,
  'vntex/comicsansvn/' => 1,
  'vntex/txttvn/' => 1,
  'vntex/urwvn/' => 1,
  'vntex/vnr/' => 1,
  'wadalab/dgj/' => 1,
  'wadalab/dmj/' => 1,
  'wadalab/mcj/' => 1,
  'wadalab/mrj/' => 1,
  'tlpkg/texworks/share/fonts/type1/gsfonts/' => 1, # these come from gs
};


# the value has no meaning here
my $exclude_tfm = { '*base*' => 'texmf-dist/fonts/tfm',
  'jknappen/ec/' => 1,
  'jknappen/fc/' => 1,
  'public/arev/' => 1,
  'public/chess/' => 1,		# original has extra bytes, not worth fixing
  'public/cmcyr/' => 1,
  'public/dozenal/' => 1,	# wrote author 31oct12
  'public/gfsbodoni/' => 1,	# wrote author 12dec12
  'public/malayalam/' => 1,
  'public/japanese-otf/' => 1,	# japanese tfm's
  'public/japanese-otf-uptex/' => 1, # japanese tfm's
  'public/wnri/' => 1,
  'public/wsuipa/' => 1,
};


# the value has no meaning here
my $exclude_vf = { '*base*' => 'texmf-dist/fonts/vf',
  'public/bgreek/' => 1,
  'public/eco/' => 1,
  'public/epigrafica/' => 1,
  'public/fonts-tlwg/' => 1,	# reported to author, early 2012
  'public/gfsartemisia/' => 1,
  'public/gfscomplutum/' => 1,
  'public/gfsdidot/' => 1,
  'public/gfsneohellenic/' => 1,
  'public/gfsporson/' => 1,
  'public/gfssolomos/' => 1,
  'public/hfoldsty/' => 1,
  'public/kerkis/' => 1,
  'public/sansmathfonts/' => 2,	# 20may13 ok with cmssbx12.tfm from sauter
  'mathdesign/mdbch/' => 1,
  'mathdesign/mdput/' => 1,
  'mathdesign/mdugm/' => 1,
  'public/txfontsb/' => 1,
  'vntex/comicsansvn/' => 1,
  'public/zefonts/' => 1,
  'public/ae/' => 1,
};


my $tmpdir = File::Temp::tempdir(CLEANUP => 1);

my $opt_all = 0;
my $opt_help = 0;

TeXLive::TLUtils::process_logging_options ();
GetOptions ("all" => \$opt_all,
            "help|?" => \$opt_help) or pod2usage (2);
pod2usage ("-exitstatus" => 0, "-verbose" => 2) if $opt_help;


exit(&main());


sub main {
  my @files = get_file_list();

  for my $file (grep { /\.otf$/ } @files) {
    check_otf($file);}

  for my $file (grep { /\.pdf$/ } @files) {
    check_pdf($file); }

  for my $file (grep { /\.pfb$/ } @files) {
    check_pfb($file); }

  for my $file (grep { /\.tfm$/ } @files) {
    check_tfm($file); }

  for my $file (grep { /\.vf$/ } @files) {
    check_vf($file); }

  return 0;
}

# get the list of files in the database of a TL installation
sub get_file_list {
  my $tlpdb = TeXLive::TLPDB->new(root => $tlroot);

  my @files = ();
  for my $tlpname ($tlpdb->list_packages) {
    my $tlp = $tlpdb->get_package($tlpname);
    push(@files, $tlp->docfiles, $tlp->runfiles, $tlp->srcfiles);
  }

  # [u]ptex font files use their own formats; don't bother checking,
  # or adding lots of individual entries to the exclude lists.
  @files = grep ($_ !~ m!/u?ptex/!, @files);

  # It takes a long time (about an hour) to check every file.  And there
  # is no value in checking unchanged files every day.  So we filter the
  # file list (unless --all is given) by mtime ... unless this happens
  # to be the first of the month, when we'll check everything, just to
  # be reminded of anything that may have crept in.
  # 
  if (! ($opt_all || `date +%d` == 1)) {
    my @filtered = ();
    for my $f (@files) {
      push (@filtered, $f) if (-M "$tlroot/$f" < 4);
    }
    @files = @filtered;
  }
  return @files;
}


# return the value in exclude list associated to a file, or undef
sub exclude_value {
  my ($exclude, $file) = @_;
  my $base = $exclude->{'*base*'};
  $file =~ s!$base/!! if $base;
  (my $filedir = $file) =~ s![^/]*$!!;
  return $exclude->{$file} || $exclude->{$filedir};
}


# the checking routines for each file type.

sub check_pdf {
  my ($file) = @_;
  my $excl_val = exclude_value($exclude_pdf, $file) || 0;
  return if $excl_val < 0;
  #
  my $errfile = "$tmpdir/pdferr";
  unlink($errfile);
  my $bad_exit = system("pdfinfo $tlroot/$file >/dev/null 2>$errfile");
  my $badness = $bad_exit ? 2 : -s $errfile ? 1 : 0;
  return if $badness <= $excl_val;
  print "Bad PDF: $file\n" if $badness == 2;
  print "Damaged PDF: $file\n" if $badness == 1;
}

sub check_pfb {
  my ($file) = @_;
  return if defined exclude_value($exclude_pfb, $file);
  my $errfile = "$tmpdir/pfberr";
  unlink($errfile);
  my $bad = system("t1lint -q $tlroot/$file");
  print "Bad PFB: $file\n" if $bad;
}

sub check_tfm {
  my ($file) = @_;
  return if defined exclude_value($exclude_tfm, $file);
  my $outfile = "$tmpdir/tfmout.pl";
  my $errfile = "$tmpdir/tfmerr";
  unlink($errfile);
  system("tftopl $tlroot/$file $outfile 2>$errfile");
  print "Bad tfm: $file\n" if -s $errfile;
}

sub check_vf {
  my ($file) = @_;
  return if defined exclude_value($exclude_vf, $file);
  (my $tfmfile = $file) =~ s!/vf/!/tfm/!;
  $tfmfile =~ s/\.vf$/.tfm/;
  return if defined exclude_value($exclude_tfm, $tfmfile);
  my $outfile = "$tmpdir/vfout.vp";
  my $errfile = "$tmpdir/vferr";
  unlink($errfile);
  system("vftovp $tlroot/$file $tlroot/$tfmfile $outfile 2>$errfile");
  print "Bad vf: $file\n" if -s $errfile;
}

sub check_otf {
  my ($file) = @_;
  return if defined exclude_value($exclude_otf, $file);
  my $bad = system("otfinfo --info $tlroot/$file >/dev/null 2>&1");
  print "Bad otf: $file\n" if $bad;
}

# vim: sw=2 expandtab