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.pm229
1 files changed, 183 insertions, 46 deletions
diff --git a/Master/tlpkg/TeXLive/TLMedia.pm b/Master/tlpkg/TeXLive/TLMedia.pm
index 344b4a0d2b7..70c5cd67679 100644
--- a/Master/tlpkg/TeXLive/TLMedia.pm
+++ b/Master/tlpkg/TeXLive/TLMedia.pm
@@ -8,9 +8,8 @@
package TeXLive::TLMedia;
use TeXLive::TLConfig;
-use TeXLive::TLPostActions;
use TeXLive::TLUtils qw(copy win32 dirname mkdirhier basename download_file
- merge_into debug ddebug info tlwarn);
+ merge_into debug ddebug info tlwarn log);
use TeXLive::TLPDB;
sub new
@@ -42,7 +41,7 @@ sub new
}
}
debug("Loading $location/$InfraLocation/$DatabaseName ...\n");
- my $tlpdb = TeXLive::TLPDB->new(root => "$location");
+ my $tlpdb = TeXLive::TLPDB->new(root => $location);
return(undef) unless defined($tlpdb);
my (@all_c, @std_c, @lang_c, @lang_doc_c);
my (@schemes);
@@ -117,6 +116,7 @@ sub install_package {
# even if opt_doc is false
$real_opt_doc = 1;
}
+ my $reloc = 1 if $tlpobj->relocated;
my $container;
my @installfiles;
my $location = $self->location;
@@ -146,16 +146,17 @@ sub install_package {
} elsif ($media eq 'CD') {
if (-r "$location/$Archive/$pkg.zip") {
$container = "$location/$Archive/$pkg.zip";
- } elsif (-r "$location/$Archive/$pkg.tar.lzma") {
- $container = "$location/$Archive/$pkg.tar.lzma";
+ } elsif (-r "$location/$Archive/$pkg.tar.xz") {
+ $container = "$location/$Archive/$pkg.tar.xz";
} else {
- tlwarn("Cannot find a package $pkg (.zip or .lzma) in $location/$Archive\n");
+ tlwarn("Cannot find a package $pkg (.zip or .xz) in $location/$Archive\n");
next;
}
} elsif (&media eq 'NET') {
$container = "$location/$Archive/$pkg.$DefaultContainerExtension";
}
- $self->_install_package($container,\@installfiles,$totlpdb) || return(0);
+ $self->_install_package ($container, $reloc, \@installfiles, $totlpdb)
+ || return(0);
# if we are installing from CD or NET we have to fetch the respective
# source and doc packages $pkg.source and $pkg.doc and install them, too
if (($media eq 'NET') || ($media eq 'CD')) {
@@ -164,21 +165,39 @@ sub install_package {
# - src/doc files should be installed
# (- the package is not already a split one (like .i386-linux))
# the above test has been removed because it would mean that
- # texlive.infra.doc.tar.lzma
+ # texlive.infra.doc.tar.xz
# will never be installed, and we do already check that there
# are at all src/doc files, which in split packages of the form
# foo.ARCH are not present. And if they are present, than that is fine,
- # too (bin-foobar.win32.doc.tar.lzma)
+ # too (bin-foobar.win32.doc.tar.xz)
# - there are actually src/doc files present
if ($container_src_split && $opt_src && $tlpobj->srcfiles) {
my $srccontainer = $container;
- $srccontainer =~ s/(\.tar\.lzma|\.zip)$/.source$1/;
- $self->_install_package($srccontainer,\@installfiles,$totlpdb) || return(0);
+ $srccontainer =~ s/(\.tar\.xz|\.zip)$/.source$1/;
+ $self->_install_package ($srccontainer, $reloc, \@installfiles, $totlpdb)
+ || return(0);
}
if ($container_doc_split && $real_opt_doc && $tlpobj->docfiles) {
my $doccontainer = $container;
- $doccontainer =~ s/(\.tar\.lzma|\.zip)$/.doc$1/;
- $self->_install_package($doccontainer,\@installfiles,$totlpdb) || return(0);
+ $doccontainer =~ s/(\.tar\.xz|\.zip)$/.doc$1/;
+ $self->_install_package ($doccontainer, $reloc, \@installfiles, $totlpdb)
+ || return(0);
+ }
+ #
+ # if we installed from NET/CD and we got a relocatable container
+ # make sure that the stray texmf-dist/tlpkg directory is removed
+ # in USER MODE that should NOT be done because we keep the information
+ # there, but for now do it unconditionally
+ if ($tlpobj->relocated) {
+ my $reloctree = $totlpdb->root . "/" . $TeXLive::TLConfig::RelocTree;
+ my $tlpkgdir = $reloctree . "/" . $TeXLive::TLConfig::InfraLocation;
+ my $tlpod = $tlpkgdir . "/tlpobj";
+ TeXLive::TLUtils::rmtree($tlpod) if (-d $tlpod);
+ # we try to remove the tlpkg directory, that will succeed only
+ # if it is empty. So in normal installations it won't be, but
+ # if we are installing a relocated package it is texmf-dist/tlpkg
+ # which will be (hopefully) empty
+ rmdir($tlpkgdir) if (-d "$tlpkgdir");
}
}
# we don't want to have wrong information in the tlpdb, so remove the
@@ -190,7 +209,7 @@ sub install_package {
$tlpobj->clear_docfiles;
}
# we have to write out the tlpobj file since it is contained in the
- # archives (.tar.lzma) but at DVD install time we don't have them
+ # archives (.tar.xz) but at DVD install time we don't have them
my $tlpod = $totlpdb->root . "/tlpkg/tlpobj";
mkdirhier( $tlpod );
open(TMP,">$tlpod/".$tlpobj->name.".tlpobj") or
@@ -204,10 +223,12 @@ sub install_package {
merge_into(\%ret, $tlpobj->make_return_hash_from_executes("enable"));
if (!$nopostinstall) {
# do the postinstallation actions
- if (defined($PostInstall{$pkg})) {
- info("running post install action for $pkg\n");
- &{$PostInstall{$pkg}}($totlpdb->root);
- }
+ #
+ # Run the post installation code in the postaction tlpsrc entries
+ &TeXLive::TLUtils::do_postaction("install", $tlpobj,
+ $totlpdb->option_file_assocs,
+ $totlpdb->option_desktop_integration,
+ $totlpdb->option_post_code);
}
return \%ret;
}
@@ -219,17 +240,18 @@ sub install_package {
# returns 1 on success and 0 on error
#
sub _install_package {
- my ($self, $what, $filelistref, $totlpdb) = @_;
+ my ($self, $what, $reloc, $filelistref, $totlpdb) = @_;
my $media = $self->media;
my $target = $totlpdb->root;
+ my $tempdir = "$target/temp";
my @filelist = @$filelistref;
# we assume that $::progs has been set up!
my $wget = $::progs{'wget'};
- my $lzmadec = $::progs{'lzmadec'};
- if (!defined($wget) || !defined($lzmadec)) {
+ my $xzdec = $::progs{'xzdec'};
+ if (!defined($wget) || !defined($xzdec)) {
tlwarn("_install_package: programs not set up properly, strange.\n");
return(0);
}
@@ -246,27 +268,31 @@ sub _install_package {
}
# we always assume that copy will work
return(1);
- } elsif ($what =~ m,\.tar(\.lzma)?$,) {
- my $type = defined($1) ? "lzma" : "tar";
+ } elsif ($what =~ m,\.tar(\.xz)?$,) {
+ my $type = defined($1) ? "xz" : "tar";
+ $target .= "/$TeXLive::TLConfig::RelocTree" if $reloc;
+
# this is the case when we install from CD or the NET, or a backup
#
- # in all other cases we create temp files .tar.lzma (or use the present
- # one), lzmadec them, and then call tar
+ # in all other cases we create temp files .tar.xz (or use the present
+ # one), xzdec them, and then call tar
my $fn = basename($what);
- mkdirhier("$target/temp");
+ my $pkg = $fn;
+ $pkg =~ s/\.tar(\.xz)?$//;
+ mkdirhier("$tempdir");
my $tarfile;
my $remove_tarfile = 1;
- if ($type eq "lzma") {
- my $lzmafile = "$target/temp/$fn";
- $tarfile = "$target/temp/$fn"; $tarfile =~ s/\.lzma$//;
- my $lzmafile_quote = $lzmafile;
+ if ($type eq "xz") {
+ my $xzfile = "$tempdir/$fn";
+ $tarfile = "$tempdir/$fn"; $tarfile =~ s/\.xz$//;
+ my $xzfile_quote = $xzfile;
my $tarfile_quote = $tarfile;
my $target_quote = $target;
if (win32()) {
- $lzmafile =~ s!/!\\!g;
- $lzmafile_quote = "\"$lzmafile\"";
+ $xzfile =~ s!/!\\!g;
+ $xzfile_quote = "\"$xzfile\"";
$tarfile =~ s!/!\\!g;
$tarfile_quote = "\"$tarfile\"";
$target =~ s!/!\\!g;
@@ -275,28 +301,28 @@ sub _install_package {
if ($what =~ m,http://|ftp://,) {
# we are installing from the NET
# download the file and put it into temp
- if (!download_file($what, $lzmafile) || (! -r $lzmafile)) {
+ if (!download_file($what, $xzfile) || (! -r $xzfile)) {
tlwarn("Downloading \n");
tlwarn(" $what\n");
tlwarn("did not succeed, please retry.\n");
- unlink($tarfile, $lzmafile);
+ unlink($tarfile, $xzfile);
return(0);
}
} else {
# we are installing from CD
# copy it to temp
- copy($what, "$target/temp");
+ copy($what, $tempdir);
}
- debug("un-lzmaing $lzmafile to $tarfile\n");
- system("$lzmadec < $lzmafile_quote > $tarfile_quote");
+ debug("un-xzing $xzfile to $tarfile\n");
+ system("$xzdec < $xzfile_quote > $tarfile_quote");
if (! -f $tarfile) {
- tlwarn("_install_package: Unpacking $lzmafile failed, please retry.\n");
- unlink($tarfile, $lzmafile);
+ tlwarn("_install_package: Unpacking $xzfile failed, please retry.\n");
+ unlink($tarfile, $xzfile);
return(0);
}
- unlink($lzmafile);
+ unlink($xzfile);
} else {
- $tarfile = "$target/temp/$fn";
+ $tarfile = "$tempdir/$fn";
if ($what =~ m,http://|ftp://,) {
if (!download_file($what, $tarfile) || (! -r $tarfile)) {
tlwarn("Downloading \n");
@@ -310,13 +336,125 @@ sub _install_package {
$remove_tarfile = 0;
}
}
- return TeXLive::TLUtils::untar($tarfile, $target, $remove_tarfile);
+ my $ret = TeXLive::TLUtils::untar($tarfile, $target, $remove_tarfile);
+ # remove the $pkg.tlpobj, we recreate it anyway again
+ unlink ("$target/tlpkg/tlpobj/$pkg.tlpobj")
+ if (-r "$target/tlpkg/tlpobj/$pkg.tlpobj");
+ return $ret;
} else {
tlwarn("_install_package: Don't know how to install $what\n");
return(0);
}
}
+#
+# remove_package removes a single package with all files (including the
+# # tlpobj files) and the entry from the tlpdb.
+sub remove_package {
+ my ($self, $pkg, $nopostinstall) = @_;
+ my $localtlpdb = $self->tlpdb;
+ my $tlp = $localtlpdb->get_package($pkg);
+ my %ret;
+ if (!defined($tlp)) {
+ tlwarn ("$pkg: package not present, cannot remove\n");
+ } else {
+ if ($pkg =~ m/^texlive\.infra/) {
+ log ("Not removing $pkg, it is essential!\n");
+ return;
+ }
+ # we have to chdir to $localtlpdb->root
+ my $Master = $localtlpdb->root;
+ chdir ($Master) || die "chdir($Master) failed: $!";
+ my @files = $tlp->all_files;
+ # also remove the .tlpobj file
+ push @files, "tlpkg/tlpobj/$pkg.tlpobj";
+ # and the ones from src/doc splitting
+ if (-r "tlpkg/tlpobj/$pkg.source.tlpobj") {
+ push @files, "tlpkg/tlpobj/$pkg.source.tlpobj";
+ }
+ if (-r "tlpkg/tlpobj/$pkg.doc.tlpobj") {
+ push @files, "tlpkg/tlpobj/$pkg.doc.tlpobj";
+ }
+ #
+ # some packages might be relocated, thus having the RELOC prefix
+ # in user mode we just remove the prefix, in normal mode we
+ # replace it with texmf-dist
+ # since we don't have user mode
+ if ($tlp->relocated) {
+ for (@files) {
+ s:^$RelocPrefix/:$RelocTree/:;
+ }
+ }
+ #
+ # we want to check that a file is only listed in one package, so
+ # in case that a file to be removed is listed in another package
+ # we will warn and *not* remove it
+ my %allfiles;
+ for my $p ($localtlpdb->list_packages) {
+ next if ($p eq $pkg); # we have to skip the to be removed package
+ for my $f ($localtlpdb->get_package($p)->all_files) {
+ $allfiles{$f} = $p;
+ }
+ }
+ my @goodfiles = ();
+ my @badfiles = ();
+ for my $f (@files) {
+ # in usermode we have to add texmf-dist again for comparison
+ if (defined($allfiles{$f})) {
+ # this file should be removed but is mentioned somewhere, too
+ push @badfiles, $f;
+ } else {
+ push @goodfiles, $f;
+ }
+ }
+ if ($#badfiles >= 0) {
+ # warn the user
+ tlwarn("The following files should be removed due to the removal of $pkg,\n");
+ tlwarn("but are part of another package, too.\n");
+ for my $f (@badfiles) {
+ tlwarn(" $f - $allfiles{$f}\n");
+ }
+ }
+ #
+ # Run only the postaction code thing now since afterwards the
+ # files will be gone ...
+ if (!$nopostinstall) {
+ &TeXLive::TLUtils::do_postaction("remove", $tlp,
+ 0, # option_file_assocs,
+ 0, # option_desktop_integration,
+ $localtlpdb->option_post_code);
+ }
+ #
+ # now do the removal
+ foreach my $entry (@goodfiles) {
+ unlink $entry;
+ }
+ tlwarn("MISSING REMOVAL OF EMPTY DIRECTORIES: sub removed_dirs needed!\n");
+ #my @removals = &removed_dirs (@goodfiles);
+ #foreach my $entry (@removals) {
+ # rmdir $entry;
+ #}
+ $localtlpdb->remove_package($pkg);
+ merge_into(\%ret, $tlp->make_return_hash_from_executes("disable"));
+ $ret{'mktexlsr'} = 1;
+ # should we save at each removal???
+ # advantage: the tlpdb actually reflects what is installed
+ # disadvantage: removing a collection calls the save routine several times
+ # still I consider it better that the tlpdb is in a consistent state
+ $localtlpdb->save;
+ #
+ # 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,
+ 0);
+ }
+ }
+ return \%ret;
+}
# member access functions
@@ -344,10 +482,9 @@ C<TeXLive::TLMedia> -- TeX Live Media module
use TeXLive::TLMedia;
- my $tlnet = TeXLive::TLMedia->new('NET');
- my $tlneo = TeXLive::TLMedia->new('NET','http://www.ctan.org/mirror/tl/');
- my $tlcd = TeXLive::TLMedia->new('CD','/mnt/tl-cd/');
- my $tldvd = TeXLive::TLMedia->new('DVD','/mnt/tl-dvd/');
+ my $tlneo = TeXLive::TLMedia->new('http://www.ctan.org/mirror/tl/');
+ my $tlcd = TeXLive::TLMedia->new('/mnt/tl-cd/');
+ my $tldvd = TeXLive::TLMedia->new('/mnt/tl-dvd/');
=head1 DESCRIPTION