summaryrefslogtreecommitdiff
path: root/Master/tlpkg/bin/tl-check-fmttriggers
blob: 90fb4131d2b10473be75e0fe9760b6d2de6519ff (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
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
#!/usr/bin/env perl
# $Id$
# Originally written by Norbert Preining and Karl Berry, 2015.  Public domain.
# 
# Determine the files on which each format (fmt/base) depends
#   (by running fmtutil -recorder),
# then map those files to TL packages,
# then check that exactly those packages are listed as triggers in the
#   corresponding tlpsrc files.

my $vc_id = '$Id$';
my $Master;

BEGIN {
  $^W = 1;
  $| = 1;
  (my $mydir = $0) =~ s,/[^/]*$,,;
  my $tlroot = "$mydir/../..";
  unshift (@INC, "$tlroot/tlpkg");
  chomp ($Master = `cd $mydir/../.. && pwd`);
}

use File::Find;
use Getopt::Long;
use Pod::Usage;

use TeXLive::TLConfig;
use TeXLive::TLUtils qw(info debug ddebug debug_hash tlwarn tldie);

my $prg = TeXLive::TLUtils::basename($0);

my $opt_analyze = 0;
my $opt_fmtargs = "--all";
my $opt_fmtdir = "/tmp/fmttriggers";
my $opt_rerecord = 1;
my $opt_help = 0;
my $opt_version = 0;

TeXLive::TLUtils::process_logging_options ();
GetOptions (
  "analyze"    => \$opt_analyze,
  "fmtargs=s"  => \$opt_fmtargs,
  "fmtdir"     => \$opt_fmtdir,
  "rerecord!"  => \$opt_rerecord,
  "version"    => \$opt_version,
  "help|?"     => \$help) || pod2usage(1);

pod2usage ("-exitstatus" => 0, "-verbose" => 2) if $help;
if ($opt_version) { print "$vc_id\n"; exit 0; } 

# These don't have triggers, and that's ok.
my $no_triggers_ok = '^(mf-nowin\.mf|(pdf|xe)tex\.cont-en)$';

exit (&main());


sub main {
  $::installerdir = $Master;  # TLUtils.pm should be smarter
  $ENV{'PATH'} = "$Master/bin/" . TeXLive::TLUtils::platform() . ":$ENV{PATH}";

  # no interference from TEXMFHOME, etc.
  $ENV{'TEXMFHOME'}   = "/nonesuch-home";
  $ENV{'TEXMFVAR'}    = "/nonesuch-uvar";
  $ENV{'TEXMFCONFIG'} = "/nonesuch-uconfig";
  $ENV{'TEXMFLOCAL'}  = "/nonesuch-local";

  if ($opt_rerecord && ! $opt_analyze) {  # remake recorder files?
    my $status = &run_fmtutil ($opt_fmtdir);
    return $status if $status;
  }
  #system ("bytime $opt_fmtdir");
  
  # read tlpdb.
  my $tlpdb_file = "$Master/tlpkg/texlive.tlpdb";
  my ($tlpdb,$fmttriggers,$fmtpkgcontainers) = &tlpdb_by_file ($tlpdb_file);
 
  # if reporting on the trigger subsets, just do that and we're done.
  if ($opt_analyze) {
    &analyze_triggers ($fmttriggers);
    return 0;
  }
  
  # read recorder files.
  my %files_per_format = &files_per_format ($opt_fmtdir);

  # map files used in the format builds to packages.
  my %pkgs_per_format = &pkgs_per_format ($tlpdb, %files_per_format);
  
  # check that those packages are exactly what's listed as needed.
  my $ret = &compare_pkgs_and_triggers (\%pkgs_per_format,
                                        $fmttriggers,
                                        $fmtpkgcontainers);
  info ("Exit status: $ret\n");
  return $ret;
}


# Run fmtutil --fmtdir=$OUTDIR --recorder ..., to recreate the recorder
# files which are the basis for finding the dependencies.
# 
# OUTDIR is completely removed first (!!), on the theory that this job
# should only be done in temporary directories.
# 
sub run_fmtutil {
  my ($outdir) = @_;
  
  # yep, destroy output directory tree.
  TeXLive::TLUtils::rmtree ($outdir);
  mkdir ($outdir, 0775) || die "$prg: mkdir($outdir) failed: $!";
  
  # the output from fmtutil can be useful in debugging.
  my $logfile = "$outdir/fmtutil.log";
  my $cmd = "fmtutil --sys --recorder --strict --fmtdir=$outdir "
             . "$opt_fmtargs >$logfile 2>&1";
  &info ("Running $cmd\n");
  my $retval = system ($cmd);
  $retval >>= 8 if $retval > 0;
  if ($retval) {
    tlwarn ("fmtutil exit status = $retval; contents of $logfile =\n");
    tlwarn (`cat $logfile`);
    tldie ("fmtutil failed, goodbye.\n");
  }
  return $retval;
}


# Return a hash with each key being a string of the form ENGINE.FORMAT,
# and the corresponding value a reference to the list of files used to
# make that format with that engine.  This is based on reading the
# recorder files (format.fls/.ofl) for the format in FMTDIR.
# Uninteresting files are removed from the list, as is the Master
# directory prefix.
# 
sub files_per_format {
  my ($fmtdir) = @_;
  my %ret;
  
  # gather all fls files.
  my @fls = ();
  my $recorder_files = sub {
    # fun with perl: we use an anonymous sub because it's lexically scoped,
    #   hence we can update a my variable (@fls) inside.  Explanation at, e.g.,
    #   http://stackoverflow.com/questions/8839005
    # In this case, we could also pass a lambda sub to find, since
    #   this sub is so simple, but for purposes of example, do it this way.
    push (@fls, $File::Find::name)
      if $File::Find::name =~ /\.(fls|ofl)$/
  };
  File::Find::find ($recorder_files, $fmtdir);
  
  # each fls file will become an entry in the return hash.
  my $fls_count = @fls;
  &info ("Reading $fls_count fls file(s): @fls\n");
  for my $fls_name (@fls) {
    open (my $fls, $fls_name) || die "open($fls_name) failed: $!";
    my @files = ();
    while (<$fls>) {
      next unless s/^INPUT //;
      next if m,/web2c/texmf\.cnf$,;       # read internally by kpathsea
      next if m,/fontname/texfonts\.map$,; # likewise
      next if m,/texsys\.aux$,;            # aux file created during run
      chomp;
      s,^${Master}/,,;			   # rm prefix
      push (@files, $_);
    }
    close ($fls) || warn "close($fls_name) failed: $!";
    
    # The engine name is the directory above the format file,
    # and the format name is the format file without extension.
    my ($engine,$format) = ($fls_name =~ m!^.*/([^/]+)/([^/.]+)\.[^/]+$!);
    #
    # we'd have to have a similar special case for mpost if mem files
    # were still used (see rebuild_one_format in fmtutil).
    $engine = "mf-nowin" if $engine eq "metafont";
    #
    my $ef = "$engine.$format";

    # Unfortunately, format filenames themselves are not unique, due to
    # cont-en and pdfcsplain.  Shouldn't be any engine+format dups, though.
    # 
    tldie ("$prg: already saw format $ef\n (with files @{$ret{$ef}}),\n"
           . "  files now = @files\n")
      if exists $ret{$ef};
    $ret{$ef} = \@files;
  }

  #&debug_hash ("files_per_format returning hash", %ret);
  return %ret;
}


# Read TLPDB_FILE and return references to three hashes:
# the first mapping contained files to TL package names, 
# the second mapping engine.format names to their specified fmttriggers,
# the third mapping engine.format names to the package defining them.
# 
# Instead of using the general TeXLive::TLPDB functions, read the tlpdb
# file ourselves.  We want to build the file->package mapping just once,
# for all files, or things become noticeably slow.  (The tlpfiles script
# does this too, but we repeat that code here because we want to find
# the fmttriggers too.)
#
sub tlpdb_by_file {
  my ($tlpdb_file) = @_;
  my (%tlpfiles, %fmttriggers, %fmtpkgcontainers);
  
  open (my $tlpdb, $tlpdb_file) || die "open($tlpdb_file) failed: $!";
  my $pkg;
  while (<$tlpdb>) {
    chomp;
    if (/^name /) {  # notice package names
      (undef,$pkg) = split (/ /);

    } elsif (s/^execute +AddFormat +//) {  # notice AddFormat lines
      my %af = TeXLive::TLUtils::parse_AddFormat_line ($_);
      if (exists $af{"error"}) {
        tldie ("$prg: parse_AddFormat_line failed: $af{error}\n"
               . "line = $_\n");
      }
      
      next if $af{"mode"} == 0; # skip disabled.
      
      my $ef = "$af{engine}.$af{name}";
      if ($af{"fmttriggers"}) {
        if (exists ($fmttriggers{$ef})) {
          tldie ("$prg: already saw triggers for $ef ($fmttriggers{$ef}),"
                 . "  triggers now = $af{fmttriggers}\n");
        }
        $fmttriggers{$ef} = $af{"fmttriggers"};
        $fmtpkgcontainers{$ef} = $pkg;
        #warn "  fmtpkgcontainers{$ef} = $pkg\n";
      } else {
        tlwarn ("$prg: no fmttriggers: $_\n") unless $ef =~ /$no_triggers_ok/;
      }

    } elsif (s/^ //) { # notice file names
      # we carefully designed the format so that the only lines with
      # leading spaces are the files.
      # The installer "package" isn't one, just ignore it.
      next if $pkg eq "00texlive.installer";
      my $f = $_;
      tlwarn ("$prg: already saw file $f (package $tlpfiles{$f}),"
              . " now in package $pkg\n")
        if exists $tlpfiles{$f}; # should never happen
      $tlpfiles{$f} = $pkg;
    }
  }
  close ($tlpdb) || warn "close($tlpdb_file) failed: $!";
  
  &info ("TLPDB files: " . scalar (keys %tlpfiles)
         . "  triggers: " . scalar (keys %fmttriggers) . "\n");
  return (\%tlpfiles, \%fmttriggers, \%fmtpkgcontainers);
}
  

# Return a hash with each key being a format name and the corresponding
# value a reference to the list of TL packages which contain the files
# used to make that format, based on the incoming TLPDB and FILES_PER_FORMAT.
# 
sub pkgs_per_format {
  my ($tlpdb,%files_per_format) = @_;
  my %ret;  # format->pkgs mapping

  for my $format (sort keys %files_per_format) {
    &debug ("finding packages for $format...\n");
    my %pkgs_for_this_format;
    my $files_ref = $files_per_format{$format};
    for my $f (@$files_ref) {
      next if $f eq "/dev/null";
      if (exists $tlpdb->{$f}) {
        my $pkg = $tlpdb->{$f};
        $pkgs_for_this_format{$pkg} = 1;
      } else {
        tlwarn ("$prg: tl package not found for file: $f\n");
      }
    }

    # looked up all files for this format; save our list of packages.
    my @pkgs = sort keys %pkgs_for_this_format;
    &debug ("  packages for $format: @pkgs\n");
    if (@pkgs == 0) {
      tlwarn ("$prg: no packages for format $format?  files = @$files_ref\n");
    }
    $ret{$format} = \@pkgs;
  }

  &info ("Formats found: " . scalar (keys %ret) . "\n");
  #&debug_hash ("pkgs_per_format returning", %ret);
  return %ret;
}


# Compare lists of packages required by building (PKGS_PER_FORMAT) with
# lists of existing trigger directives (FMTTRIGGERS). Return 0 if
# identical, 1 otherwise (and report differences). Ignore some
# hyphenation dependencies, the package itself containing the trigger
# directive (FMTPKGCONTAINERS), and various other dependencies we
# specify to ease maintenance.
# 
sub compare_pkgs_and_triggers {
  my ($pkgs_per_format,$fmttriggers,$fmtpkgcontainers) = @_;
  my $bad_p = 0;
  my $all_pkgs = 0;
  
  # we don't include these as fmttriggers since when they meaningfully
  # change, fmtutil should get called anyway due to language.* changing.
  my @skip_recorded = qw(dehyph-exptl ruhyphen ukrhyph);
  #
  # Anything matching hyphen-.* is also ignored, but not hyph-utf8.

  for my $ef (sort keys %$pkgs_per_format) {
    my @recorded_pkgs = @{$pkgs_per_format->{$ef}};
    $all_pkgs += @recorded_pkgs;

    my %recorded_pkgs;
    @recorded_pkgs{@recorded_pkgs} = ();  # hash slice for recorded pkgs

    if (defined $fmttriggers->{$ef}) {
      my @tlpdb_pkgs = @{$fmttriggers->{$ef}};
      my %tlpdb_pkgs;
      @tlpdb_pkgs{@tlpdb_pkgs} = ();       # hash slice for tlpdb pkgs

      my @recorded_only = ();
      for my $r (keys %recorded_pkgs) {
        # no need for a package to include itself as a fmttrigger.
        next if $r eq $fmtpkgcontainers->{$ef};
        
        if (exists $tlpdb_pkgs{$r}) {
          delete $tlpdb_pkgs{$r}; # ok, in both
        } else {
          # sometimes we like to include the hyphenation packages as
          # triggers in the tlpdb, for no particular reason. Let that be
          # ok, and only check for the skipped packages when making the
          # trigger list for an engine.format not in tlpdb.
          next if grep ($_ eq $r, @skip_recorded);
          next if $r =~ /hyphen-.*/;
          push (@recorded_only, $r);
        }
      }
      if (keys %tlpdb_pkgs) {
        # These packages are included as fmttriggers even though they
        # are not always used, usually to simplify maintenance of the
        # package lists. So don't worry about them if they are present.
        # See 00texlive.autopatterns.tlpsrc for more.
        # 
        # luaotfload doesn't show up in the recorder output,
        # unfortunately. It's used in the lualatex patterns.
        # 
        my @skip_tlpdb = qw(atbegshi atveryend everyshi
                            firstaid l3backend l3kernel l3packages latex
                            luaotfload
                            tex-ini-files unicode-data);
        my %skip_tlpdb; @skip_tlpdb{@skip_tlpdb} = 1; # make into hash
        
        for my $t (keys %tlpdb_pkgs) {
          delete $tlpdb_pkgs{$t} if exists $skip_tlpdb{$t};
        }
        if (keys %tlpdb_pkgs) {
          tlwarn ("$prg: $ef triggers only in tlpdb: "
                  . join (",", sort keys %tlpdb_pkgs)
                  . "\n");
          $bad_p = 1;
        }
      }
      if (@recorded_only) {
        tlwarn ("$prg: $ef triggers only in recorder: "
                . join (",", sort @recorded_only) . "\n");
        $bad_p = 1;
      }
      
      delete $fmttriggers->{$ef};

    } else {
      # not in tlpdb at all; in a few cases, that is expected.
      # Otherwise, complain and output needed fmttriggers directive.
      if ($ef =~ /$no_triggers_ok/) {
        delete $fmttriggers->{$ef}; # ok
      } else {
        tlwarn ("$prg: no fmttriggers in tlpdb: $ef\n"
                . "  fmttriggers=" . join (",", @recorded_pkgs) . "\n");
        $bad_p = 1;
      }
    }
  }
  
  for my $ef (sort keys %$fmttriggers) {
    my $trig = join (",", sort @{$fmttriggers->{$ef}});
    tlwarn ("$prg: format in tlpdb only: "
            . "$ef ($trig)\n");
    $bad_p = 1;
  }
  
  info ("Triggers checked: $all_pkgs (includes duplicates)\n");
  return $bad_p;
}


sub analyze_triggers {
  my ($fmttriggers) = @_;
  my %fmttriggers = %$fmttriggers;
  
  my %by_pkg;
  for my $ef (sort keys %fmttriggers) {
    next if $ef =~ /(aleph|lamed|jadetex|mex)$/; # these are taken care of
    my @pkgs = @{$fmttriggers{$ef}};
    #print "$ef => @pkgs\n";
    for my $p (@pkgs) {
      $by_pkg{$p} .= " $ef";
    }
  }
  
  for my $p (sort { ($by_pkg{$b} =~ tr/ //) 
                <=> ($by_pkg{$a} =~ tr/ //) } keys %by_pkg) {
    printf "%-14s %2d %s\n", $p, ($by_pkg{$p} =~ tr/ //), $by_pkg{$p};
  }
}

__END__

=head1 NAME

tl-check-fmttriggers - check that all needed packages trigger format rebuilds

=head1 SYNOPSIS

check-fmttriggers [I<option>]...

=head1 OPTIONS

=over 4

=item B<--analyze>

Instead of the usual dependency check described below, merely report the
list of I<engine>.I<format> which each package is a dependency for,
sorted by the number of I<engine>.I<format>s. This provides some
information for creating common dependencies, which can then be defined
as C<global_> tlpvars in C<00texlive.autopatterns.tlpsrc>, to increase
maintainability. (It does not actually try to figure out any tlpvars or
which packages to use them in, just reports counts.)

=item B<--fmtargs> I<str>

Pass I<str> to C<fmtutil>, overriding C<--all>; e.g., for debugging you
might want C<--fmtargs=--byfmt=tex> to build only C<tex.fmt>.  (Many
inconsistencies with the TLPDB will be reported, naturally.)

=item B<--fmtdir> I<dir>

Rebuild formats in I<dir>; default C</tmp/fmttriggers>.  This directory
is completely removed before rebuilding, so do not use any system
directory.

=item B<--no-rerecord>

Do not rebuild all formats to remake the recorder files; the default
(C<--rerecord>) is to do so.

=item B<--help>

Display this documentation and exit.

=item B<--version>

Display version information and exit.

=back

The standard options B<-q>, B<-v>, and B<-logfile>=I<file> are also
accepted; see the C<process_logging_options> function in
L<TeXLive::TLUtils> for details.  In particular, with B<-v> or higher,
the packages found to be needed for each I<engine.format> combination
will be reported.

=head1 DESCRIPTION

Compare the fmttriggers= listed in the tlpsrc files with the actual
dependencies found by running fmtutil -recorder and inspecting the
recorder (.fls) files.

=head1 AUTHORS AND COPYRIGHT

This script and its documentation were written for the TeX Live
distribution (L<http://tug.org/texlive>) and both are licensed under the
GNU General Public License Version 2 or later.

=cut

# Local Variables:
# perl-indent-level: 2
# tab-width: 2
# indent-tabs-mode: nil
# End:
# vim: sw=2 expandtab