| Current File : //usr/share/texlive/texmf-dist/scripts/texlive/mktexlsr.pl |
#!/usr/bin/perl
#
# Copyright 2015 Norbert Preining
#
# This file is licensed under the GNU General Public License version 2
# or any later version.
#
# History:
# Original shell script (C) 1994 Thomas Esser (as texhash), Public domain.
#
=pod
=head1 NAME
C<mktexlsr> and C<TeX::LSR> - handle TeX's Kpathsea file name database C<ls-R>
=head1 SYNOPSIS
mktexlsr [I<option>]... [I<dir>]...
texhash [I<option>]... [I<dir>]...
=head1 DESCRIPTION
B<mktexlsr> rebuilds the C<ls-R> filename databases used by TeX.
If one or more arguments I<dir> are given, these are used as the
directories in which to build C<ls-R>. Else all directories in the
search path for C<ls-R> files (i.e., \$TEXMFDBS) are used.
B<texhash> is a synonym for B<mktexlsr>; there are no differences in
behavior based on the name.
=head1 OPTIONS
=over 4
=item B<--dry-run>, B<-n>
do not actually update anything
=item B<--help>, B<-h>
display this help and exit
=item B<--nofollow>
do not follow symlinks (default to follow)
=item B<--output[=]>I<NAME>, B<-o> I<NAME>
if (and only if) exactly one I<dir> is given, output C<ls-R> file to I<NAME>
=item B<--quiet>, B<-q>, B<--silent>
cancel --verbose
=item B<--verbose>
explain what is being done, defaults to on when output is connected
to a terminal.
=item B<--version>, B<-v>
output version information and exit
=back
=cut
use strict;
$^W = 1;
package mktexlsr;
my $ismain;
BEGIN {
$^W = 1;
$ismain = (__FILE__ eq $0);
}
# for future inclusion in TeX Live svn:
my $svnid = '$Id: mktexlsr.pl 38001 2015-07-30 01:25:25Z preining $';
my $lastchdate = '$Date: 2015-07-30 03:25:25 +0200 (Thu, 30 Jul 2015) $';
$lastchdate =~ s/^\$Date:\s*//;
$lastchdate =~ s/ \(.*$//;
my $svnrev = '$Revision: 38001 $';
$svnrev =~ s/^\$Revision:\s*//;
$svnrev =~ s/\s*\$$//;
my $version = "revision $svnrev ($lastchdate)";
use Getopt::Long;
use File::Basename;
use Pod::Usage;
my $opt_dryrun = 0;
my $opt_help = 0;
my $opt_verbose = (-t STDIN); # test whether connected to a terminal
my $opt_version = 0;
my $opt_output;
my $opt_sort = 0; # for debugging sort output
my $opt_follow = 1; # follow links - check whether they are dirs or not
(my $prg = basename($0)) =~ s/\.pl$//;
my $lsrmagic =
'% ls-R -- filename database for kpathsea; do not change this line.';
my $oldlsrmagic =
'% ls-R -- maintained by MakeTeXls-R; do not change this line.';
&main() if $ismain;
#################################################################
#
# usage as module
#
package TeX::LSR;
use Cwd;
use File::Spec::Functions;
use File::Find;
=pod
=head1 Perl Module Usage
This file also provides a module C<TeX::LSR> that can be used
as programmatic interface to the C<ls-R> files. Available
methods are:
$lsr = new TeX::LSR( root => $texmftree );
$lsr->loadtree();
$lsr->loadfile();
$lsr->write( [filename => $fn, sort => $do_sort ] );
$lsr->addfiles ( @files );
=head1 Methods
=over 4
=item C<< TeX::LSR->new( [root => "$path"] ) >>
create a new C<LSR> object related to the tree in C<$path>,
without loading any further information. Returns 1 on success
and 0 on failure.
The tree is represented as hash, where each file and directory
acts as key, with files having 1 as value, and directories
their recursive representation hash as value.
=cut
sub new {
my $class = shift;
my %params = @_;
my $self = {
root => $params{'root'},
filename => '', # to accomodated both ls-r and ls-R
is_loaded => 0,
tree => { }
};
bless $self, $class;
return $self;
}
=pod
=item C<< $lsr->loadtree() >>
Loads the file information from the actual tree by traversing the
whole directory recursively.
Common VCS files and directories are ignored (C<.git>, C<.svn>, C<.hg>,
C<.bzr>, C<CVS>). See above for the representation.
Returns 1 on success, 0 on failure.
=cut
# returns 1 on success, 0 on failure
sub loadtree {
my $self = shift;
return 0 if (!defined($self->{'root'}));
return 0 if (! -d $self->{'root'});
my $tree;
build_tree($tree, $self->{'root'});
$self->{'tree'} = $tree->{$self->{'root'}};
$self->{'is_loaded'} = 1;
return 1;
# code adapted from
# http://www.perlmonks.org/?node=How%20to%20map%20a%20directory%20tree%20to%20a%20perl%20hash%20tree
sub build_tree {
my $node = $_[0] = {};
my @s;
# go through all dirs recursively (File::Find::find),
# links are dereferenced according to $opt_follow
# add an entry of 1 if it is not a directory, otherwise
# create an empty hash as argument
File::Find::find( { follow_skip => 2, follow_fast => $opt_follow, wanted => sub {
$node = (pop @s)->[1] while (@s && $File::Find::dir ne $s[-1][0]);
# ignore VCS
return if ($_ eq ".git");
return if ($_ eq ".svn");
return if ($_ eq ".hg");
return if ($_ eq ".bzr");
return if ($_ eq "CVS");
return $node->{$_} = 1 if (! -d);
push (@s, [ $File::Find::name, $node ]);
$node = $node->{$_} = {};
}}, $_[1]);
$_[0]{$_[1]} = delete $_[0]{'.'};
}
}
# set the `filename' member; check ls-R first, then ls-r.
=pod C<< $lsr->setup_filename() >>
We support file names C<ls-R> and C<ls-r>, but create as C<ls-R>.
Internal function, should not be used outside.
=cut
sub setup_filename {
my $self = shift;
if (!$self->{'filename'}) {
if (-r $self->{'root'} . "/ls-R") {
$self->{'filename'} = 'ls-R';
} elsif (-r $self->{'root'} . "/ls-r") {
$self->{'filename'} = 'ls-r';
} else {
$self->{'filename'} = 'ls-R';
}
}
return 1;
}
=pod
=item C<< $lsr->load() >>
Loads the file information either from the C<lsr-R> file, if
present, otherwise from the actual tree.
Returns 1 on success, 0 on failure.
=cut
sub load {
my $self = shift;
return 0 if (!defined($self->{'root'}));
return 0 if (! -d $self->{'root'});
$self->setup_filename();
if (-r $self->{'filename'}) {
return $self->loadfile();
} else {
return $self->loadtree();
}
}
=pod
=item C<< $lsr->loadfile() >>
Loads the file information from the C<ls-R> file. Checks for the
presence of the magic header as first line.
Returns 1 on success, 0 on failure.
=cut
# read given file; return 0 if failure, 1 if ok.
sub loadfile {
my $self = shift;
return 0 if (!defined($self->{'root'}));
return 0 if (! -d $self->{'root'});
$self->setup_filename();
my $lsrfile = catfile($self->{'root'}, $self->{'filename'});
return 0 if (! -r $lsrfile);
open (LSR, "<", $lsrfile)
|| die "$prg: readable but not openable $lsrfile??: $!";
# check first line for the magic header
chomp (my $fl = <LSR>);
if (($fl eq $lsrmagic) || ($fl eq $oldlsrmagic)) {
my %tree;
my $t;
for my $l (<LSR>) {
chomp($l);
next if ($l =~ m!^\s*$!);
next if ($l =~ m!^\./:!);
if ($l =~ m!^(.*):!) {
$t = \%tree;
my @a = split(/\//, $1);
for (@a) {
$t->{$_} = {} if (!defined($t->{$_}) || ($t->{$_} == 1));
$t = $t->{$_};
}
} else {
$t->{$l} = 1;
}
}
$self->{'tree'} = $tree{'.'};
}
close(LSR);
$self->{'is_loaded'} = 1;
return 1;
}
#
=pod
=item C<< $lsr->write( [ filename => "$fn", sort => $val) >>
Writes out the C<ls-R> file, either to the default file name, or
to C<$fn> if given. Entries within a directory are not sorted
(not necessary), but sorting can be enforced by passing a true
value to C<sort>.
Returns 1 on success, 0 on failure (and give warning).
=cut
sub write {
my $self = shift;
my %params = @_;
my $fn;
my $dosort = 0;
$fn = $params{'filename'} if $params{'filename'};
$dosort = $params{'sort'};
if (!defined($self->{'root'})) {
warn "TeX::LSR: root undefined, cannot write.\n";
return 0;
}
if ($self->{'is_loaded'} == 0) {
warn "TeX::LSR: tree not loaded, cannot write: $self->{root}\n";
return 0;
}
if (!defined($fn)) {
$self->setup_filename();
$fn = catfile($self->{'root'}, $self->{'filename'});
}
if (-e $fn && ! -w $fn) {
warn "TeX::LSR: ls-R file not writable, skipping: $fn\n";
return 0;
}
open (LSR, ">$fn") || die "TeX::LSR writable but cannot open??; $!";
print LSR "$lsrmagic\n\n";
print LSR "./:\n"; # hardwired ./ for top-level files
do_entry($self->{'tree'}, ".", $dosort);
close LSR;
return 1;
sub do_entry {
my ($t, $n, $sortit) = @_;
print LSR "$n:\n";
my @sd;
for my $st ($sortit ? sort(keys %$t) : keys %$t) {
push (@sd, $st) if (ref($t->{$st}) eq 'HASH');
print LSR "$st\n";
}
print LSR "\n";
for my $st ($sortit ? sort @sd : @sd) {
do_entry($t->{$st}, "$n/$st", $sortit);
}
}
}
=pod
=item C<< $lsr->addfiles( @files ) >>
Adds the files from C<@files> to the C<ls-R> tree. If a file
is relative, it is added relative the the root of the tree. If
it is absolute and the root agrees with a prefix of the file name,
add the remaining part. If they disagree, throw an error.
Returns 1 on success, 0 on failure (and give warning).
=cut
sub addfiles {
my ($self, @files) = @_;
if ($self->{'is_loaded'} == 0) {
warn "TeX::LSR: tree not loaded, cannot add files: $self->{root}\n";
return 0;
}
# if we are passed an absolute file name, check whether the prefix
# coincides with the root of the texmf tree, and add the relative
# file name, otherwise bail out
for my $f (@files) {
if (file_name_is_absolute($f)) {
my $cf = canonpath($f);
my $cr = canonpath($self->root);
if ($cf =~ m/^$cr([\\\/])?(.*)$/) {
$f = $2;
} else {
warn("File $f does not reside in $self->root.");
return 0;
}
}
my $t = $self->{'tree'};
my @a = split(/[\\\/]/, $f);
my $fn = pop @a;
for (@a) {
$t->{$_} = {} if (!defined($t->{$_}) || ($t->{$_} == 1));
$t = $t->{$_};
}
$t->{$fn} = 1;
}
return 1;
}
=pod
=back
=cut
##########################################################
#
# package TeX::Update
#
# based on the mktexupd function in TLUtils
package TeX::Update;
=pod
=head1 TeX ls-R Update module
This file also provides a module C<TeX::Update> that can be used
to add files to their respective trees.
Available methods are:
$upd = new TeX::Update();
$upd->mustexist(1);
$upd->add(file1, [file2]);
$upd->add(file3);
$upd->exec();
$upd->reset();
=head1 Methods
=over 4
=item C<< TeX::Update->new() >>
Create a new TeX::Update object.
=cut
sub new {
my $class = shift;
my $self = {
files => {},
mustexist => 0,
};
bless $self, $class;
return $self;
}
=pod
=item C<< $upd->add( @files ) >>
Adds a list of files without any checks done.
Returns 1.
=cut
sub add {
my $self = shift;
foreach my $file (@_) {
$file =~ s|\\|/|g;
$self->{'files'}{$file} = 1;
}
return 1;
}
=pod
=item C<< $upd->reset( ) >>
Removes all references to added files. Returns 1.
=cut
sub reset {
my $self = shift;
$self->{'files'} = {};
return 1;
}
=pod
=item C<< $upd->mustexist( [ $newvalue ] ) >>
Wit C<$newvalue> given, sets the mustexist propery. In both
cases returns the current value afterwards.
=cut
sub mustexist {
my $self = shift;
if (@_) { $self->{'mustexist'} = shift }
return $self->{'mustexist'};
}
=pod
=item C<< $upd->exec( ) >>
Goes through all added files, determines whether the files is contained
in a tree that contains a ls-R files. If yes, adds the files there.
If the mustexist property is set, bails out in case a file does not
exists.
Returns 1 on success, 0 on failure (and give warning).
=cut
sub exec {
my $self = shift;
# first check whether all files exist
if ($self->{'mustexist'}) {
for my $f (keys %{$self->{'files'}}) {
die "File \'$f\' doesn't exist.\n" if (! -f $f);
}
}
my @texmfdbs = mktexlsr::find_default_lsr_trees();
# filter files into the respective trees
my %dbs;
for my $p (keys %{$self->{'files'}}) {
for my $db (@texmfdbs) {
# remove terminal / if present
$db =~ s|/$||;
# lowercase for Windows
$db = lc($db) if mktexlsr::win32();
# search path
my $used_path = mktexlsr::win32() ? lc($p) : $p;
# check whether $p/$used_path is a file in $db
# we append a / to make sure that subdirs do not overlap (texmf/-dist)
if ( substr($used_path, 0, length("$db/")) eq "$db/" ) {
# fie $p/$used_path resides in the current $db
# strip initial $db/
my $filepart = substr($used_path, length("$db/"));
$dbs{$db}{$filepart} = 1;
last; # of the db loops!
}
}
}
#
# now do the actual work
for my $db (keys %dbs) {
if (! -d $db) {
if (! mktexlsr::mkdirhier($db) ) {
die "Cannot create directory $db: $!";
}
}
my $lsr = new TeX::LSR(root => $db);
# load either from ls-R or tree
$lsr->load() || die "Cannot load ls-R in $db.";
$lsr->addfiles(keys %{$dbs{$db}}) || die "Cannot add some file to $db.";
$lsr->write() || die "Cannot write ls-R in $db.";
}
return 1;
}
=pod
=back
=cut
#############################################################
#
# back to main mktexlsr package/program.
package mktexlsr;
sub main {
GetOptions("dry-run|n" => \$opt_dryrun,
"help|h" => \$opt_help,
"verbose!" => \$opt_verbose,
"quiet|q|silent" => sub { $opt_verbose = 0 },
"sort" => \$opt_sort,
"output|o=s" => \$opt_output,
"follow!" => \$opt_follow,
"version|v" => \$opt_version)
|| pod2usage(2);
pod2usage(-verbose => 2, -exitval => 0) if $opt_help;
if ($opt_version) {
print version();
exit (0);
}
if ($opt_output && $#ARGV != 0) {
# we only support --output with only one tree as argument
die "$prg: with --output, exactly one tree must be given: @ARGV\n";
}
for my $t (find_lsr_trees()) {
my $lsr = new TeX::LSR(root => $t);
print "$prg: Updating $t...\n" if $opt_verbose;
if ($lsr->loadtree()) {
if ($opt_dryrun) {
print "$prg: Dry run, not writing files.\n" if $opt_dryrun;
} elsif ($opt_output) {
#warn "writing to $opt_output\n";
$lsr->write(filename => $opt_output, sort => $opt_sort);
} else {
#warn "writing with sort=$opt_sort\n";
$lsr->write(sort => $opt_sort);
}
} else {
warn "$prg: cannot read files, skipping: $t\n";
}
}
print "$prg: Done.\n" if $opt_verbose;
}
sub find_default_lsr_trees {
# the shellfile used kpsewhich --show-path=ls-R | tr : '\n'
# seems to be simpler than using -var-value TEXMFDBS and
# fixing the return value
my $delim = win32() ? ';' : ':';
chomp( my $t = `kpsewhich -show-path=ls-R` );
my @texmfdbs = split($delim, $t);
return @texmfdbs;
}
sub find_lsr_trees {
my %lsrs;
my @candidates = @ARGV;
if (!@candidates) {
@candidates = find_default_lsr_trees();
}
for my $t (@candidates) {
my $ret;
eval {$ret = Cwd::abs_path($t);}; # eval needed for w32
if ($ret) {
$lsrs{$ret} = 1;
} else {
# ignored, we simply skip directories that don't exist
}
}
return sort(keys %lsrs);
}
sub version {
my $ret = sprintf "%s version %s\n", $prg, $version;
return $ret;
}
sub win32 {
return ( ($^O =~ /^MSWin/i) ? 1 : 0 );
}
# copied from TLUtils.pm
sub mkdirhier {
my ($tree,$mode) = @_;
return if (-d "$tree");
my $subdir = "";
# win32 is special as usual: we need to separate //servername/ part
# from the UNC path, since (! -d //servername/) tests true
$subdir = $& if ( win32() && ($tree =~ s!^//[^/]+/!!) );
my @dirs = split (/\//, $tree);
for my $dir (@dirs) {
$subdir .= "$dir/";
if (! -d $subdir) {
if (defined $mode) {
mkdir ($subdir, $mode)
|| die "$0: mkdir($subdir,$mode) failed, goodbye: $!\n";
} else {
mkdir ($subdir) || die "$0: mkdir($subdir) failed, goodbye: $!\n";
}
}
}
}
# for module loading!
1;
=pod
=head1 FURTHER INFORMATION AND BUG REPORTING
For more information, see the `Filename database' section of
Kpathsea manual available at http://tug.org/kpathsea.
Report bugs to: tex-k@tug.org
=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:set tabstop=2 expandtab: #