move add/remove_symlinks to TLUtils, so that we can use it in install-tl

us it there, and fix tlmgr, and remove code from TLMedia.pm


git-svn-id: svn://tug.org/texlive/trunk@14145 c570f23f-e606-0410-a88d-b1316a301751

1 files changed, 120 insertions, 0 deletions

diff --git a/Master/tlpkg/TeXLive/TLUtils.pm b/Master/tlpkg/TeXLive/TLUtils.pm
index 54650559440..d41f7819cff 100644
--- a/Master/tlpkg/TeXLive/TLUtils.pm
+++ b/Master/tlpkg/TeXLive/TLUtils.pm
@@ -62,6 +62,8 @@ C<TeXLive::TLUtils> -- utilities used in the TeX Live infrastructure
   TeXLive::TLUtils::install_package($what, $filelistref, $target, $platform);
   TeXLive::TLUtils::do_postaction($how, $tlpobj);
   TeXLive::TLUtils::announce_execute_actions($how, @executes);
+  TeXLive::TLUtils::add_symlinks($root, $arch, $sys_bin, $sys_man, $sys_info);
+  TeXLive::TLUtils::remove_symlinks($root, $arch, $sys_bin, $sys_man, $sys_info);
 
 =head2 Miscellaneous
 
@@ -124,6 +126,8 @@ BEGIN {
     &xsystem
     &run_cmd
     &announce_execute_actions
+    &add_symlinks
+    &remove_symlinks
     &tlcmp
   );
   @EXPORT = qw(setup_programs download_file process_logging_options
@@ -1691,6 +1695,122 @@ sub announce_execute_actions {
 }
 
 
+=pod
+
+=item C<add_symlinks($root, $arch, $sys_bin, $sys_man, $sys_info)>
+=item C<remove_symlinks($root, $arch, $sys_bin, $sys_man, $sys_info)>
+
+These two functions try to create/remove symlinks for binaries, man pages,
+and info files as specified by the options $sys_bin, $sys_man, $sys_info.
+
+The functions return 1 on success and 0 on error.
+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");
+    chomp (@files = `ls "$from"`);
+    my $ret = 1;
+    for my $f (@files) {
+      unlink("$to/$f");
+      if (system("ln -s \"$from/$f\" \"$to\"")) {
+        tlwarn("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");
+    return 0;
+  }
+}
+
+sub remove_link_dir_dir {
+  my ($from, $to) = @_;
+  if ((-d "$to") && (-w "$to")) {
+    debug("removing links from $from to $to\n");
+    chomp (@files = `ls "$from"`);
+    my $ret = 1;
+    foreach my $f (@files) {
+      next if (! -r "$to/$f");
+      if ((-l "$to/$f") &&
+          (readlink("$to/$f") =~ m;^$from/;)) {
+        $ret = 0 unless unlink("$to/$f");
+      } else {
+        $ret = 0;
+        tlwarn ("not removing $to/$f, not a link or wrong destination!\n");
+      }
+    }
+    # trry to remove the destination directory, it might be empty and
+    # we might have write permissions, ignore errors
+    `rmdir "$to" 2>/dev/null`;
+    return $ret;
+  } else {
+    tlwarn ("destination $to not writable, no removal of links done!\n");
+    return 0;
+  }
+}
+
+sub add_remove_symlinks {
+  my ($mode, $Master, $arch, $sys_bin, $sys_man, $sys_info) = @_;
+  my $errors = 0;
+  my $plat_bindir = "$Master/bin/$arch";
+  return if win32();
+  if ($mode eq "add") {
+    $errors++ unless add_link_dir_dir($plat_bindir, $sys_bin);
+    if (-d "$Master/texmf/doc/info") {
+      $errors++ unless add_link_dir_dir("$Master/texmf/doc/info", $sys_info);
+    }
+  } elsif ($mode eq "remove") {
+    $errors++ unless remove_link_dir_dir($plat_bindir, $sys_bin);
+    if (-d "$Master/texmf/doc/info") {
+      $errors++ unless remove_link_dir_dir("$Master/texmf/doc/info", $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/doc/man") {
+    debug("$mode symlinks for man pages in $sys_man\n");
+    my $foo = `(cd "$Master/texmf/doc/man" && echo *)`;
+    chomp (my @mans = split (' ', $foo));
+    foreach my $m (@mans) {
+      my $mandir = "$Master/texmf/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");
+      }
+    }
+    `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
+  if ($errors) {
+    info("$mode of symlinks failed $errors times, please see above messages.\n");
+    return 0;
+  } else {
+    return 1;
+  }
+}
+
+sub add_symlinks {
+  return (add_remove_symlinks("add", @_));
+}
+sub remove_symlinks {
+  return (add_remove_symlinks("remove", @_));
+}
+
+
+
 =item C<untar($tarfile,$targetdir, $remove_tarfile)>
 
 Unpacked C<$tarfile> in C<$targetdir> (changing directories to