diff options
Diffstat (limited to 'Master/tlpkg/TeXLive')
| -rw-r--r-- | Master/tlpkg/TeXLive/TLUtils.pm | 108 |
1 files changed, 108 insertions, 0 deletions
diff --git a/Master/tlpkg/TeXLive/TLUtils.pm b/Master/tlpkg/TeXLive/TLUtils.pm index 777e4d97e71..97f35efb9ba 100644 --- a/Master/tlpkg/TeXLive/TLUtils.pm +++ b/Master/tlpkg/TeXLive/TLUtils.pm @@ -60,6 +60,7 @@ C<TeXLive::TLUtils> -- utilities used in the TeX Live infrastructure TeXLive::TLUtils::download_file($path, $destination [, $progs ]); TeXLive::TLUtils::setup_programs($bindir, $platform); TeXLive::TLUtils::tlcmp($file, $file); + TeXLive::TLUtils::nulldev(); =head2 Installer Functions @@ -97,6 +98,7 @@ C<TeXLive::TLUtils> -- utilities used in the TeX Live infrastructure TeXLive::TLUtils::compare_tlpobjs($tlpA, $tlpB); TeXLive::TLUtils::compare_tlpdbs($tlpdbA, $tlpdbB); TeXLive::TLUtils::report_tlpdb_differences(\%ret); + TeXLive::TLUtils::mktexupd(); =head1 DESCRIPTION @@ -174,6 +176,8 @@ BEGIN { &compare_tlpdbs &report_tlpdb_differences &setup_persistent_downloads + &mktexupd + &nulldev ); @EXPORT = qw(setup_programs download_file process_logging_options tldie tlwarn info log debug ddebug dddebug debug_hash @@ -2328,6 +2332,16 @@ sub _download_file } } +=item C<nulldev ()> + +Return C</dev/null> on Unix and C<nul> on Windows. + +=cut + +sub nulldev { + return (&win32)? 'nul' : '/dev/null'; +} + =back @@ -3522,6 +3536,100 @@ sub parse_line { return(@pieces); } +=item C<mktexupd ()> + +Append entries to C<ls-R> files. Usage example: + + my $updLSR=&mktexupd(); + $updLSR->{mustexist}(1); + $updLSR->{add}(file1); + $updLSR->{add}(file2); + $updLSR->{add}(file3); + $updLSR->{exec}(); + +The first line creates a new object. Only one such object should be +created in a program in order to avoid duplicate entries in C<ls-R> files. + +C<add> pushes a filename or a list of filenames to a hash encapsulated +in a closure. Filenames must be specified with the full (absolute) path. +Duplicate entries are ignored. + +C<exec> checks for each component of C<$TEXMFDBS> whether there are files +in the hash which have to be appended to the corresponding C<ls-R> files +and eventually updates the corresponding C<ls-R> files. Files which are +in directories not stated in C<$TEXMFDBS> are silently ignored. + +If the flag C<mustexist> is set, C<exec> aborts with an error message +if a file supposed to be appended to an C<ls-R> file doesn't exist physically +on the file system. This option was added for compatibility with the +C<mktexupd> shell script. This option shouldn't be enabled in scripts, +except for testing, because it degrades performance on non-cached file +systems. + +=cut + +sub mktexupd { + my %files; + my $mustexist=0; + + my $hash={ + "add" => sub { + foreach my $file (@_) { + $file =~ s|\\|/|g; + $files{$file}=1; + } + }, + # "reset" => sub { + # %files=(); + # }, + "mustexist" => sub { + $mustexist=shift; + }, + "exec" => sub { + # check whether files exist + if ($mustexist) { + foreach my $file (keys %files) { + die "File \"$file\" doesn't exist.\n" if (! -f $file); + } + } + my $delim= (&win32)? ';' : ':'; + my $TEXMFDBS; + chomp($TEXMFDBS=`kpsewhich --show-path="ls-R"`); + + my @texmfdbs=split ($delim, "$TEXMFDBS"); + my %dbs; + + foreach my $path (keys %files) { + foreach my $db (@texmfdbs) { + $db=substr($db, -1) if ($db=~m|/$|); # strip leading / + if (substr($path, 0, length("$db/")) eq "$db/") { + # we appended a / because otherwise "texmf" is recognized as a + # substring of "texmf-dist". + my $path='./' . substr($path, length("$db/")); + my ($dir, $file); + $_=$path; + ($dir, $file) = m|(.*)/(.*)|; + $dbs{$db}{$dir}{$file}=1; + } + } + } + foreach my $db (keys %dbs) { + if (! -f "$db" || ! -w "$db/ls-R") { + &mkdirhier ($db); + } + open LSR, ">>$db/ls-R"; + foreach my $dir (keys %{$dbs{$db}}) { + print LSR "\n$dir:\n"; + foreach my $file (keys %{$dbs{$db}{$dir}}) { + print LSR "$file\n"; + } + } + close LSR; + } + } + }; + return $hash; +} =back |