texlive[73062] Build/source/texk/texlive/linked_scripts:

commits+karl at tug.org commits+karl at tug.org
Sat Dec 7 18:56:53 CET 2024


Revision: 73062
          https://tug.org/svn/texlive?view=revision&revision=73062
Author:   karl
Date:     2024-12-07 18:56:53 +0100 (Sat, 07 Dec 2024)
Log Message:
-----------
linked_scripts make vs. files consistency

Modified Paths:
--------------
    trunk/Build/source/texk/texlive/linked_scripts/ChangeLog
    trunk/Build/source/texk/texlive/linked_scripts/Makefile.am
    trunk/Build/source/texk/texlive/linked_scripts/Makefile.in

Removed Paths:
-------------
    trunk/Build/source/texk/texlive/linked_scripts/texlive/extractbb.lua
    trunk/Build/source/texk/texlive/linked_scripts/texlive/mktexlsr.pl

Modified: trunk/Build/source/texk/texlive/linked_scripts/ChangeLog
===================================================================
--- trunk/Build/source/texk/texlive/linked_scripts/ChangeLog	2024-12-07 00:43:00 UTC (rev 73061)
+++ trunk/Build/source/texk/texlive/linked_scripts/ChangeLog	2024-12-07 17:56:53 UTC (rev 73062)
@@ -1,3 +1,11 @@
+2024-12-07  Karl Berry  <karl at freefriends.org>
+
+	* Makefile.am (check-make-vs-files): new target to compare
+	list in Makefile[.am] with files on filesystem.
+	* texlive/extractbb.lua,
+	* texlive/mktexlsr.pl: remove, not listed.
+	tldistro thread around 4 Jul 2024 16:27:36.
+
 2024-11-24  Karl Berry  <karl at tug.org>
 
 	* Makefile.am (texmf_other_scripts): no more texlive/extractbb.lua.

Modified: trunk/Build/source/texk/texlive/linked_scripts/Makefile.am
===================================================================
--- trunk/Build/source/texk/texlive/linked_scripts/Makefile.am	2024-12-07 00:43:00 UTC (rev 73061)
+++ trunk/Build/source/texk/texlive/linked_scripts/Makefile.am	2024-12-07 17:56:53 UTC (rev 73062)
@@ -363,8 +363,9 @@
 .PHONY: install-links
 install-links:
 
-## For WIN32 (MinGW or native) we have wrapper binaries with .exe,
-## for Cygwin and Unix we have symlinks without .exe.
+# 

+# For WIN32 (MinGW or native) we have wrapper binaries with .exe,
+# for Cygwin and Unix we have symlinks without .exe.
 if WIN32
 WINEXT = $(EXEEXT)
 endif WIN32
@@ -387,9 +388,21 @@
 	else :; fi
 endif !WIN32
 
-## 

-## This target is invoked by check-wrapper-consistency (run from cron).
+# 

+# This target is invoked by tl-check-wrapper-consistency (run from cron).
 .PHONY: echo-shell-scripts
 shell_scripts = $(texmf_shell_scripts)
 echo-shell-scripts:
 	@echo $(shell_scripts)
+
+# just a shorter name for all the scripts for convenience.
+all_scripts = $(nobase_dist_texmf_scripts_SCRIPTS)
+
+# Compare the list of scripts to the extant files in the repo;
+# should be exactly the same. Run from cron.
+check-make-vs-files:
+	# we descend two levels here because of context/perl/mptopdf.pl.
+	find "$(srcdir)"/*/* -type f | sed "s,$(srcdir)/,," | sort \
+	  >tmplist.files
+	echo $(all_scripts) | tr ' ' '\n' | sort >tmplist.make
+	comm -3 tmplist.files tmplist.make

Modified: trunk/Build/source/texk/texlive/linked_scripts/Makefile.in
===================================================================
--- trunk/Build/source/texk/texlive/linked_scripts/Makefile.in	2024-12-07 00:43:00 UTC (rev 73061)
+++ trunk/Build/source/texk/texlive/linked_scripts/Makefile.in	2024-12-07 17:56:53 UTC (rev 73062)
@@ -509,8 +509,15 @@
 
 relpath = $(SHELL) $(top_srcdir)/../../build-aux/relpath
 runscript = $(top_srcdir)/$(WIN_WRAPPER)/runscript.exe
+
+# 

+# For WIN32 (MinGW or native) we have wrapper binaries with .exe,
+# for Cygwin and Unix we have symlinks without .exe.
 @WIN32_TRUE at WINEXT = $(EXEEXT)
 shell_scripts = $(texmf_shell_scripts)
+
+# just a shorter name for all the scripts for convenience.
+all_scripts = $(nobase_dist_texmf_scripts_SCRIPTS)
 all: all-am
 
 .SUFFIXES:
@@ -824,10 +831,19 @@
 @WIN32_FALSE@	  rm -f $(DESTDIR)$(bindir)/man; \
 @WIN32_FALSE@	else :; fi
 
+# 

+# This target is invoked by check-wrapper-consistency (run from cron).
 .PHONY: echo-shell-scripts
 echo-shell-scripts:
 	@echo $(shell_scripts)
 
+# Compare 
+check-make-vs-files:
+# we descend two levels because of context/perl/mptopdf.pl.
+	find "$(srcdir)"/*/* -type f | sed "s,$(srcdir)/,," | sort >tmplist.files
+	echo $(all_scripts) | tr ' ' '\n' | sort >tmplist.make
+	comm -3 tmplist.files tmplist.make
+
 # Tell versions [3.59,3.63) of GNU make to not export all variables.
 # Otherwise a system limit (for SysV at least) may be exceeded.
 .NOEXPORT:

Deleted: trunk/Build/source/texk/texlive/linked_scripts/texlive/extractbb.lua
===================================================================
--- trunk/Build/source/texk/texlive/linked_scripts/texlive/extractbb.lua	2024-12-07 00:43:00 UTC (rev 73061)
+++ trunk/Build/source/texk/texlive/linked_scripts/texlive/extractbb.lua	2024-12-07 17:56:53 UTC (rev 73062)
@@ -1,252 +0,0 @@
-#!/usr/bin/env texlua
--- $Id: extractbb.lua 72829 2024-11-12 02:41:50Z kakuto $
--- SPDX-License-Identifier: CC0-1.0
--- SPDX-FileCopyrightText: 2024 Max Chernoff
---
--- A generic wrapper to make commands safe to run with restricted shell escape.
---
--- Originally created for extractbb, which is listed in shell_escape_commands,
--- but can be run as dvipdfm(x), which in turn can run arbitrary commands
--- using its -D option.
---
--- The idea is to exec "ebb --ebb <other args>", since only argv[1] is
--- used by dvipdfmx to determine its behavior.
---
--- Note: This script can only adjust the paths and arguments of the target
--- executable; it *CANNOT* make an arbitrary program safe to run with
--- restricted shell escape.
-
--- A shorter, less paranoid version.
--- (Prepend a hyphen to the line below to enable).
---[=[
-arg[0] = arg[0]:gsub("extractbb", "ebb")
-table.insert(arg, 1, "ebb")
-table.insert(arg, 2, "--extractbb")
-os.exec(arg)
-os.exit(1)
---]=]
-
----------------------
---- Configuration ---
----------------------
-
--- The base name of this script. (Example: ``extractbb'')
-local SCRIPT_NAME = "extractbb"
-
--- The base name of the path to the target program. (Example: ``xdvipdfmx'')
-local TARGET_PATH_NAME = "xdvipdfmx"
-
--- The name to use when calling the target program. Equivalent to ``argv[0]''
--- in C. (Example: ``extractbb'')
-local TARGET_EXEC_NAME = "ebb"
-
--- Any extra arguments to be prepended to the target program, before any
--- user-supplied arguments. Equivalent to ``argv[1], ...'' in C.
--- (Example: ``--extractbb'')
-local TARGET_PREPEND_ARGS = { "--extractbb" }
-
--- Any extra arguments to be appended to the target program, after any
--- user-supplied arguments. Equivalent to ``..., argv[argc]'' in C.
-local TARGET_APPEND_ARGS = {}
-
--- Sets the value of ``openin_any'' to this value. If ``nil'', then the value
--- will be left unchanged. (Example: ``r'')
-local READ_PERMS = "r"
-
--- Sets the value of ``openout_any'' to this value. If ``nil'', then the value
--- will be left unchanged. (Example: ``p'')
-local WRITE_PERMS = "p"
-
--- The name of the Lua interpreter. (Example: ``texlua'')
-local INTERPRETER_NAME = "texlua"
-
--- The extension of the interpreter. Extensionless-names are also permitted.
--- (Example: ``exe'')
-local INTERPRETER_EXT = "exe"
-
-
-----------------------
---- Initialization ---
-----------------------
-
--- Save often-used globals for a slight speed boost.
-local insert = table.insert
-
--- Set the kpathsea program name
-kpse.set_program_name(INTERPRETER_NAME, SCRIPT_NAME)
-
--- Rename the input arguments so we don't get confused
-local script_args = arg
-
-
-----------------------------
---- Function Definitions ---
-----------------------------
-
--- Error messages
-local function error(title, details)
-    -- Header
-    io.stderr:write("! extractbb ERROR: ")
-    io.stderr:write(title)
-    io.stderr:write(".\n\nTechnical Details:\n")
-
-    -- Messages
-    for key, value in pairs(details) do
-        io.stderr:write(tostring(key), ": ")
-        io.stderr:write("(", type(value), ") ")
-        io.stderr:write(tostring(value), "\n")
-    end
-
-    -- Traceback
-    io.stderr:write("\n")
-    io.stderr:write(debug.traceback(nil, 2), "\n")
-
-    -- Flush and exit
-    io.stderr:flush()
-    os.exit(1)
-end
-
--- Get the directory, name, and extension from a full path. We'll split on
--- either a forward or backward slash---Windows can use either, and we don't
--- need to support Unix systems with TL installed to a directory with
--- backslashes in its name.
-local split_dir_pattern = "^(.*)[/\\]([^/\\]-)$"
-local split_ext_pattern = "(.*)%.([^.]-)$"
-
-local function split_path(path)
-    -- Make sure that we were given a string
-    if type(path) ~= "string" then
-        return nil, nil, nil
-    end
-
-    -- Split the (directory) from the (name and extension)
-    local dir, name_ext = path:match(split_dir_pattern)
-
-    -- No directory
-    if not dir then
-        dir      = nil
-        name_ext = path
-
-    -- A bare directory (with a trailing slash)
-    elseif name_ext == "" then
-        return dir, nil, nil
-    end
-
-    -- Split the (name) from the (extension)
-    local name, ext = name_ext:match(split_ext_pattern)
-
-    -- No extension (or a dotfile)
-    if (not name) or (name == "") then
-        name = name_ext
-        ext  = nil
-    end
-
-    return dir, name, ext
-end
-
--- See if a file exists
-local function file_exists(path)
-    local mode = lfs.attributes(path, "mode")
-    return (mode == "file") or (mode == "link")
-end
-
-
----------------------
---- Safety Checks ---
----------------------
-
--- Make sure that we're running unrestricted.
-if status.shell_escape ~= 1 then
-    error("Shell escape has been disabled", {
-        shell_escape = status.shell_escape,
-    })
-end
-
-if status.safer_option ~= 0 then
-    error("The ``safer'' option has been enabled", {
-        safer_option = status.safer_option,
-    })
-end
-
--- Set the file permissions.
-if READ_PERMS then
-    os.setenv("openin_any", READ_PERMS)
-end
-
-if WRITE_PERMS then
-    os.setenv("openout_any", WRITE_PERMS)
-end
-
--- Get the location of the interpreter
-local interpreter_dir = os.selfdir or kpse.var_value("SELFAUTOLOC")
-local _, interpreter_name, interpreter_ext = split_path(script_args[-1])
-
-if os.type == "windows" then
-    interpreter_ext = INTERPRETER_EXT
-end
-
--- Error details
-local error_details = {
-    interpreter_dir     = interpreter_dir  or "<nil>",
-    interpreter_name    = interpreter_name or "<nil>",
-    interpreter_ext     = interpreter_ext  or "<nil>",
-    os_type             = os.type          or "<nil>",
-    os_name             = os.name          or "<nil>",
-}
-
--- Get the path to the target program
-local target_ext  = interpreter_ext and ("." .. interpreter_ext) or ""
-local target_path = interpreter_dir .. "/" .. TARGET_PATH_NAME .. target_ext
-
-error_details.target_path = target_path or "<nil>"
-error_details.target_ext  = target_ext  or "<nil>"
-
--- Make sure that the target program exists
-if not file_exists(target_path) then
-    error("The target program does not exist", error_details)
-end
-
-
-----------------------
---- Run the target ---
-----------------------
-
--- Generate the target arguments
-local target_args = {
-    [0] = target_path,      -- Path to the executable
-    [1] = TARGET_EXEC_NAME, -- argv[0]
-}
-
--- argv[2] through argv[n]
-for _, arg in ipairs(TARGET_PREPEND_ARGS) do
-    insert(target_args, arg)
-end
-
-for i = 1, #script_args do
-    -- We use a numeric iterator here to avoid ``arg[-1]'' and ``arg[0]''.
-    local this_arg = script_args[i]
-    if os.type == 'windows' then
-        this_arg = '"'..this_arg..'"'
-    end
-    insert(target_args, this_arg)
-
-    -- Show version information
-    if this_arg:match("%-version") then
-        print("(Wrapped by extractbb.lua $Revision: 72829 $.)")
-    end
-end
-
-for _, arg in ipairs(TARGET_APPEND_ARGS) do
-    insert(target_args, arg)
-end
-
--- Run the target program, replacing the current process
-local _, err = os.exec(target_args)
-
--- Unreachable except in the case of a failed exec
-for key, value in ipairs(target_args) do
-    error_details["target_args[" .. key .. "]"] = value
-end
-
-error_details.exec_message = err or "<nil>"
-error("The target program failed to run", error_details)

Deleted: trunk/Build/source/texk/texlive/linked_scripts/texlive/mktexlsr.pl
===================================================================
--- trunk/Build/source/texk/texlive/linked_scripts/texlive/mktexlsr.pl	2024-12-07 00:43:00 UTC (rev 73061)
+++ trunk/Build/source/texk/texlive/linked_scripts/texlive/mktexlsr.pl	2024-12-07 17:56:53 UTC (rev 73062)
@@ -1,734 +0,0 @@
-#!/usr/bin/env 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 62699 2022-03-14 09:53:53Z siepo $';
-my $lastchdate = '$Date: 2022-03-14 10:53:53 +0100 (Mon, 14 Mar 2022) $';
-$lastchdate =~ s/^\$Date:\s*//;
-$lastchdate =~ s/ \(.*$//;
-my $svnrev = '$Revision: 62699 $';
-$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 = win32() ? 0 : 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 at 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: #



More information about the tex-live-commits mailing list.