summaryrefslogtreecommitdiff
path: root/Build/source/texk/tests
diff options
context:
space:
mode:
authorKarl Berry <karl@freefriends.org>2014-12-09 23:20:30 +0000
committerKarl Berry <karl@freefriends.org>2014-12-09 23:20:30 +0000
commitae510c98fac43fb40e7c8ec15ae2d1dab513eb3b (patch)
treedcec7ee4b4666e431788428d5500edad49b7a7da /Build/source/texk/tests
parent92b35aa42d6d9f68b1d1f730dd47da06d2d3aa23 (diff)
sync
git-svn-id: svn://tug.org/texlive/trunk@35775 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Build/source/texk/tests')
-rw-r--r--Build/source/texk/tests/TeXLive/TLConfig.pm7
-rw-r--r--Build/source/texk/tests/TeXLive/TLUtils.pm181
2 files changed, 109 insertions, 79 deletions
diff --git a/Build/source/texk/tests/TeXLive/TLConfig.pm b/Build/source/texk/tests/TeXLive/TLConfig.pm
index 4e0855319b8..573efa08d56 100644
--- a/Build/source/texk/tests/TeXLive/TLConfig.pm
+++ b/Build/source/texk/tests/TeXLive/TLConfig.pm
@@ -1,4 +1,3 @@
-# $Id: TLConfig.pm 34040 2014-05-15 12:16:59Z siepo $
# TeXLive::TLConfig.pm - module exporting configuration values
# Copyright 2007-2014 Norbert Preining
# This file is licensed under the GNU General Public License version 2
@@ -6,7 +5,7 @@
package TeXLive::TLConfig;
-my $svnrev = '$Revision: 34040 $';
+my $svnrev = '$Revision: 35731 $';
my $_modulerevision;
if ($svnrev =~ m/: ([0-9]+) /) {
$_modulerevision = $1;
@@ -59,10 +58,10 @@ $ReleaseYear = 2014;
# users can upgrade from this year to the current year; maybe a spread
# of more than one year will be useful at some point, but not now.
-# $MinRelease = $ReleaseYear - 1;
+$MinRelease = 2013; # upgrade from 2013 to 2015 might work?
# users can NOT upgrade due to internal changes, force a full installation
-$MinRelease = $ReleaseYear;
+#$MinRelease = $ReleaseYear;
# Meta Categories do not ship files, but only call for other packages.
our @MetaCategories = qw/Collection Scheme/;
diff --git a/Build/source/texk/tests/TeXLive/TLUtils.pm b/Build/source/texk/tests/TeXLive/TLUtils.pm
index eeeaf92144d..ab940e6b93e 100644
--- a/Build/source/texk/tests/TeXLive/TLUtils.pm
+++ b/Build/source/texk/tests/TeXLive/TLUtils.pm
@@ -5,7 +5,7 @@
package TeXLive::TLUtils;
-my $svnrev = '$Revision: 35578 $';
+my $svnrev = '$Revision: 35719 $';
my $_modulerevision;
if ($svnrev =~ m/: ([0-9]+) /) {
$_modulerevision = $1;
@@ -26,7 +26,7 @@ C<TeXLive::TLUtils> -- utilities used in the TeX Live infrastructure
use TeXLive::TLUtils;
-=head2 Platform Detection
+=head2 Platform detection
TeXLive::TLUtils::platform();
TeXLive::TLUtils::platform_name($canonical_host);
@@ -34,17 +34,18 @@ C<TeXLive::TLUtils> -- utilities used in the TeX Live infrastructure
TeXLive::TLUtils::win32();
TeXLive::TLUtils::unix();
-=head2 System Tools
+=head2 System tools
TeXLive::TLUtils::getenv($string);
TeXLive::TLUtils::which($string);
TeXLive::TLUtils::get_system_tmpdir();
TeXLive::TLUtils::tl_tmpdir();
TeXLive::TLUtils::xchdir($dir);
+ TeXLive::TLUtils::wsystem($msg,@args);
TeXLive::TLUtils::xsystem(@args);
TeXLive::TLUtils::run_cmd($cmd);
-=head2 File Utilities
+=head2 File utilities
TeXLive::TLUtils::dirname($path);
TeXLive::TLUtils::basename($path);
@@ -64,7 +65,7 @@ C<TeXLive::TLUtils> -- utilities used in the TeX Live infrastructure
TeXLive::TLUtils::nulldev();
TeXLive::TLUtils::get_full_line($fh);
-=head2 Installer Functions
+=head2 Installer functions
TeXLive::TLUtils::make_var_skeleton($path);
TeXLive::TLUtils::make_local_skeleton($path);
@@ -174,6 +175,7 @@ BEGIN {
&create_mirror_list
&extract_mirror_entry
&tlmd5
+ &wsystem
&xsystem
&run_cmd
&announce_execute_actions
@@ -206,8 +208,8 @@ use TeXLive::TLConfig;
$::opt_verbosity = 0; # see process_logging_options
-
-=head2 Platform Detection
+
+=head2 Platform detection
=over 4
@@ -482,7 +484,7 @@ sub get_system_tmpdir {
=item C<tl_tmpdir>
-Create a temporary directory which is cleaned up as soon as the program
+Create a temporary directory which is removed when the program
is terminated.
=cut
@@ -504,9 +506,28 @@ sub xchdir {
}
+=item C<wsystem($msg, @args)>
+
+Call C<info> about what is being done starting with C<$msg>, then run
+C<system(@args)>; C<tlwarn> if unsuccessful and return the exit status.
+
+=cut
+
+sub wsystem {
+ my ($msg,@args) = @_;
+ info("$msg @args ...\n");
+ my $status = system(@args);
+ if ($status != 0) {
+ tlwarn("$0: command failed: @args: $!\n");
+ }
+ return $status;
+}
+
+
=item C<xsystem(@args)>
-Run C<system(@args)> and die if unsuccessful.
+Call C<ddebug> about what is being done, then run C<system(@args)>, and
+die if unsuccessful.
=cut
@@ -523,7 +544,7 @@ sub xsystem {
=item C<run_cmd($cmd)>
-runs shell CMD and captures its output. Returns a list with CMD's
+Run shell command C<$cmd> and captures its output. Returns a list with CMD's
output as the first element and the return value (exit code) as second.
=cut
@@ -541,8 +562,6 @@ sub run_cmd {
}
-
-
=back
=head2 File Utilities
@@ -714,28 +733,30 @@ a fileserver.
# real Program Files. Ugh.
sub dir_writable {
- my $path=shift;
+ my ($path) = @_;
return 0 unless -d $path;
$path =~ s!\\!/!g if win32;
$path =~ s!/$!!;
my $i = 0;
my $too_large = 100000;
- while ((-e $path . "/" . $i) and $i<$too_large) { $i++; }
- return 0 if $i>=$too_large;
- my $f = $path."/".$i;
- return 0 unless open TEST, ">".$f;
+ while ((-e "$path/$i") && $i < $too_large) {
+ $i++;
+ }
+ return 0 if $ i >= $too_large;
+ my $f = "$path/$i";
+ return 0 if ! open (TEST, ">$f");
my $written = 0;
$written = (print TEST "\n");
- close TEST;
- unlink $f;
+ close (TEST);
+ unlink ($f);
return $written;
}
=item C<mkdirhier($path, [$mode])>
-The function C<mkdirhier> does the same as the UNIX command C<mkdir -p>.
-The optional parameter sets the permission flags.
+The function C<mkdirhier> does the same as the UNIX command C<mkdir -p>,
+and dies on failure. The optional parameter sets the permission bits.
=cut
@@ -1044,9 +1065,6 @@ sub touch {
}
}
-
-
-
=item C<collapse_dirs(@files)>
@@ -1991,27 +2009,38 @@ On Windows it returns undefined.
=cut
sub add_link_dir_dir {
- my ($from, $to) = @_;
- mkdirhier $to;
- if (-w $to) {
- debug("linking files from $from to $to\n");
+ my ($from,$to) = @_;
+ mkdirhier ($to);
+ if (-w $to) {
+ debug ("linking files from $from to $to\n");
chomp (@files = `ls "$from"`);
my $ret = 1;
for my $f (@files) {
- # skip certain dangerous entries that should never be linked somewhere
+ # don't make a system-dir link to our special "man" link.
if ($f eq "man") {
- debug("not linking man into $to.\n");
+ debug ("not linking `man' into $to.\n");
+ next;
+ }
+ #
+ # attempt to remove an existing symlink, but nothing else.
+ unlink ("$to/$f") if -l "$to/$f";
+ #
+ # if the destination still exists, skip it.
+ if (-e "$to/$f") {
+ tlwarn ("add_link_dir_dir: $to/$f exists; not making symlink.\n");
next;
}
- unlink("$to/$f");
- if (system("ln -s \"$from/$f\" \"$to\"")) {
- tlwarn("Linking $f from $from to $to failed: $!\n");
+ #
+ # try to make the link.
+ if (system ("ln -s '$from/$f' '$to'") != 0) {
+ tlwarn ("add_link_dir_dir: linking $f from $from to $to failed: $!\n");
$ret = 0;
}
}
return $ret;
} else {
- tlwarn("destination $to not writable, no linking files in $from done.\n");
+ tlwarn ("add_link_dir_dir: destination $to not writable, "
+ . "no links from $from.\n");
return 0;
}
}
@@ -2050,58 +2079,65 @@ sub add_remove_symlinks {
my ($mode, $Master, $arch, $sys_bin, $sys_man, $sys_info) = @_;
my $errors = 0;
my $plat_bindir = "$Master/bin/$arch";
+
+ # nothing to do with symlinks on Windows, of course.
return if win32();
+
+ my $info_dir = "$Master/texmf-dist/doc/info";
if ($mode eq "add") {
- $errors++ unless add_link_dir_dir($plat_bindir, $sys_bin);
- if (-d "$Master/texmf-dist/doc/info") {
- $errors++
- unless add_link_dir_dir("$Master/texmf-dist/doc/info", $sys_info);
+ $errors++ unless add_link_dir_dir($plat_bindir, $sys_bin); # bin
+ if (-d $info_dir) {
+ $errors++ unless add_link_dir_dir($info_dir, $sys_info);
}
} elsif ($mode eq "remove") {
- $errors++ unless remove_link_dir_dir($plat_bindir, $sys_bin);
- if (-d "$Master/texmf-dist/doc/info") {
- $errors++
- unless remove_link_dir_dir("$Master/texmf-dist/doc/info", $sys_info);
+ $errors++ unless remove_link_dir_dir($plat_bindir, $sys_bin); # bin
+ if (-d $info_dir) {
+ $errors++ unless remove_link_dir_dir($info_dir, $sys_info);
}
} else {
die ("should not happen, unknown mode $mode in add_remove_symlinks!");
}
- mkdirhier $sys_man if ($mode eq "add");
- if (-w $sys_man && -d "$Master/texmf-dist/doc/man") {
- debug("$mode symlinks for man pages in $sys_man\n");
- my $foo = `(cd "$Master/texmf-dist/doc/man" && echo *)`;
- my @mans = split (' ', $foo);
- chomp (@mans);
- foreach my $m (@mans) {
- my $mandir = "$Master/texmf-dist/doc/man/$m";
- next unless -d $mandir;
- if ($mode eq "add") {
- $errors++ unless add_link_dir_dir($mandir, "$sys_man/$m");
- } else {
- $errors++ unless remove_link_dir_dir($mandir, "$sys_man/$m");
+
+ # man
+ my $top_man_dir = "$Master/texmf-dist/doc/man";
+ debug("$mode symlinks for man pages to $sys_man from $top_man_dir\n");
+ if (! -d $top_man_dir && $mode eq "add") {
+ ; # better to be silent?
+ #info("skipping add of man symlinks, no source directory $top_man_dir\n");
+ } else {
+ mkdirhier $sys_man if ($mode eq "add");
+ if (-w $sys_man) {
+ my $foo = `(cd "$top_man_dir" && echo *)`;
+ my @mans = split (' ', $foo);
+ chomp (@mans);
+ foreach my $m (@mans) {
+ my $mandir = "$top_man_dir/$m";
+ next unless -d $mandir;
+ if ($mode eq "add") {
+ $errors++ unless add_link_dir_dir($mandir, "$sys_man/$m");
+ } else {
+ $errors++ unless remove_link_dir_dir($mandir, "$sys_man/$m");
+ }
}
+ #`rmdir "$sys_man" 2>/dev/null` if ($mode eq "remove");
+ } else {
+ tlwarn("man symlink destination ($sys_man) not writable,"
+ . "cannot $mode symlinks.\n");
+ $errors++;
}
- # `rmdir "$sys_man" 2>/dev/null` if ($mode eq "remove");
- } else {
- tlwarn("destination of man symlink $sys_man not writable, "
- . "cannot $mode symlinks.\n");
- $errors++;
}
- # we collected errors in $ret, so return the negation of it
+
+ # we collected errors in $errors, so return the negation of it
if ($errors) {
- info("$mode of symlinks failed $errors times, please see above messages.\n");
+ info("$mode of symlinks had $errors error(s), see messages above.\n");
return 0;
} else {
return 1;
}
}
-sub add_symlinks {
- return (add_remove_symlinks("add", @_));
-}
-sub remove_symlinks {
- return (add_remove_symlinks("remove", @_));
-}
+sub add_symlinks { return (add_remove_symlinks("add", @_)); }
+sub remove_symlinks { return (add_remove_symlinks("remove", @_)); }
=pod
@@ -2351,7 +2387,6 @@ sub read_file_ignore_cr {
return $ret;
}
-
=item C<setup_programs($bindir, $platform)>
@@ -2672,7 +2707,7 @@ sub get_full_line {
return $line . $cont;
}
-
+
=back
=head2 Installer Functions
@@ -2727,7 +2762,6 @@ sub make_local_skeleton {
mkdirhier "$prefix/web2c";
}
-
=item C<create_fmtutil($tlpdb, $dest, $localconf)>
@@ -3073,7 +3107,7 @@ sub parse_AddFormat_line {
return %ret;
}
-
+
=back
=head2 Miscellaneous
@@ -3929,8 +3963,6 @@ sub sort_archs ($$) {
$aa cmp $bb ;
}
-#############################################
-#
# Taken from Text::ParseWords
#
sub quotewords {
@@ -4085,7 +4117,6 @@ sub mktexupd {
return $hash;
}
-
=back
=cut
1;