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

4 files changed, 133 insertions, 126 deletions

diff --git a/Master/install-tl b/Master/install-tl
index 3d5721fade7..b459f63a8c0 100755
--- a/Master/install-tl
+++ b/Master/install-tl
@@ -819,7 +819,9 @@ sub do_path_adjustments {
     setenv_reg('TEXMFCNF', $vars{'TEXMFSYSVAR'}.'/web2c') if $vars{'from_dvd'};
     broadcast_env();
   } else {
-    $localtlpdb->add_symlinks() 
+    TeXLive::TLUtils::add_symlinks($vars{'TEXDIR'}, $vars{'this_platform'},
+      $vars{'option_sys_bin'}, $vars{'option_sys_man'}, 
+      $vars{'option_sys_info'});
   }
   info ("finished with path adjustment actions\n");
 }
diff --git a/Master/texmf/scripts/texlive/tlmgr.pl b/Master/texmf/scripts/texlive/tlmgr.pl
index 913471dff55..8c3896ccc6a 100755
--- a/Master/texmf/scripts/texlive/tlmgr.pl
+++ b/Master/texmf/scripts/texlive/tlmgr.pl
@@ -886,10 +886,18 @@ sub action_symlinks {
   }
   init_local_db();
   if ($what =~ m/^add$/i) {
-    $localtlmedia->add_symlinks();
+    TeXLive::TLUtils::add_symlinks($localtlmedia->tlpdb->root,
+      $localtlmedia->platform(),
+      $localtlmedia->tlpdb->option("sys_bin"),
+      $localtlmedia->tlpdb->option("sys_man"),
+      $localtlmedia->tlpdb->option("sys_info"));
   } elsif ($what =~ m/^remove$/i) {
     # remove symlinks
-    $localtlmedia->remove_symlinks();
+    TeXLive::TLUtils::remove_symlinks($localtlmedia->tlpdb->root,
+      $localtlmedia->platform(),
+      $localtlmedia->tlpdb->option("sys_bin"),
+      $localtlmedia->tlpdb->option("sys_man"),
+      $localtlmedia->tlpdb->option("sys_info"));
   } else {
     # that should not happen
     tlwarn("that should not happen, action_symlinks what=$what\n");
diff --git a/Master/tlpkg/TeXLive/TLMedia.pm b/Master/tlpkg/TeXLive/TLMedia.pm
index 6980f813959..bb8638a765d 100644
--- a/Master/tlpkg/TeXLive/TLMedia.pm
+++ b/Master/tlpkg/TeXLive/TLMedia.pm
@@ -500,129 +500,6 @@ sub remove_package {
 }
 
 
-=pod
-
-=item C<< $tlmedia->add_symlinks() >>
-=item C<< $tlmedia->remove_symlinks() >>
-
-These two functions try to create/remove symlinks for binaries, man pages,
-and info files as specified by the options saved in the respective tlpdb
-($tlpdb->option("sys_bin"), $tlpdb->option("sys_man"), 
-$tlpdb->option("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 $self = shift;
-  my $mode = shift;
-  my $errors = 0;
-  my $Master = $self->location;
-  my $arch = $self->platform();
-  my $plat_bindir = "$Master/bin/$arch";
-  return if win32();
-  $sys_bin = $self->tlpdb->option("sys_bin");
-  $sys_man = $self->tlpdb->option("sys_man");
-  $sys_info= $self->tlpdb->option("sys_info");
-  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 (shift->add_remove_symlinks("add", @_));
-}
-sub remove_symlinks {
-  return (shift->add_remove_symlinks("remove", @_));
-}
-
-
 # member access functions
 #
 sub media { my $self = shift ; return $self->{'media'}; }
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