From 1cba6d04155f7747a5061a73ae4ac9341b3ff58a Mon Sep 17 00:00:00 2001 From: Norbert Preining Date: Mon, 6 Jul 2009 12:31:40 +0000 Subject: 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 --- Master/tlpkg/TeXLive/TLMedia.pm | 123 ---------------------------------------- Master/tlpkg/TeXLive/TLUtils.pm | 120 +++++++++++++++++++++++++++++++++++++++ 2 files changed, 120 insertions(+), 123 deletions(-) (limited to 'Master/tlpkg') 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 -- 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 +=item C + +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 Unpacked C<$tarfile> in C<$targetdir> (changing directories to -- cgit v1.2.3