diff options
author | Norbert Preining <preining@logic.at> | 2008-12-26 20:20:37 +0000 |
---|---|---|
committer | Norbert Preining <preining@logic.at> | 2008-12-26 20:20:37 +0000 |
commit | afdd53f7d2908c4265cf5b404ad5184213b6df43 (patch) | |
tree | 0cf7adf58c5f23753850add326f8e489fcbee841 /Master/tlpkg/TeXLive/TLPDB.pm | |
parent | 1967755718cb27759236566a62a71ef71b8d899e (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/TLPDB.pm')
-rw-r--r-- | Master/tlpkg/TeXLive/TLPDB.pm | 161 |
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 |