summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNorbert Preining <preining@logic.at>2009-07-06 12:31:40 +0000
committerNorbert Preining <preining@logic.at>2009-07-06 12:31:40 +0000
commit1cba6d04155f7747a5061a73ae4ac9341b3ff58a (patch)
tree2dd8f2cf98e5ba92939f2bc3b6a783294682fb90
parentb7571eb1447c7088b54908ad9a33c253f2a31744 (diff)
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
-rwxr-xr-xMaster/install-tl4
-rwxr-xr-xMaster/texmf/scripts/texlive/tlmgr.pl12
-rw-r--r--Master/tlpkg/TeXLive/TLMedia.pm123
-rw-r--r--Master/tlpkg/TeXLive/TLUtils.pm120
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