summaryrefslogtreecommitdiff
path: root/Master/tlpkg/TeXLive
diff options
context:
space:
mode:
authorNorbert Preining <preining@logic.at>2008-12-26 20:20:37 +0000
committerNorbert Preining <preining@logic.at>2008-12-26 20:20:37 +0000
commitafdd53f7d2908c4265cf5b404ad5184213b6df43 (patch)
tree0cf7adf58c5f23753850add326f8e489fcbee841 /Master/tlpkg/TeXLive
parent1967755718cb27759236566a62a71ef71b8d899e (diff)
make add/remove symlinks in fact one function, and factor out the removal
code, too git-svn-id: svn://tug.org/texlive/trunk@11725 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/TeXLive')
-rw-r--r--Master/tlpkg/TeXLive/TLPDB.pm161
1 files changed, 55 insertions, 106 deletions
diff --git a/Master/tlpkg/TeXLive/TLPDB.pm b/Master/tlpkg/TeXLive/TLPDB.pm
index 5b394dfd8d0..0fdf61039ec 100644
--- a/Master/tlpkg/TeXLive/TLPDB.pm
+++ b/Master/tlpkg/TeXLive/TLPDB.pm
@@ -930,7 +930,7 @@ On Windows it returns undefined.
=cut
-sub link_dir_dir {
+sub add_link_dir_dir {
my ($from, $to) = @_;
mkdirhier $to;
if (-w $to) {
@@ -951,9 +951,36 @@ sub link_dir_dir {
}
}
-sub add_symlinks {
+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 $nrfailed = 0;
+ my $mode = shift;
+ my $errors = 0;
my $Master = $self->{'root'};
my $arch = $self->option_platform;
my $plat_bindir = "$Master/bin/$arch";
@@ -961,127 +988,49 @@ sub add_symlinks {
$sys_bin = $self->option_sys_bin;
$sys_man = $self->option_sys_man;
$sys_info= $self->option_sys_info;
- $nrfailed++ unless link_dir_dir($plat_bindir, $sys_bin);
- $nrfailed++ unless link_dir_dir("$Master/texmf/doc/info", $sys_info);
- mkdirhier $sys_man;
+ if ($mode eq "add") {
+ $errors++ unless add_link_dir_dir($plat_bindir, $sys_bin);
+ $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);
+ $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) {
- debug("linking man pages to $sys_man\n");
+ 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;
- $nrfailed++ unless link_dir_dir($mandir, "$sys_man/$m");
+ 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, "
- . "no linking of man files done.\n");
- $nrfailed++;
+ . "cannot $mode symlinks.\n");
+ $errors++;
}
# we collected errors in $ret, so return the negation of it
- if ($nrfailed) {
- info("linking failed $nrfailed times, please see above messages.\n");
+ 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 {
- my $self = shift;
- my $errors = 0;
- my $Master = $self->{'root'};
- my $arch = $self->option_platform;
- my $plat_bindir = "$Master/bin/$arch";
- return if win32();
- if (!$self->option_create_symlinks) {
- tlwarn("Option to create symlinks is not set, please do that first.\n");
- return 0;
- } else {
- $sys_bin = $self->option_sys_bin;
- $sys_man = $self->option_sys_man;
- $sys_info= $self->option_sys_info;
- my @files;
- if ((-d "$sys_bin") && (-w "$sys_bin")) {
- my $plat_bindir;
- if (-l "$sys_bin/pdftex") {
- my $fullpath = readlink("$sys_bin/pdftex");
- if ($fullpath =~ m;^$Master/bin/(.*)/[^/]*$;) {
- $plat_bindir = $1;
- }
- } else {
- $errors++;
- tlwarn ("$sys_bin/pdftex not present or not a link, not removing any link of binaries!\n");
- }
- if ($plat_bindir) {
- @files = `ls "$Master/bin/$plat_bindir"`;
- chomp(@files);
- foreach my $f (@files) {
- next if (! -r "$sys_bin/$f");
- if ((-l "$sys_bin/$f") &&
- (readlink("$sys_bin/$f") =~ m;^$Master/bin/$plat_bindir/;)) {
- unlink("$sys_bin/$f");
- } else {
- $errors++;
- tlwarn ("not removing $sys_bin/$f, not a link or wrong destination!\n");
- }
- }
- }
- `rmdir "$sys_bin" 2>/dev/null`;
- } else {
- tlwarn ("destination of bin symlink $sys_bin not writable, no removal of links of bin files done!\n");
- }
- # info files
- if (-w $sys_info) {
- @files = `ls "$Master/texmf/doc/info"`;
- chomp(@files);
- foreach my $f (@files) {
- next if (! -r "$sys_info/$f");
- if ((-l "$sys_info/$f") &&
- (readlink("$sys_info/$f") =~ m;^$Master/texmf/doc/info/;)) {
- unlink("$sys_info/$f");
- } else {
- $errors++;
- tlwarn ("not removing $sys_info/$f, not a link or wrong destination!\n");
- }
- }
- `rmdir "$sys_info" 2>/dev/null`;
- } else {
- $errors++;
- tlwarn ("destination of info symlink $sys_info not writable, no removal of links of info files done!\n");
- }
- # man files
- if (-w $sys_man) {
- my $foo = `(cd "$Master/texmf/doc/man" && echo *)`;
- my @mans = split ' ', $foo;
- chomp(@mans);
- foreach my $m (@mans) {
- my $mandir = "$Master/texmf/doc/man/$m";
- next unless -d $mandir;
- next unless -d "$sys_man/$m";
- @files = `ls "$mandir"`;
- chomp(@files);
- foreach my $f (@files) {
- next if (! -r "$sys_man/$m/$f");
- if ((-l "$sys_man/$m/$f") &&
- (readlink("$sys_man/$m/$f") =~ m;^$Master/texmf/doc/man/$m/;)) {
- unlink("$sys_man/$m/$f");
- } else {
- $errors++;
- tlwarn ("not removing $sys_man/$m/$f, not a link or wrong destination!\n");
- }
- }
- # ignore errors, it might be not empty
- `rmdir "$sys_man/$m" 2>/dev/null`;
- }
- `rmdir "$sys_man" 2>/dev/null`;
- } else {
- $errors++;
- tlwarn ("destination of man symlink $sys_man not writable, no removal of links of man files done!\n");
- }
- }
- # we collected errors in $errors, so return the ! of it
- return (!$errors);
+ return (shift->add_remove_symlinks("remove", @_));
}
=pod