diff options
author | Norbert Preining <preining@logic.at> | 2008-12-19 22:57:33 +0000 |
---|---|---|
committer | Norbert Preining <preining@logic.at> | 2008-12-19 22:57:33 +0000 |
commit | f6bc14e1abf07895c34f8feb1549e34d65bf1889 (patch) | |
tree | d47d42a3d065e3fda8c5b4b87392600b7c86d0ab /Master/tlpkg/TeXLive/TLPDB.pm | |
parent | b2710f561308242d8fdd0779e1377da9d299d118 (diff) |
- add TLPDB->add_symlinks and TLPDB->remove_symlinks
- add symlink information to tlmgr2 option
- add comment if we should activate it or not
git-svn-id: svn://tug.org/texlive/trunk@11657 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/TeXLive/TLPDB.pm')
-rw-r--r-- | Master/tlpkg/TeXLive/TLPDB.pm | 190 |
1 files changed, 189 insertions, 1 deletions
diff --git a/Master/tlpkg/TeXLive/TLPDB.pm b/Master/tlpkg/TeXLive/TLPDB.pm index 6076773dc89..122a53f161a 100644 --- a/Master/tlpkg/TeXLive/TLPDB.pm +++ b/Master/tlpkg/TeXLive/TLPDB.pm @@ -50,6 +50,8 @@ C<TeXLive::TLPDB> -- A database of TeX Live Packages $tlpdb->config_release; $tlpdb->config_revision; $tlpdb->option($key, [$value]); + $tlpdb->add_symlinks(); + $tlpdb->remove_symlinks(); TeXLive::TLPDB->listdir([$dir]); $tlpdb->generate_listfiles([$destdir]); @@ -912,6 +914,191 @@ sub config_revision { return ""; } + +=pod + +=item C<< $tlpdb->add_symlinks() >> +=item C<< $tlpdb->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 tlpdb +($tlpdb->option_create_symlinks, $tlpdb->option_sys_bin, +$tlpdb->option_sys_man, $tlpdb->option_sys_info). + +The functions return 1 on success and 0 on error. + +On win32 it returns undefined; + +=cut + +sub add_symlinks { + my $self = shift; + my $ret = 0; + my $Master = $self->{'root'}; + my $arch = $self->option_platform; + my $plat_bindir = "$Master/bin/$arch"; + return if win32(); + if ($self->option_create_symlinks) { + $sys_bin = $self->option_sys_bin; + $sys_man = $self->option_sys_man; + $sys_info= $self->option_sys_info; + my @files; + # bin files + mkdirhier $sys_bin; + if (-w $sys_bin) { + debug("linking binaries to $sys_bin\n"); + chomp (@files = `ls $plat_bindir`); + `cd "$sys_bin" && rm -f @files`; + `ln -s "$plat_bindir/"* "$sys_bin"`; + } else { + tlwarn("destination of bin symlinks $sys_bin not writable, " + . "no linking of bin files done.\n"); + $ret++; + } + # for info and man files we do that only if the option_install_docfiles + # is set + if ($self->option_install_docfiles) { + # info files + mkdirhier $sys_info; + if (-w $sys_info) { + debug("linking info pages to $sys_info\n"); + chomp (@files = `ls "$Master/texmf/doc/info"`); + `cd "$sys_info" && rm -f @files`; + `ln -s "$Master/texmf/doc/info/"*info* "$sys_info"`; + } else { + tlwarn("destination of info symlink $sys_info not writable, " + . "no linking of info files done.\n"); + $ret++; + } + # man files + mkdirhier $sys_man; + if (-w $sys_man) { + debug("linking man pages to $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; + mkdirhier "$sys_man/$m"; + next unless -w "$sys_man/$m"; + chomp (@files = `ls "$mandir"`); + `cd "$sys_man/$m" && rm -f @files`; + `ln -s "$mandir/"* "$sys_man/$m"`; + } + } else { + tlwarn("destination of man symlink $sys_man not writable, " + . "no linking of man files done.\n"); + $ret++; + } + } else { + # doc files are not installed, so not linked, should we return an + # error, or warn, or ??? + } + # we collected errors in $ret, so return the negation of it + return !$ret; + } else { + tlwarn("Option to create symlinks is not set, please do that first.\n"); + return 0; + } +} + +sub remove_symlinks { + my $self = shift; + my $ret = 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 { + $ret++; + 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 { + $ret++; + 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 { + $ret++; + tlwarn ("not removing $sys_info/$f, not a link or wrong destination!\n"); + } + } + `rmdir "$sys_info" 2>/dev/null`; + } else { + $ret++; + 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 { + $ret++; + 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 { + $ret++; + tlwarn ("destination of man symlink $sys_man not writable, no removal of links of man files done!\n"); + } + } + # we collected errors in $ret, so return the ! of it + return (!$ret); +} + =pod =item C<< $tlpdb->option_XXXXX >> @@ -955,8 +1142,9 @@ sub _option_value { return "$1"; } } - return ""; + return; } + tlwarn("00texlive-installation.config not found, cannot read option $key.\n"); return; } |