summaryrefslogtreecommitdiff
path: root/Master/tlpkg/TeXLive/TLMedia.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/TeXLive/TLMedia.pm')
-rw-r--r--Master/tlpkg/TeXLive/TLMedia.pm168
1 files changed, 160 insertions, 8 deletions
diff --git a/Master/tlpkg/TeXLive/TLMedia.pm b/Master/tlpkg/TeXLive/TLMedia.pm
index 90af2763348..6980f813959 100644
--- a/Master/tlpkg/TeXLive/TLMedia.pm
+++ b/Master/tlpkg/TeXLive/TLMedia.pm
@@ -11,6 +11,7 @@ use TeXLive::TLConfig;
use TeXLive::TLUtils qw(copy win32 dirname mkdirhier basename download_file
merge_into debug ddebug info tlwarn log);
use TeXLive::TLPDB;
+use TeXLive::TLWinGoo;
sub new
{
@@ -137,8 +138,8 @@ sub install_package {
my $container_src_split = $fromtlpdb->config_src_container;
my $container_doc_split = $fromtlpdb->config_doc_container;
# get options about src/doc splitting from $totlpdb
- my $opt_src = $totlpdb->option_install_srcfiles;
- my $opt_doc = $totlpdb->option_install_docfiles;
+ my $opt_src = $totlpdb->option("install_srcfiles");
+ my $opt_doc = $totlpdb->option("install_docfiles");
my $real_opt_doc = $opt_doc;
if ($tlpobj->category =~ m/documentation/i) {
# we do install documenation files for category Documentation
@@ -258,10 +259,15 @@ sub install_package {
# do the postinstallation actions
#
# Run the post installation code in the postaction tlpsrc entries
+ # in case we are on w32 and the admin did install for himself only
+ # we switch off admin mode
+ if (win32() && admin() && !$totlpdb->option("w32_multi_user")) {
+ non_admin();
+ }
&TeXLive::TLUtils::do_postaction("install", $tlpobj,
- $totlpdb->option_file_assocs,
- $totlpdb->option_desktop_integration,
- $totlpdb->option_post_code);
+ $totlpdb->option("file_assocs"),
+ $totlpdb->option("desktop_integration"),
+ $totlpdb->option("post_code"));
}
}
return 1;
@@ -454,7 +460,7 @@ sub remove_package {
&TeXLive::TLUtils::do_postaction("remove", $tlp,
0, # option_file_assocs,
0, # option_desktop_integration,
- $localtlpdb->option_post_code);
+ $localtlpdb->option("post_code"));
}
#
my @removals = &TeXLive::TLUtils::removed_dirs (@goodfiles);
@@ -474,17 +480,147 @@ sub remove_package {
$localtlpdb->save;
#
# Run the post installation code in the postaction tlpsrc entries
+ # in case we are on w32 and the admin did install for himself only
+ # we switch off admin mode
+ if (win32() && admin() && !$localtlpdb->option("w32_multi_user")) {
+ non_admin();
+ }
+ #
+ # Run the post installation code in the postaction tlpsrc entries
# the postaction code part cannot be evaluated now since the
# files are already removed.
if (!$nopostinstall) {
&TeXLive::TLUtils::do_postaction("remove", $tlp,
- $localtlpdb->option_file_assocs,
- $localtlpdb->option_desktop_integration,
+ $localtlpdb->option("file_assocs"),
+ $localtlpdb->option("desktop_integration"),
0);
}
}
return 1;
}
+
+
+=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
@@ -500,6 +636,22 @@ sub lang_doc_collections { my $self = shift; return @{ $self->{'lang_doc_collect
sub schemes { my $self = shift; return @{ $self->{'schemes'} }; }
sub systems { my $self = shift; return @{ $self->{'systems'} }; }
+# deduce the platform of the referenced media as follows:
+# - if the $tlpdb->setting("platform") is there it overrides the detected
+# setting
+# - if it is not there call TLUtils::platform()
+sub platform {
+ # try to deduce the platform
+ my $self = shift;
+ my $tlpdb = $self->tlpdb;
+ if (defined($tlpdb)) {
+ my $ret = $tlpdb->setting("platform");
+ return $ret if defined $ret;
+ }
+ # the platform setting wasn't found in the tlpdb, try TLUtils::platform
+ return TeXLive::TLUtils::platform();
+}
+
1;
__END__