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, 0 insertions, 123 deletions

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'}; }