#!/usr/bin/env perl # # ToDos/unsolved problems: # * collision of symbol links # * texmf.cnf (path settings, variables) # * aliases # * binaries, libraries # use strict; $^W=1; my $prj = 'mkjobtexmf'; my $version = '0.8'; my $date = '2011/11/10'; my $author = 'Heiko Oberdiek'; my $copyright = "Copyright 2007, 2008, 2011 $author"; my $cmd_tex = 'pdflatex'; my $cmd_kpsewhich = 'kpsewhich'; my $cmd_texhash = 'texhash'; my $cmd_strace = 'strace'; my $ext_tex = '.tex'; my $ext_recorder = '.fls'; my $ext_strace = '.strace'; my $ext_mkjobtexmf = '.mjt'; my $jobname = ''; my $texname = ''; my $destdir = ''; my @args = (); my @texopt = (); my $verbose = 0; my $output = 0; my $strace = 0; my $copy = 0; my $flat = 0; my $texhash = 1; my $needs_texhash = 0; my @texmf; my @exclude_ext; my %files; my %links; my %flat_ignore = ( 'ls-R' => '', 'aliases' => '', ); my $win = 0; $win = 1 if $^O =~ /MSWin/i; my $title = "\U$prj\E $date v$version, $copyright\n"; sub die_error ($) { my $msg = shift; die "!!! Error: $msg!\n"; } sub warning ($) { my $msg = shift; print "!!! Warning: $msg!\n"; } sub verbose (@) { my @msg = @_; print "* @msg\n" if $verbose; } sub value ($) { my $value = $_[0]; "[$value]"; } sub die_usage { my $msg = $_[0]; pod2usage( -exitstatus => 2, -msg => "\n==> $msg!\n"); } use Getopt::Long; use Pod::Usage; my $man = 0; my $help = 0; my $opt_version = 0; GetOptions( 'jobname=s' => \$jobname, 'texname=s' => \$texname, 'texopt=s' => \@texopt, 'destdir=s' => \$destdir, 'cmd-tex=s' => \$cmd_tex, 'cmd-kpsewhich=s' => \$cmd_kpsewhich, 'cmd-texhash=s' => \$cmd_texhash, 'cmd-strace=s' => \$cmd_strace, 'strace' => \$strace, 'copy' => \$copy, 'flat' => \$flat, 'texhash!' => \$texhash, 'exclude-ext=s' => \@exclude_ext, 'verbose' => \$verbose, 'output' => \$output, 'help|?' => \$help, 'man' => \$man, 'version' => \$opt_version, ) or die_usage('Unknown option'); if ($help) { print $title; pod2usage(1); } pod2usage(-exitstatus => 0, -verbose => 2) if $man; if ($opt_version) { print "$prj $date v$version\n"; exit(0); } print $title; if (@ARGV > 0) { $strace = 1; $texname = ''; my @args = @ARGV; } $jobname or die_usage('Missing jobname'); $texname = "$jobname$ext_tex" unless $texname; $destdir = "$jobname$ext_mkjobtexmf" unless $destdir; verbose "jobname: " . value $jobname; verbose "texname: " . value $texname if $texname; verbose "command: " . value "@args" if @args; verbose "destdir: " . value $destdir; verbose "system: ". value $^O; @exclude_ext = split(/,/, join(',', @exclude_ext)); foreach my $ext (@exclude_ext) { verbose "exclude-ext: " . value $ext; } if (!$copy) { my $symlink_exists = eval { symlink('', ''); 1 }; if ($symlink_exists) { verbose "symbolic linking: supported"; } else { $copy = 1; verbose "symbolic linking: unsupported"; } } my $umask = umask; if (defined($umask)) { verbose "umask: " . sprintf("%04o", $umask); } else { $umask = 0; verbose "umask: unsupported"; } if ($copy) { use File::Copy; } if ($flat) { use File::Basename; } sub check_child_error () { if ($? != 0) { if ($? == -1) { die_error "Failed to execute: $!"; } elsif ($? & 127) { die_error sprintf "Child died with signal %d, %s coredump", ($? & 127), ($? & 128) ? 'with' : 'without'; } else { die_error sprintf "Child exited with value %d", $? >> 8; } } verbose "child exit: ok"; } sub run_generic (@) { my @args = @_; my $cmd = $_[0]; verbose "exec: " . value "@args"; print '>' x 79, "\n"; system $cmd @args; print '<' x 79, "\n"; check_child_error; } sub run_tex { if ($strace) { my @run_args; if (@args) { @run_args = @args; } else { @run_args = ( $cmd_tex, '-interaction=nonstopmode', @texopt, $texname ); } run_generic( $cmd_strace, '-f', '-e', 'trace=open,access', # trace=file '-o', "$jobname$ext_strace", @run_args ) } else { run_generic( $cmd_tex, '-recorder', "-jobname=$jobname", '-interaction=nonstopmode', @texopt, $texname ); } } sub run_texhash { return unless $texhash; return if $flat; if ($needs_texhash) { my $cmd_version = "$cmd_texhash --version"; verbose "exec: $cmd_version"; print '>' x 79, "\n"; my @lines = `$cmd_version`; print @lines if $verbose; print '<' x 79, "\n"; if ($? != 0) { if ($? == -1) { verbose "Execution failed: $!"; } elsif ($? & 127) { verbose sprintf "Execution died with signal %d, %s coredump", ($? & 127), ($? & 128) ? 'with' : 'without'; } else { verbose sprintf "Execution failed with error code: %d", $? >> 8; } } else { my $catch = "@lines"; if ($catch =~ /(kpathsea|mktexlsr)/i) { run_generic( $cmd_texhash, "$destdir/texmf" ); } else{ verbose 'Unsupported port of texhax found.'; } } } else { verbose("Run of texhash skipped, no files added."); } } use Cwd 'abs_path', 'getcwd'; my $pwd = getcwd; verbose "pwd: " . value($pwd); sub get_texmf_trees () { return if $flat; my $cmdline = "$cmd_kpsewhich -expand-path='\$TEXMF'"; $cmdline = "$cmd_kpsewhich -expand-path=\$TEXMF" if $win; verbose "exec: " . value($cmdline); my $str = `$cmdline`; check_child_error; $str =~ s/[\r\n]+$//; if ($win) { @texmf = split ';', $str; } else { @texmf = split ':', $str; } my %texmf; foreach my $texmf (@texmf) { $texmf{$texmf} = ''; $texmf{abs_path($texmf)} = ''; } @texmf = sort keys %texmf; if (@texmf == 0 and $win) { my $cmdline = "$cmd_kpsewhich --show-path=tfm"; verbose "exec: " . value($cmdline); my $str = `$cmdline`; check_child_error; $str =~ s/[\n\r]+$//; foreach my $texmf (split ';', $str) { if ($texmf =~ m|^(.*)/fonts/tfm/*$|) { push @texmf, $1; } } } if ($verbose) { if (@texmf) { map { verbose 'texmf: ' . value($_) } @texmf; } else { verbose 'texmf: none'; } } } sub add_file ($) { my $file = shift; my $add = 1; foreach my $ext (@exclude_ext) { my $ext = ".$ext"; my $len_ext = length $ext; my $len_file = length $file; if ($len_file >= $len_ext) { if ($ext eq substr $file, $len_file - $len_ext) { $add = 0; verbose "excluded: " . value($file); last; } } } $files{$file} = '' if $add; } sub analyze_recorder { my $file_rec = $jobname . ($strace ? $ext_strace : $ext_recorder); verbose 'File with recorded file names: ' . value($file_rec); open(IN, '<', $file_rec) or die_error "Cannot open `$file_rec'"; if ($strace) { while () { chomp; next if /\)\s+= -\d/; # -1 ENOENT, ... next if /\WO_DIRECTORY\W/; # skip directories my $type = 'INPUT'; if ($output) { $type = 'OUTPUT' if /\WO_WRONLY\W/; } else { next if /\WO_WRONLY\W/; } /^\d+\s+\w+\(\"([^"]+)\",/ or warning "Unknown entry `$_'"; my $file = $1; add_file $file; } } else { while () { chomp; next if /^PWD /; next if not $output and /^OUTPUT /; /^(INPUT|OUTPUT) (.*)$/ or warning "Unknown entry `$_'"; my $type = $1; my $file = $2; add_file $file; } } close(IN); } sub map_files { if ($flat) { map_files_flat(); } else { map_files_texmf(); } } sub map_files_flat { my %abs_files; my %names; my %clashes; foreach my $file (keys %files) { $abs_files{abs_path($file)} = ''; } foreach my $file (keys %abs_files) { my $name = basename($file); next if exists $flat_ignore{$name}; if (defined($names{$name})) { push @{$names{$name}}, $file; $clashes{$name} = ''; } else { my @a = ($file); $names{$name} = \@a; } } foreach my $name (sort keys %clashes) { print "* file name clash for " . value($name) . "\n"; my @a = @{$names{$name}}; foreach my $file (@a) { print " " . value($file) . "\n"; } } foreach my $name (sort keys %names) { my $file = @{$names{$name}}[0]; my $clash = $clashes{$name} ? ' (clash)' : ''; verbose value($name) . ' => ' . value($file) . $clash; $links{$name} = $file; } } sub map_files_texmf { my @failed; my $pwd_dir = "$pwd/"; my $pwd_len = length $pwd_dir; foreach my $file (sort keys %files) { verbose "file: " . value($file); my $abs_file = abs_path($file); my $found = ''; if ($pwd_dir eq substr $file, 0, $pwd_len) { $found = substr $file, $pwd_len; } if (not $found) { foreach (@texmf) { my $texmf = "$_/"; my $len = length($texmf); my $str = substr $file, 0, $len; if ($texmf eq $str) { $found = 'texmf/' . substr $file, $len; if ($found =~ /(^|\/)\.\.\//) { $found = ''; } } last if $found; my $str = substr $abs_file, 0, $len; if ($texmf eq $str) { $found = 'texmf/' . substr $abs_file, $len; last; } } } if (not($found)) { if ($file =~ /(^|\/)\.\.\// or $file =~ /^\//) { push @failed, $file; } else { $found = $file; } } if ($found) { $links{$found} = abs_path($file); } } if ($verbose) { foreach (sort keys %links) { verbose value($_) . ' => ' . value($links{$_}); } } foreach (@failed) { print "!!! Failed: " . value($_) . "\n"; } } sub make_dirs ($) { my $path = shift; my @elems = split /\/+/, $path; if (@elems <= 1) { return 1; } pop @elems; my $dir = ''; foreach my $elem (@elems) { $dir .= '/' if $dir; $dir .= $elem; next if -d $dir; if (mkdir $dir) { verbose 'mkdir: ' . value($dir); next; } return 0; } return 1; } sub make_links { foreach my $key (sort keys %links) { my $source = $links{$key}; my $dest = "$destdir/$key"; my $result_mkdir = make_dirs $dest; if (not $result_mkdir) { if ($key =~ s|^([A-Za-z]):/|$1/|) { $dest = "$destdir/$key"; $result_mkdir = make_dirs $dest; } if (not $result_mkdir) { die_error("Cannot create directory `$dest'"); } } if (-e $dest) { my $type = ''; if (-l $dest) { $type .= 'link'; } elsif (-f $dest) { $type = 'file'; } elsif (-d $dest) { $type = 'directory'; } elsif (-b $dest) { $type = 'block device'; } elsif (-c $dest) { $type = 'character device'; } elsif (-p $dest) { $type = 'pipe'; } elsif (-S $dest) { $type = 'socket'; } elsif (-t $dest) { $type = 'tty'; } $type = " ($type)" if $type; verbose "destination$type exists: " . value($dest); next; } $needs_texhash = 1; do_link_copy($source, $dest); } } sub do_link_copy { my $source = shift; my $dest = shift; my $success = 0; if ($copy) { if (copy($source, $dest) == 1) { $success = 1; my ($source_mode, $source_atime, $source_mtime) = (stat($source))[2, 8, 9]; my ($dest_mode, $dest_atime, $dest_mtime) = (stat($dest))[2, 8, 9]; # preserve executable permissions if necessary my $new_dest_mode = $dest_mode | (($source_mode & 0111) & ~$umask); if ($new_dest_mode != $dest_mode) { if (chmod($new_dest_mode, $dest) < 1) { print "!!! Setting executive mode failed: " . value($dest) . "\n"; } } # preserve file times if ($source_atime != $dest_atime || $source_mtime != $dest_mtime) { if (utime($source_atime, $source_mtime, $dest) < 1) { print "!!! Setting file times failed: " . value($dest) . "\n"; } } } } else { if (symlink($source, $dest) == 1) { $success = 1; } } if ($success == 0) { my $method = $copy ? 'Copying' : 'Symbolic linking'; print "!!! $method failed:\n " . value($dest) . ' => ' . value($source) . "\n"; } } run_tex; get_texmf_trees; analyze_recorder; map_files; make_links; run_texhash; 1; __DATA__ =head1 NAME mkjobtexmf -- Generate a texmf tree for a particular job =head1 VERSION 2011-11-10 v0.8 =head1 SYNOPSIS The progam B runs a program and tries to find the used file names. Two methods are available, option C<-recorder> of TeX (Web2C) or the program B. Then it generates a directory with a texmf tree. It checks the found files and tries sort them in this texmf tree. It can be used for archiving purposes or to speed up following TeX runs. mkjobtexmf [options] This runs TeX that can be configured by options. Both methods for getting the used file names are available. mkjobtexmf [options] -- [args] The latter form runs program I with arguments I instead of TeX. As method only program B is available. Options: --jobname Name of the job (mandatory). Usually this is the TeX file without extension --texname Input file for TeX. Default is the job name with extension '.tex' --texopt