summaryrefslogtreecommitdiff
path: root/Master/tlpkg/TeXLive
diff options
context:
space:
mode:
authorNorbert Preining <preining@logic.at>2009-05-12 15:53:11 +0000
committerNorbert Preining <preining@logic.at>2009-05-12 15:53:11 +0000
commit7e5585bcd4f8ba119cad8f0a7e13b6a7a610776f (patch)
treec48db3cea0e4511d09d0e7b7fdf7ef7a04f68f6e /Master/tlpkg/TeXLive
parentc84165218f94bc15a1441e91a421f4d070bc5eb7 (diff)
Move most of the stuff from tlpkg, tlmgr from branch to trunk
git-svn-id: svn://tug.org/texlive/trunk@13054 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/TeXLive')
-rw-r--r--Master/tlpkg/TeXLive/TLConfig.pm28
-rw-r--r--Master/tlpkg/TeXLive/TLMedia.pm229
-rw-r--r--Master/tlpkg/TeXLive/TLPDB.pm187
-rw-r--r--Master/tlpkg/TeXLive/TLPOBJ.pm168
-rw-r--r--Master/tlpkg/TeXLive/TLPSRC.pm71
-rw-r--r--Master/tlpkg/TeXLive/TLTREE.pm10
-rw-r--r--Master/tlpkg/TeXLive/TLUtils.pm399
-rw-r--r--Master/tlpkg/TeXLive/TLWinGoo.pm48
8 files changed, 887 insertions, 253 deletions
diff --git a/Master/tlpkg/TeXLive/TLConfig.pm b/Master/tlpkg/TeXLive/TLConfig.pm
index f75ed3b392d..a148fc0ae31 100644
--- a/Master/tlpkg/TeXLive/TLConfig.pm
+++ b/Master/tlpkg/TeXLive/TLConfig.pm
@@ -11,6 +11,7 @@ BEGIN {
use vars qw( @ISA @EXPORT_OK @EXPORT );
@ISA = qw(Exporter);
@EXPORT_OK = qw(
+ $ReleaseYear
@MetaCategories
@NormalCategories
@Categories
@@ -28,10 +29,17 @@ BEGIN {
$WinSpecialUpdatePackagesRegexp
@CriticalPackagesList
@AllowedConfigOptions
+ $WindowsMainMenuName
+ $RelocPrefix
+ $RelocTree
);
@EXPORT = @EXPORT_OK;
}
+# the year of our release, will be used in the location of the
+# network packges, and in menu names, and probably many other places
+$ReleaseYear = 2009;
+
# Meta Categories do not ship files, but call only for other packages
our @MetaCategories = qw/Collection Scheme/;
our $MetaCategoriesRegexp = '(Collection|Scheme)';
@@ -53,17 +61,20 @@ our $DatabaseName = "texlive.tlpdb";
our $BlockSize = 4096;
# the way we package things on the web
-our $DefaultContainerExtension = "tar.lzma";
+our $DefaultContainerExtension = "tar.xz";
our $Archive = "archive";
our $TeXLiveServerURL = "http://mirror.ctan.org";
-our $TeXLiveServerPath = "systems/texlive/tlnet/2008";
+our $TeXLiveServerPath = "systems/texlive/tlnet/$ReleaseYear";
our $TeXLiveURL = "$TeXLiveServerURL/$TeXLiveServerPath";
+our $RelocTree = "texmf-dist";
+our $RelocPrefix = "RELOC";
our $WinSpecialUpdatePackagesRegexp =
'^(texlive\.infra|bin-tlperl\.win32$|bin-texlive)';
+
our @CriticalPackagesList = qw/texlive.infra bin-texlive/;
push(@CriticalPackagesList, "bin-tlperl.win32") if ($^O=~/^MSWin(32|64)$/i);
@@ -84,6 +95,8 @@ our @AllowedConfigOptions = qw/
autobackup
/;
+our $WindowsMainMenuName = "TeX Live $ReleaseYear";
+
1;
@@ -165,7 +178,16 @@ since they are too central, currently bin-texlive and texlive.infra.
=item C<@TeXLive::TLConfig::AllowedConfigOptions>
-A list of a config options that can be set in 00texlive-installation.config.
+A list of a config options that can be set in 00texlive.installation.
+
+=item C<$TeXLive::TLConfig::RelocTree>
+
+the texmf-tree name that can be relocated, defaults to "texmf-dist"
+
+=item C<$TeXLive::TLConfig::RelocPrefix>
+
+The string that replaces the RelocTree in the tlpdb if a package is
+reloaced, defaults to "RELOC".
=back
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
diff --git a/Master/tlpkg/TeXLive/TLPDB.pm b/Master/tlpkg/TeXLive/TLPDB.pm
index 0fdf61039ec..bd0458c963e 100644
--- a/Master/tlpkg/TeXLive/TLPDB.pm
+++ b/Master/tlpkg/TeXLive/TLPDB.pm
@@ -214,49 +214,49 @@ sub from_file {
my $tlpdbfile;
if ($path =~ m;^((http|ftp)://|file:\/\/*);) {
debug("TLPDB.pm: trying to initialize from $path\n");
- # if we have lzmadec available we try the lzma file
- if (defined($::progs{'lzmadec'})) {
- # we first try the lzma compressed file
+ # if we have xzdec available we try the xz file
+ if (defined($::progs{'xzdec'})) {
+ # we first try the xz compressed file
my $tmpdir = TeXLive::TLUtils::get_system_tmpdir();
my $bn = TeXLive::TLUtils::basename("$path");
- my $lzmafile = "$tmpdir/$bn.$$.lzma";
- my $lzmafile_quote = $lzmafile;
+ my $xzfile = "$tmpdir/$bn.$$.xz";
+ my $xzfile_quote = $xzfile;
# this is a variable of the whole sub as we have to remove the file
# before returning
$tlpdbfile = "$tmpdir/$bn.$$";
my $tlpdbfile_quote = $tlpdbfile;
if (win32()) {
- $lzmafile =~ s!/!\\!g;
+ $xzfile =~ s!/!\\!g;
$tlpdbfile =~ s!/!\\!g;
}
- $lzmafile_quote = "\"$lzmafile\"";
+ $xzfile_quote = "\"$xzfile\"";
$tlpdbfile_quote = "\"$tlpdbfile\"";
- debug("trying to download $path.lzma to $lzmafile\n");
- my $ret = TeXLive::TLUtils::download_file("$path.lzma", "$lzmafile");
+ debug("trying to download $path.xz to $xzfile\n");
+ my $ret = TeXLive::TLUtils::download_file("$path.xz", "$xzfile");
# better to check both, the return value AND the existence of the file
- if ($ret && (-r "$lzmafile")) {
+ if ($ret && (-r "$xzfile")) {
# ok, let the fun begin
- debug("un-lzmaing $lzmafile to $tlpdbfile\n");
- # lzmadec *hopefully* returns 0 on success and anything else on failure
+ debug("un-xzing $xzfile to $tlpdbfile\n");
+ # xzdec *hopefully* returns 0 on success and anything else on failure
# we don't have to negate since not zero means error in the shell
# and thus in perl true
- if (system("$::progs{'lzmadec'} <$lzmafile_quote >$tlpdbfile_quote")) {
- debug("un-lzmaing $lzmafile failed, tryin gplain file\n");
- # to be sure we unlink the lzma file and the tlpdbfile
- unlink($lzmafile);
+ if (system("$::progs{'xzdec'} <$xzfile_quote >$tlpdbfile_quote")) {
+ debug("un-xzing $xzfile failed, tryin gplain file\n");
+ # to be sure we unlink the xz file and the tlpdbfile
+ unlink($xzfile);
unlink($tlpdbfile);
} else {
- unlink($lzmafile);
+ unlink($xzfile);
open($retfh, "<$tlpdbfile") || die "$0: open($tlpdbfile) failed: $!";
- debug("found the uncompressed lzma file\n");
+ debug("found the uncompressed xz file\n");
}
}
} else {
- debug("no lzmadec defined, not trying tlpdb.lzma ...\n");
+ debug("no xzdec defined, not trying tlpdb.xz ...\n");
}
if (!defined($retfh)) {
- debug("TLPDB: downloading $path.lzma didn't succeed, try $path\n");
- # lzma did not succeed, so try the normal file
+ debug("TLPDB: downloading $path.xz didn't succeed, try $path\n");
+ # xz did not succeed, so try the normal file
$retfh = TeXLive::TLUtils::download_file($path, "|");
if (!$retfh) {
die "open tlpdb($path) failed: $!";
@@ -277,7 +277,7 @@ sub from_file {
}
} until (!$ret);
tlwarn("unusable location $path, could not load any packages\n") if (!$found);
- # remove the un-lzma-ed tlpdb file from temp dir
+ # remove the un-xz-ed tlpdb file from temp dir
# THAT IS RACY!!! we should fix that in some better way with tempfile
unlink($tlpdbfile) if $tlpdbfile;
return($found);
@@ -394,13 +394,13 @@ sub _add_tlpcontainer {
$container .= ".zip";
$unpackprog="unzip";
$args="-o -qq $container -d $dest";
- } elsif (-r "$container.lzma") {
- $container .= ".lzma";
+ } elsif (-r "$container.xz") {
+ $container .= ".xz";
$unpackprog="NO_IDEA_HOW_TO_UNPACK_LZMA";
$args="NO IDEA WHAT ARGS IT NEEDS";
- die "$0: lzma checked for but not implemented, maybe update TLPDB.pm";
+ die "$0: xz checked for but not implemented, maybe update TLPDB.pm";
} else {
- die "$0: No package $container (.zip or .lzma) in $ziplocation";
+ die "$0: No package $container (.zip or .xz) in $ziplocation";
}
tlwarn("Huuu, this needs testing and error checking!\n");
tlwarn("Should we use -a -- adapt line endings etc?\n");
@@ -788,7 +788,7 @@ Return the location of the actual C<texlive.tlpdb> file used. This is a
read-only function; you cannot change the root of the TLPDB using this
function.
-See C<00texlive-installation.config.tlpsrc> for a description of the
+See C<00texlive.installation.tlpsrc> for a description of the
special value C<__MASTER>.
=cut
@@ -1110,12 +1110,16 @@ Need to be documented
=cut
sub _set_option_value {
- my ($self,$key,$value) = @_;
- my $pkg = $self->{'tlps'}{'00texlive-installation.config'};
+ my $self = shift;
+ $self->_set_option_value_pkg('00texlive.installation', @_);
+}
+sub _set_option_value_pkg {
+ my ($self,$pkgname,$key,$value) = @_;
+ my $pkg = $self->{'tlps'}{$pkgname};
my @newdeps;
if (!defined($pkg)) {
$pkg = new TeXLive::TLPOBJ;
- $pkg->name("00texlive-installation.config");
+ $pkg->name($pkgname);
$pkg->category("TLCore");
push @newdeps, "$key:$value";
} else {
@@ -1133,20 +1137,25 @@ sub _set_option_value {
}
}
$pkg->depends(@newdeps);
- $self->{'tlps'}{'00texlive-installation.config'} = $pkg;
+ $self->{'tlps'}{$pkgname} = $pkg;
}
sub _option_value {
- my ($self,$key) = @_;
- if (defined($self->{'tlps'}{'00texlive-installation.config'})) {
- foreach my $d ($self->{'tlps'}{'00texlive-installation.config'}->depends) {
+ my $self = shift;
+ $self->_option_value_pkg('00texlive.installation', @_);
+}
+
+sub _option_value_pkg {
+ my ($self,$pkg,$key) = @_;
+ if (defined($self->{'tlps'}{$pkg})) {
+ foreach my $d ($self->{'tlps'}{$pkg}->depends) {
if ($d =~ m!^$key:(.*)$!) {
return "$1";
}
}
return;
}
- tlwarn("00texlive-installation.config not found, cannot read option $key.\n");
+ tlwarn("$pkg not found, cannot read option $key.\n");
return;
}
@@ -1156,6 +1165,15 @@ sub option {
if (@_) { $self->_set_option_value($key, shift); }
return $self->_option_value($key);
}
+
+sub option_pkg {
+ my $self = shift;
+ my $pkg = shift;
+ my $key = shift;
+ if (@_) { $self->_set_option_value_pkg($pkg, $key, shift); }
+ return $self->_option_value_pkg($pkg, $key);
+}
+
# TODO the above function should be used in the functions below as
# far as possible ...
@@ -1179,6 +1197,31 @@ sub option_create_symlinks {
if (@_) { $self->_set_option_value("opt_create_symlinks", shift); }
return $self->_option_value("opt_create_symlinks");
}
+sub option_desktop_integration {
+ my $self = shift;
+ if (@_) { $self->_set_option_value("opt_desktop_integration", shift); }
+ return $self->_option_value("opt_desktop_integration");
+}
+sub option_file_assocs {
+ my $self = shift;
+ if (@_) { $self->_set_option_value("opt_file_assocs", shift); }
+ return $self->_option_value("opt_file_assocs");
+}
+sub option_post_code {
+ my $self = shift;
+ if (@_) { $self->_set_option_value("opt_post_code", shift); }
+ return $self->_option_value("opt_post_code");
+}
+sub option_path {
+ my $self = shift;
+ if (@_) { $self->_set_option_value("opt_path", shift); }
+ return $self->_option_value("opt_path");
+}
+sub option_w32_multi_user {
+ my $self = shift;
+ if (@_) { $self->_set_option_value("opt_w32_multi_user", shift); }
+ return $self->_option_value("opt_w32_multi_user");
+}
sub option_install_docfiles {
my $self = shift;
if (@_) { $self->_set_option_value("opt_install_docfiles", shift); }
@@ -1239,26 +1282,64 @@ containing only those formats present in the installation.
=cut
sub fmtutil_cnf_lines {
my $self = shift;
- my %fmtcnffiles;
- foreach my $p ($self->list_packages) {
- my $obj = $self->get_package ($p);
- die "$0: No TeX Live package named $p, strange" if ! $obj;
+ my @fmtlines = ();
+
+ foreach my $pkg ($self->list_packages) {
+ my $obj = $self->get_package ($pkg);
+ die "No TeX Live package named $pkg, too strange" if ! $obj;
+ my $first = 1;
foreach my $e ($obj->executes) {
- if ($e =~ m/BuildFormat (.*)$/) {
- $fmtcnffiles{$1} = 1;
- }
- # others are ignored here
+ if ($e =~ m/AddFormat\s+(.*)\s*/) {
+ my $name;
+ my $engine;
+ my $patterns = "-";
+ my $options = "";
+ my $mode = "";
+ if ($first) {
+ push @fmtlines, "# from $pkg:\n";
+ $first = 0;
+ }
+ foreach my $p (&TeXLive::TLUtils::quotewords('\s+', 0, "$1")) {
+ # foreach my $p (split(' ', $1)) {
+ my ($a, $b);
+ if ($p =~ m/^(name|engine|mode|patterns|options)=(.*)$/) {
+ $a = $1;
+ $b = $2;
+ } else {
+ die "Unknown format directive in $pkg: $e";
+ }
+ if ($a eq "name") {
+ die "AddFormat line needs name=something: $pkg, $e" unless $b;
+ $name = $b; next;
+ }
+ if ($a eq "engine") {
+ die "AddFormat line needs engine=something: $pkg, $e" unless $b;
+ $engine = $b; next;
+ }
+ if ($a eq "patterns") {
+ $patterns = ( $b ? $b : "-");
+ next;
+ }
+ if ($a eq "mode") {
+ if ($b eq "disabled") {
+ $mode = "#! ";
+ } else {
+ $mode = "";
+ }
+ next;
+ }
+ if ($a eq "options") {
+ $options = ( $b ? $b : "");
+ next;
+ }
+ # should not be reached at all
+ die "Unknown language directive in $pkg: $e";
+ }
+ push @fmtlines, "$mode$name $engine $patterns $options\n";
+ }
}
}
- my @formatlines;
- foreach my $f (sort keys %fmtcnffiles) {
- open(INFILE,"<$self->{'root'}/texmf/fmtutil/format.$f.cnf")
- or tlwarn("Cannot open $self->{'root'}/texmf/fmtutil/format.$f.cnf\nThe generated fmtutil.cnf file might be incomplete.\nError: $!\n");
- @tmp = <INFILE>;
- close(INFILE);
- push @formatlines, @tmp;
- }
- return(@formatlines);
+ return @fmtlines;
}
=item C<< $tlpdb->updmap_cfg_lines >>
@@ -1420,7 +1501,7 @@ named C<package.source.extension> and C<package.doc.extension>.
=item C<container_format/I<format>>
This option specifies a format for containers. The currently supported
-formats are C<lzma> and C<zip>. But note that C<zip> is untested.
+formats are C<xz> and C<zip>. But note that C<zip> is untested.
=back
diff --git a/Master/tlpkg/TeXLive/TLPOBJ.pm b/Master/tlpkg/TeXLive/TLPOBJ.pm
index 06233187de8..6b08caf8067 100644
--- a/Master/tlpkg/TeXLive/TLPOBJ.pm
+++ b/Master/tlpkg/TeXLive/TLPOBJ.pm
@@ -6,7 +6,9 @@
package TeXLive::TLPOBJ;
-use TeXLive::TLConfig qw($DefaultCategory $CategoriesRegexp $MetaCategoriesRegexp $InfraLocation);
+use TeXLive::TLConfig qw($DefaultCategory $CategoriesRegexp
+ $MetaCategoriesRegexp $InfraLocation
+ $RelocPrefix $RelocTree);
use TeXLive::TLUtils;
use TeXLive::TLTREE;
@@ -22,6 +24,7 @@ sub new {
shortdesc => $params{'shortdesc'},
longdesc => $params{'longdesc'},
catalogue => $params{'catalogue'},
+ relocated => $params{'relocated'},
runfiles => defined($params{'runfiles'}) ? $params{'runfiles'} : [],
runsize => $params{'runsize'},
srcfiles => defined($params{'srcfiles'}) ? $params{'srcfiles'} : [],
@@ -29,6 +32,7 @@ sub new {
docfiles => defined($params{'docfiles'}) ? $params{'docfiles'} : [],
docsize => $params{'docsize'},
executes => defined($params{'executes'}) ? $params{'executes'} : [],
+ postactions => defined($params{'postactions'}) ? $params{'postactions'} : [],
# note that binfiles is a HASH with keys of $arch!
binfiles => defined($params{'binfiles'}) ? $params{'binfiles'} : {},
binsize => defined($params{'binsize'}) ? $params{'binsize'} : {},
@@ -92,6 +96,7 @@ sub from_fh {
($lastcmd eq "docfiles") ||
($lastcmd eq "srcfiles") ||
($lastcmd eq "executes") ||
+ ($lastcmd eq "postaction") ||
($lastcmd eq "depend") ) {
$line =~ s/^ /${lastcmd}continued /;
} else {
@@ -163,6 +168,10 @@ sub from_fh {
$self->{'category'} = "$1";
$lastcmd = "category";
next;
+ } elsif ($line =~ /^relocated\s+([01])\s*/o) {
+ $self->relocated("$1");
+ $lastcmd = "relocated";
+ next;
} elsif ($line =~ /^revision\s+(.*)\s*/o) {
$self->{'revision'} = "$1";
$lastcmd = "revision";
@@ -216,6 +225,10 @@ sub from_fh {
push @{$self->{'executes'}}, "$2" unless "$2" eq "";
$lastcmd = "execute";
next;
+ } elsif ($line =~ /^postaction(continued)?\s*(.*)\s*/o) {
+ push @{$self->{'postactions'}}, "$2" unless "$2" eq "";
+ $lastcmd = "postaction";
+ next;
} elsif ($line =~ /^depend(continued)?\s*(.*)\s*/o) {
push @{$self->{'depends'}}, "$2" unless "$2" eq "";
$lastcmd = "depend";
@@ -299,6 +312,7 @@ sub writeout {
defined($self->{'catalogue'}) && print $fd "catalogue $self->{'catalogue'}\n";
defined($self->{'shortdesc'}) && print $fd "shortdesc $self->{'shortdesc'}\n";
defined($self->{'license'}) && print $fd "license $self->{'license'}\n";
+ defined($self->{'relocated'}) && $self->{'relocated'} && print $fd "relocated 1\n";
# ugly hack to get rid of use FileHandle; see man perlform
#format_name $fd "multilineformat";
select((select($fd),$~ = "multilineformat")[0]);
@@ -316,6 +330,11 @@ sub writeout {
print $fd "execute $_\n";
}
}
+ if (defined($self->{'postactions'})) {
+ foreach (@{$self->{'postactions'}}) {
+ print $fd "postaction $_\n";
+ }
+ }
if (defined($self->{'containersize'})) {
print $fd "containersize $self->{'containersize'}\n";
}
@@ -388,6 +407,11 @@ sub writeout_simple {
print $fd "execute $_\n";
}
}
+ if (defined($self->{'postactions'})) {
+ foreach (@{$self->{'postactions'}}) {
+ print $fd "postaction $_\n";
+ }
+ }
if (defined($self->{'docfiles'}) && (@{$self->{'docfiles'}})) {
print $fd "docfiles\n";
foreach (sort @{$self->{'docfiles'}}) {
@@ -416,44 +440,70 @@ sub writeout_simple {
}
}
+sub cancel_common_texmf_tree {
+ my $self = shift;
+ my @docfiles = $self->docfiles;
+ for (@docfiles) { s:^$RelocTree/:$RelocPrefix/:; }
+ $self->docfiles(@docfiles);
+ my @runfiles = $self->runfiles;
+ for (@runfiles) { s:^$RelocTree/:$RelocPrefix/:; }
+ $self->runfiles(@runfiles);
+ my @srcfiles = $self->srcfiles;
+ for (@srcfiles) { s:^$RelocTree/:$RelocPrefix/:; }
+ $self->srcfiles(@srcfiles);
+ # if there are bin files they have definitely NOT the
+ # texmf-dist prefix, so we cannot cancel it anyway
+}
+
+sub common_texmf_tree {
+ my $self = shift;
+ my $tltree;
+ my $dd = 0;
+ my @files = $self->all_files;
+ foreach ($self->all_files) {
+ my $tmp;
+ ($tmp) = split m@/@;
+ if (defined($tltree) && ($tltree ne $tmp)) {
+ return;
+ } else {
+ $tltree = $tmp;
+ }
+ }
+ # if there are no files then it is by default relocatable, so
+ # return the right tree
+ if (!@files) {
+ $tltree = $RelocTree;
+ }
+ return $tltree;
+}
+
-sub make_container
-{
+sub make_container {
my ($self,$type,$instroot,$destdir,$containername,$relative) = @_;
- if (($type ne "lzma") && ($type ne "tar")) {
- die "$0: TLPOBJ supports tar and lzma containers, not $type";
+ if (($type ne "xz") && ($type ne "tar")) {
+ die "$0: TLPOBJ supports tar and xz containers, not $type";
}
if (!defined($containername)) {
$containername = $self->name;
}
- my @files = ();
+ my @files = $self->all_files;
my $compresscmd;
my $tlpobjdir = "$InfraLocation/tlpobj";
- my %binf = %{$self->{'binfiles'}};
- foreach (keys %binf) {
- push @files, @{$binf{$_}};
- }
- push @files, $self->runfiles;
- push @files, $self->docfiles;
- push @files, $self->srcfiles;
@files = TeXLive::TLUtils::sort_uniq(@files);
# we do relative packages ONLY if the files do NOT span multiple
# texmf trees. check this here
my $tltree;
if ($relative) {
- foreach (@files) {
- my $tmp;
- ($tmp) = split m@/@;
- if (defined($tltree) && ($tltree ne $tmp)) {
- die ("$0: package $containername spans multiple trees, "
- . "relative generation not allowed");
- } else {
- $tltree = $tmp;
- }
+ $tltree = $self->common_texmf_tree;
+ if (!defined($tltree)) {
+ die ("$0: package $containername spans multiple trees, "
+ . "relative generation not allowed");
}
- my @nf;
- map { s@^$tltree/@@ ; push @nf, $_; } @files;
- @files = @nf;
+ if ($tltree ne $RelocTree) {
+ die ("$0: building $pkg container relocatable but the comon prefix"
+ . "is not $RelocTree");
+ }
+ s,^$RelocTree/,, foreach @files;
}
# load Cwd only if necessary ...
require Cwd;
@@ -468,7 +518,9 @@ sub make_container
# and put the tlpobj into the root!
if ($relative) {
chdir("./$tltree");
- $tlpobjdir = ".";
+ # we don't need to change the $tlpobjdir because we put it in
+ # all cases into tlpkg/tlpobj
+ #$tlpobjdir = "./tlpkg/tlpobj";
}
# we add the .tlpobj into the .tlpobj directory
my $removetlpobjdir = 0;
@@ -485,33 +537,33 @@ sub make_container
if ($type eq "tar") {
$containername = $tarname;
} else {
- $containername = "$tarname.lzma";
+ $containername = "$tarname.xz";
}
# start the fun
my $tar = $::progs{'tar'};
- my $lzma;
+ my $xz;
if (!defined($tar)) {
tlwarn("$0: programs not set up, trying \"tar\".\n");
$tar = "tar";
}
- if ($type eq "lzma") {
- $lzma = $::progs{'lzma'};
- if (!defined($lzma)) {
- tlwarn("$0: programs not set up, trying \"lzma\".\n");
- $lzma = "lzma";
+ if ($type eq "xz") {
+ $xz = $::progs{'xz'};
+ if (!defined($xz)) {
+ tlwarn("$0: programs not set up, trying \"xz\".\n");
+ $xz = "xz";
}
}
# No owner/group options if we are being called on a user's machine to
# make a backup. We only want these when we are making the master
- # containers for tlnet. Also exclude .svn directories when making the
+ # containers for tlnet. Also exclude .svn directories when making the
# masters. We determine user vs. master by whether there's a revision
# suffix in the container name.
my @attrs = $containername =~ /\.r[0-9]/
? () : ("--owner", "0", "--group", "0", "--exclude", ".svn");
my @cmdline = ($tar, "-cf", "$destdir/$tarname", @attrs);
-
+
# Get list of files and symlinks to back up. Nothing else should be
# in the list.
my @files_to_backup = ();
@@ -553,10 +605,14 @@ sub make_container
#
if (length ("@files_to_backup") > 50000) {
@files_to_backup = TeXLive::TLUtils::collapse_dirs(@files_to_backup);
- # Yet another complication. collapse_dirs returns absolute paths.
+ # A complication, as always. collapse_dirs returns absolute paths.
# We want to change them back to relative so that the backup tar
# has the same structure.
+ # in relative mode we have to remove the texmf-dist prefix, too
s,^$instroot/,, foreach @files_to_backup;
+ if ($relative) {
+ s,^$RelocTree/,, foreach @files_to_backup;
+ }
}
push(@cmdline, @files_to_backup);
}
@@ -567,11 +623,11 @@ sub make_container
xsystem(@cmdline);
# compress it.
- if ($type eq "lzma") {
+ if ($type eq "xz") {
if (-r "$destdir/$tarname") {
- system($lzma, "--force", "-z", "$destdir/$tarname");
+ system($xz, "--force", "-z", "$destdir/$tarname");
} else {
- tlwarn("$0: Couldn't find $destdir/$tarname to run $lzma\n");
+ tlwarn("$0: Couldn't find $destdir/$tarname to run $xz\n");
return (0, 0, "");
}
}
@@ -745,7 +801,7 @@ sub split_bin_package {
foreach $a (keys(%binf)) {
my $tlp = new TeXLive::TLPOBJ;
$tlp->name($self->name . ".$a");
- $tlp->shortdesc("binary files of " . $self->name . " for $a");
+ $tlp->shortdesc("$a files of " . $self->name);
$tlp->revision($self->revision);
$tlp->category($self->category);
$tlp->add_binfiles($a,@{$binf{$a}});
@@ -840,7 +896,7 @@ sub make_return_hash_from_executes {
} else {
push @maps, "disable $3";
}
- } elsif ($e =~ m/^BuildFormat\s+([^\s]+)\s*$/) {
+ } elsif ($e =~ m/^AddFormat\s+([^\s]+)\s*$/) {
push @formats, $1;
} elsif ($e =~ m/^AddHyphen\s+(.*)\s*$/) {
push @dats, $1;
@@ -882,6 +938,11 @@ sub revision {
if (@_) { $self->{'revision'} = shift }
return $self->{'revision'};
}
+sub relocated {
+ my $self = shift;
+ if (@_) { $self->{'relocated'} = shift }
+ return ($self->{'relocated'} ? 1 : 0);
+}
sub catalogue {
my $self = shift;
if (@_) { $self->{'catalogue'} = shift }
@@ -1029,6 +1090,11 @@ sub executes {
if (@_) { $self->{'executes'} = [ @_ ] }
return @{ $self->{'executes'} };
}
+sub postactions {
+ my $self = shift;
+ if (@_) { $self->{'postactions'} = [ @_ ] }
+ return @{ $self->{'postactions'} };
+}
sub containerdir {
my @self = shift;
if (@_) { $_containerdir = $_[0] }
@@ -1071,9 +1137,11 @@ Please see L<TeXLive::TLPSRC> documentation for the specification. The
only differences are that the various C<*pattern> keys are invalid, and
instead there are the respective C<*files> keys described below. Furthermore
some more I<keys> is allowed: C<revision> which specifies the maximum of
-all last changed revision of files contained in the package, and anything
+all last changed revision of files contained in the package, anything
starting with C<catalogue-> specifying information coming from the
-TeX Catalogue.
+TeX Catalogue, and C<relocated> taking either 0 or 1 indicating that
+this packages has been relocated, i.e., in the containers the
+initial C<texmf-dist> directory has been stripped off.
All these keys have in common that they are followed by a list of files
I<indented> by one space. They differ only in the first line itself
@@ -1190,7 +1258,7 @@ the C<binsize> function returns (and takes as argument) a hash with the
architectures as keys, similar to the C<runfiles> functions (see above).
Futhermore, if the tlpobj is contained ina tlpdb which describes a media
-where the files are distributed in packed format (usually as .tar.lzma),
+where the files are distributed in packed format (usually as .tar.xz),
there are 6 more possible keys:
$tlpobj->containersize
@@ -1246,17 +1314,23 @@ or the filehandle if given:
debugging function for comparison with C<tpm>/C<tlps>, will go away.
+=item C<common_texmf_tree>
+
+if all files of the package are from the same texmf tree, this tree
+is returned, otherwise an undefined value. That is also a check
+whether a package is relocatable.
+
=item C<make_container($type,$instroot[, $destdir[, $containername[, $relative]]])>
creates a container file of the all files in the C<TLPOBJ>
in C<$destdir> (if not defined then C<< TLPOBJ->containerdir >> is used).
The C<$type> variable specifies the type of container to be used.
-Currently only C<zip> or C<lzma> are allowed, and are generating
-zip files and tar.lzma files, respectively.
+Currently only C<zip> or C<xz> are allowed, and are generating
+zip files and tar.xz files, respectively.
The file name of the created container file is C<$containername.extension>,
-where extension is either C<.zip> or C<.tar.lzma>, depending on the
+where extension is either C<.zip> or C<.tar.xz>, depending on the
setting of C<$type>. If no C<$containername> is specified the package name
is used.
diff --git a/Master/tlpkg/TeXLive/TLPSRC.pm b/Master/tlpkg/TeXLive/TLPSRC.pm
index d2d13d98543..41ff0601915 100644
--- a/Master/tlpkg/TeXLive/TLPSRC.pm
+++ b/Master/tlpkg/TeXLive/TLPSRC.pm
@@ -30,6 +30,7 @@ sub new
srcpatterns => $params{'srcpatterns'},
docpatterns => $params{'docpatterns'},
binpatterns => $params{'binpatterns'},
+ postactions => $params{'postactions'},
executes => defined($params{'executes'}) ? $params{'executes'} : [],
depends => defined($params{'depends'}) ? $params{'depends'} : [],
};
@@ -67,6 +68,7 @@ sub from_file
my $catalogue = "";
my (@executes, @depends);
my (@runpatterns, @docpatterns, @binpatterns, @srcpatterns);
+ my (@postactions);
my $started = 0;
my $finished = 0;
my $savedline = "";
@@ -132,6 +134,9 @@ sub from_file
} elsif ($line =~ /^depend\s+(.*)\s*$/) {
push @depends, $1 if ($1 ne "");
next;
+ } elsif ($line =~ /^postaction\s+(.*)\s*$/) {
+ push @postactions, $1 if ($1 ne "");
+ next;
} else {
tlwarn("$srcfile:$.: unknown tlpsrc directive, please fix: $line\n");
}
@@ -149,6 +154,7 @@ sub from_file
$self->docpatterns(@docpatterns) if @docpatterns;
$self->executes(@executes) if @executes;
$self->depends(@depends) if @depends;
+ $self->postactions(@postactions) if @postactions;
}
@@ -175,6 +181,11 @@ sub writeout
print $fd "execute $_\n";
}
}
+ if (defined($self->{'postactions'})) {
+ foreach (@{$self->{'postactions'}}) {
+ print $fd "postaction $_\n";
+ }
+ }
if (defined($self->{'srcpatterns'}) && (@{$self->{'srcpatterns'}})) {
foreach (sort @{$self->{'srcpatterns'}}) {
print $fd "srcpattern $_\n";
@@ -213,6 +224,7 @@ sub make_tlpobj
$tlp->longdesc($self->{'longdesc'}) if (defined($self->{'longdesc'}));
$tlp->catalogue($self->{'catalogue'}) if (defined($self->{'catalogue'}));
$tlp->executes(@{$self->{'executes'}}) if (defined($self->{'executes'}));
+ $tlp->postactions(@{$self->{'postactions'}}) if (defined($self->{'postactions'}));
$tlp->depends(@{$self->{'depends'}}) if (defined($self->{'depends'}));
$tlp->revision(0);
my $filemax;
@@ -540,6 +552,11 @@ sub executes {
if (@_) { @{ $self->{'executes'} } = @_ }
return @{ $self->{'executes'} };
}
+sub postactions {
+ my $self = shift;
+ if (@_) { @{ $self->{'postactions'} } = @_ }
+ return @{ $self->{'postactions'} };
+}
format multilineformat =
longdesc ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<~~
@@ -580,7 +597,7 @@ I<key> I<value>
where I<key> can be C<name>, C<category>, C<shortdesc>, C<longdesc>,
C<catalogue>, C<runpattern>, C<srcpattern>, C<docpattern>, C<binpattern>,
-C<execute>, or C<depend>.
+C<execute>, C<postaction>, or C<depend>.
Continuation lines are supported via a trailing backslash. That is, if
the C<.tlpsrc> file contains two physical lines like this:
@@ -631,14 +648,14 @@ The full list of currently used packages of this type is:
This package contains configuration options for the TeX Live archive.
If container_split_{doc,src}_files occurs in the depend lines the
-{doc,src} files are split into separate containers (.tar.lzma)
+{doc,src} files are split into separate containers (.tar.xz)
during container build time. Note that this has NO effect on the
appearance within the texlive.tlpdb. It is only on container level.
The container_format/XXXXX specifies the format, currently allowed
-is only "lzma", which generates .tar.lzma files. zip can be supported.
+is only "xz", which generates .tar.xz files. zip can be supported.
release/NNNN specifies the release number as used in the installer.
-=item B<00texlive-installation.config>
+=item B<00texlive.installation>
This package serves a double purpose:
@@ -737,9 +754,51 @@ I<file> for that language. The additional variables I<var> are:
C<lefthyphenmin>, C<righthyphenmin> (both integers), and C<synonyms> (a
comma-separated list of alias names for that hyphenation).
-=item C<execute BuildFormat> I<format>
+=item C<execute AddFormat name=I<fmt> engine=I<eng> [I<var>...]>
+
+activates the format with name I<fmt> based on the engine I<eng>. The
+additional variables I<var> are:
+C<mode> which can only be equal to C<disable> in which case the format
+will only be mentioned but disabled (prefixed with C<#!>;
+C<patterns> which gives the patterns file, if not present C<-> is used;
+C<options> which gives the additional options for the C<fmtutil.cnf> file.
+
+=back
+
+=item <postaction>
+
+gives a free from entry of post install and removal actions to be
+executed. The difference to the C<execute> statement is that
+C<postaction> is concerned with system integration, i.e., adjusting
+things outside the installation directory, while C<execute> touches
+only things within the installation.
+
+Currently the following C<postaction>s are understood:
+
+=over 4
+
+=item C<postaction shortcut name=I<name> type=menu|desktop icon=I<path> cmd=I<cmd> args=I<args> hide=0|1>
+
+On W32 creates a shortcut either in the main TeX Live menu or on the
+desktop. Please see the documentation of TeXLive::TLWinGoo for details
+on the parameters.
+
+=item C<postaction filetype name=I<name> cmd=I<cmd>>
+
+On W32 associates the file type I<name> with the command I<cmd>.
+
+=item C<postaction fileassoc extension=I<.ext> filetype=I<name>>
+
+On W32 declares files with the extenstion I<.ext> of file type I<name>.
+
+=item C<postaction script file=I<file> [filew32=I<filew32>]>
+
+This postaction executes the given I<file> with two arguments, the first
+being the root of the installation, the second being either the string
+C<install> or C<remove>.
-build the format I<format>, as specified in the C<fmtutil.cnf> file.
+If the C<filew32> argument is given this script is run on Windows systems
+instead of the one given via C<file>.
=back
diff --git a/Master/tlpkg/TeXLive/TLTREE.pm b/Master/tlpkg/TeXLive/TLTREE.pm
index 5f47771e712..95c882dfdb6 100644
--- a/Master/tlpkg/TeXLive/TLTREE.pm
+++ b/Master/tlpkg/TeXLive/TLTREE.pm
@@ -253,10 +253,16 @@ sub _get_files_matching_glob_pattern {
}
}
}
- if ($dirpart =~ m@^bin/win32@) {
+ if (($dirpart =~ m@^bin/win32@) || ($dirpart =~ m@^bin/i386-cygwin@)) {
# for arch=win32 under bin we want to automatch more extensions.
foreach my $f (@candfiles) {
- my $w32_binext = "bat|cmd|exe|dll|texlua";
+ my $w32_binext;
+ if ($dirpart =~ m@^bin/win32@) {
+ $w32_binext = "bat|cmd|exe|dll|texlua";
+ } else {
+ # cygwin part, they have .exe, but nothing else
+ $w32_binext = "exe";
+ }
ddebug("matching $f in $dirpart via glob $globline.($w32_binext)\n");
if ($f =~ /^$basepart\.($w32_binext)$/) {
ddebug("hit: globline=$globline, $dirpart/$f\n");
diff --git a/Master/tlpkg/TeXLive/TLUtils.pm b/Master/tlpkg/TeXLive/TLUtils.pm
index 4b7dafbc3f3..cd5fc335235 100644
--- a/Master/tlpkg/TeXLive/TLUtils.pm
+++ b/Master/tlpkg/TeXLive/TLUtils.pm
@@ -32,6 +32,7 @@ C<TeXLive::TLUtils> -- utilities used in the TeX Live infrastructure
TeXLive::TLUtils::tl_tmpdir();
TeXLive::TLUtils::xchdir($dir);
TeXLive::TLUtils::xsystem(@args);
+ TeXLive::TLUtils::run_cmd($cmd);
=head2 File Utilities
@@ -56,6 +57,7 @@ C<TeXLive::TLUtils> -- utilities used in the TeX Live infrastructure
TeXLive::TLUtils::create_language_def($tlpdb,$dest,$localconf);
TeXLive::TLUtils::install_packages($from_tlpdb,$media,$to_tlpdb,$what,$opt_src, $opt_doc)>);
TeXLive::TLUtils::install_package($what, $filelistref, $target, $platform);
+ TeXLive::TLUtils::do_postaction($how, $tlpobj);
=head2 Miscellaneous
@@ -113,10 +115,11 @@ BEGIN {
&give_ctan_mirror
&tlmd5
&xsystem
+ &run_cmd
);
@EXPORT = qw(setup_programs download_file process_logging_options
tlwarn info log debug ddebug dddebug debug_hash
- win32 xchdir xsystem);
+ win32 xchdir xsystem run_cmd);
}
use Cwd;
@@ -398,6 +401,25 @@ sub xsystem
}
}
+=item C<run_cmd($cmd)>
+
+runs a command and captures its output. Then returns a list with the
+output as first element and the return value (exit code) as second.
+
+=cut
+
+sub run_cmd {
+ my $cmd = shift;
+ my $output = `$cmd`;
+ $retval = $?
+ if ($retval != 0) {
+ $retval /= 256 if $retval > 0;
+ }
+ return ($output, $retval);
+}
+
+
+
=back
@@ -949,6 +971,7 @@ sub install_packages {
my $starttime = time();
foreach my $package (@packs) {
my $tlpobj = $tlpobjs{$package};
+ my $reloc = $tlpobj->relocated;
$n++;
my $remtime = "??:??";
my $tottime = "??:??";
@@ -1006,16 +1029,16 @@ sub install_packages {
} elsif ($media eq 'CD') {
if (-r "$root/$Archive/$package.zip") {
$container = "$root/$Archive/$package.zip";
- } elsif (-r "$root/$Archive/$package.tar.lzma") {
- $container = "$root/$Archive/$package.tar.lzma";
+ } elsif (-r "$root/$Archive/$package.tar.xz") {
+ $container = "$root/$Archive/$package.tar.xz";
} else {
- tlwarn("No package $package (.zip or .lzma) in $root/$Archive\n");
+ tlwarn("No package $package (.zip or .xz) in $root/$Archive\n");
next;
}
} elsif ($media eq 'NET') {
$container = "$root/$Archive/$package.$DefaultContainerExtension";
}
- if (!install_package($container, $tlpobj->containersize,
+ if (!install_package($container, $reloc, $tlpobj->containersize,
$tlpobj->containermd5, \@installfiles,
$totlpdb->root, $vars{'this_platform'})) {
# we already warn in install_package that something bad happened,
@@ -1036,8 +1059,8 @@ sub install_packages {
# - 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/;
- if (!install_package($srccontainer, $tlpobj->srccontainersize,
+ $srccontainer =~ s/(\.tar\.xz|\.zip)$/.source$1/;
+ if (!install_package($srccontainer, $reloc, $tlpobj->srccontainersize,
$tlpobj->srccontainermd5, \@installfiles,
$totlpdb->root, $vars{'this_platform'})) {
return 0;
@@ -1045,8 +1068,8 @@ sub install_packages {
}
if ($container_doc_split && $real_opt_doc && $tlpobj->docfiles) {
my $doccontainer = $container;
- $doccontainer =~ s/(\.tar\.lzma|\.zip)$/.doc$1/;
- if (!install_package($doccontainer,
+ $doccontainer =~ s/(\.tar\.xz|\.zip)$/.doc$1/;
+ if (!install_package($doccontainer, $reloc,
$tlpobj->doccontainersize,
$tlpobj->doccontainermd5, \@installfiles,
$totlpdb->root, $vars{'this_platform'})) {
@@ -1064,7 +1087,7 @@ sub install_packages {
}
$totlpdb->add_tlpobj($tlpobj);
# 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") ||
@@ -1083,7 +1106,7 @@ sub install_packages {
}
-=item C<install_package($what, $size, $md5, $filelistref, $target, $platform)>
+=item C<install_package($what, $reloc, $size, $md5, $filelistref, $target, $platform)>
This function installs the files given in @$filelistref from C<$what>
into C<$target>.
@@ -1097,29 +1120,34 @@ the way. In this case the list C<@$filelistref> is not taken into
account.
If C<$what> starts with C<http://> or C<ftp://> then C<$what> is
-downloaded from the net and piped through C<lzmadec> and C<tar>.
+downloaded from the net and piped through C<xzdec> and C<tar>.
-If $what ends with C<.tar.lzma> (but does not start with C<http://> or
+If $what ends with C<.tar.xz> (but does not start with C<http://> or
C<ftp://>, but possibly with C<file:/>) it is assumed to be a readable
-file on the system and is likewise piped through C<lzmadec> and C<tar>.
+file on the system and is likewise piped through C<xzdec> and C<tar>.
In both of these cases currently the list C<$@filelistref> currently
is not taken into account (should be fixed!).
+if C<$reloc> is true the container (NET or CD mode) is packaged in a way
+that the initial texmf-dist is missing.
+
Returns 1 on success and 0 on error.
=cut
sub install_package {
- my ($what, $whatsize, $whatmd5, $filelistref, $target, $platform) = @_;
+ my ($what, $reloc, $whatsize, $whatmd5, $filelistref, $target, $platform) = @_;
my @filelist = @$filelistref;
+ my $tempdir = "$target/temp";
+
# we assume that $::progs has been set up!
my $wget = $::progs{'wget'};
- my $lzmadec = $::progs{'lzmadec'};
- if (!defined($wget) || !defined($lzmadec)) {
- tlwarn("install_package: wget/lzmadec programs not set up properly.\n");
+ my $xzdec = $::progs{'xzdec'};
+ if (!defined($wget) || !defined($xzdec)) {
+ tlwarn("install_package: wget/xzdec programs not set up properly.\n");
return 0;
}
if (ref $what) {
@@ -1132,35 +1160,43 @@ sub install_package {
mkdirhier("$target/$dn");
copy "$root/$file", "$target/$dn";
}
- } elsif ($what =~ m,\.tar.lzma$,) {
+ } elsif ($what =~ m,\.tar.xz$,) {
# this is the case when we install from CD or the NET
#
- # 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
+
+ # if we are unpacking a relocated container we adjust the target
+ if ($reloc) {
+ $target .= "/$TeXLive::TLConfig::RelocTree" if $reloc;
+ mkdir($target) if (! -d $target);
+ }
my $fn = basename($what);
- mkdirhier("$target/temp");
- my $lzmafile = "$target/temp/$fn";
- my $tarfile = "$target/temp/$fn"; $tarfile =~ s/\.lzma$//;
- my $lzmafile_quote = $lzmafile;
+ my $pkg = $fn;
+ $pkg =~ s/\.tar\.xz$//;
+ mkdirhier("$tempdir");
+ my $xzfile = "$tempdir/$fn";
+ my $tarfile = "$tempdir/$fn"; $tarfile =~ s/\.xz$//;
+ my $xzfile_quote = $xzfile;
my $tarfile_quote = $tarfile;
if (win32()) {
- $lzmafile =~ s!/!\\!g;
+ $xzfile =~ s!/!\\!g;
$tarfile =~ s!/!\\!g;
$target =~ s!/!\\!g;
}
- $lzmafile_quote = "\"$lzmafile\"";
+ $xzfile_quote = "\"$xzfile\"";
$tarfile_quote = "\"$tarfile\"";
my $gotfiledone = 0;
- if (-r $lzmafile) {
+ if (-r $xzfile) {
# check that the downloaded file is not partial
if ($whatsize >= 0) {
# we have the size given, so check that first
- my $size = (stat $lzmafile)[7];
+ my $size = (stat $xzfile)[7];
if ($size == $whatsize) {
# we want to check also the md5sum if we have it present
if ($whatmd5) {
- if (tlmd5($lzmafile) eq $whatmd5) {
+ if (tlmd5($xzfile) eq $whatmd5) {
$gotfiledone = 1;
} else {
tlwarn("Downloaded $what, size equal, but md5sum differs;\n",
@@ -1174,12 +1210,12 @@ sub install_package {
}
} else {
tlwarn("Partial download of $what found, removing it.\n");
- unlink($tarfile, $lzmafile);
+ unlink($tarfile, $xzfile);
}
} else {
# ok no size information, hopefully we have md5 sums
if ($whatmd5) {
- if (tlmd5($lzmafile) eq $whatmd5) {
+ if (tlmd5($xzfile) eq $whatmd5) {
$gotfiledone = 1;
} else {
tlwarn("Downloaded file, but md5sum differs, removing it.\n");
@@ -1190,39 +1226,44 @@ sub install_package {
$gotfiledone = 1;
}
}
- debug("Reusing already downloaded container $lzmafile\n")
+ debug("Reusing already downloaded container $xzfile\n")
if ($gotfiledone);
}
if (!$gotfiledone) {
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 $what did not succeed.\n");
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("Unpacking $lzmafile did not succeed.\n");
+ tlwarn("Unpacking $xzfile did not succeed.\n");
return 0;
}
if (!TeXLive::TLUtils::untar($tarfile, $target, 1)) {
tlwarn("Un-tarring $tarfile did not succeed.\n");
return 0;
}
+ # we remove the created .tlpobj it is recreated anyway in
+ # install_packages above in the right place. This way we also
+ # get rid of the $pkg.source.tlpobj which are useless
+ unlink ("$target/tlpkg/tlpobj/$pkg.tlpobj")
+ if (-r "$target/tlpkg/tlpobj/$pkg.tlpobj");
if ($what =~ m,http://|ftp://,) {
# we downloaded the original .tar.lzma from the net, so we keep it
} else {
- # we are downloading it from CD, so we can unlink it to save
+ # we are downloading it from CD, so we can unlink it to save
# disk space
- unlink($lzmafile);
+ unlink($xzfile);
}
} else {
tlwarn("Sorry, no idea how to install $what\n");
@@ -1231,6 +1272,261 @@ sub install_package {
return 1;
}
+=item C<do_postaction($how, $tlpobj, $do_fileassocs, $do_shortcuts, $do_script)>
+
+Evaluates the C<postaction> fields in the C<$tlpobj>. The first parameter
+can be either C<install> or C<remove>. The second gives the TLPOBJ whos
+postactions should be evaluated, and the last three arguments specify
+what type of postactions should (or shouldn't) be evaluated.
+
+Returns 1 on success, and 0 on failure.
+
+=cut
+
+sub do_postaction {
+ my ($how, $tlpobj, $do_fileassocs, $do_shortcuts, $do_script) = @_;
+ my $ret = 1;
+ if (!defined($tlpobj)) {
+ tlwarn("do_postaction: didn't get a tlpobj\n");
+ return 0;
+ }
+ debug("running postaction=$how for " . $tlpobj->name . "\n")
+ if $tlpobj->postactions;
+ for my $pa ($tlpobj->postactions) {
+ if ($pa =~ m/^\s*shortcut\s+(.*)\s*$/) {
+ next unless $do_shortcuts;
+ $ret &&= _do_postaction_shortcut($how, $tlpobj, $1);
+ } elsif ($pa =~ m/\s*filetype\s+(.*)\s*$/) {
+ next unless $do_fileassocs;
+ $ret &&= _do_postaction_filetype($how, $tlpobj, $1);
+ } elsif ($pa =~ m/\s*fileassoc\s+(.*)\s*$/) {
+ next unless $do_fileassocs;
+ $ret &&= _do_postaction_fileassoc($how, $tlpobj, $1);
+ } elsif ($pa =~ m/\s*script\s+(.*)\s*$/) {
+ next unless $do_script;
+ $ret &&= _do_postaction_script($how, $tlpobj, $1);
+ } else {
+ tlwarn("do_postaction: don't know how to do $pa\n");
+ $ret = 0;
+ }
+ }
+ # nothing to do
+ return $ret;
+}
+
+sub _do_postaction_fileassoc {
+ my ($how, $tlpobj, $pa) = @_;
+ return 1 unless win32();
+ my ($errors, %keyval) =
+ parse_into_keywords($pa, qw/extension filetype/);
+
+ if ($errors) {
+ tlwarn("parsing the postaction line >>$pa<< did not succeed!\n");
+ return 0;
+ }
+
+ # name can be an arbitrary string
+ if (!defined($keyval{'extension'})) {
+ tlwarn("extension of fileassoc postaction not given\n");
+ return 0;
+ }
+ my $extension = $keyval{'extension'};
+
+ # cmd can be an arbitrary string
+ if (!defined($keyval{'filetype'})) {
+ tlwarn("filetype of fileassoc postaction not given\n");
+ return 0;
+ }
+ my $filetype = $keyval{'filetype'};
+
+ if ($how eq "install") {
+ TeXLive::TLWinGoo::register_extension($extension, $filetype);
+ } elsif ($how eq "remove") {
+ TeXLive::TLWinGoo::unregister_extension($extension);
+ } else {
+ tlwarn("Unknown mode $how\n");
+ return 0;
+ }
+ return 1;
+}
+sub _do_postaction_filetype {
+ my ($how, $tlpobj, $pa) = @_;
+ return 1 unless win32();
+ my ($errors, %keyval) =
+ parse_into_keywords($pa, qw/name cmd/);
+
+ if ($errors) {
+ tlwarn("parsing the postaction line >>$pa<< did not succeed!\n");
+ return 0;
+ }
+
+ # name can be an arbitrary string
+ if (!defined($keyval{'name'})) {
+ tlwarn("name of filetype postaction not given\n");
+ return 0;
+ }
+ my $name = $keyval{'name'};
+
+ # cmd can be an arbitrary string
+ if (!defined($keyval{'cmd'})) {
+ tlwarn("cmd of filetype postaction not given\n");
+ return 0;
+ }
+ my $cmd = $keyval{'cmd'};
+
+ if ($how eq "install") {
+ TeXLive::TLWinGoo::register_file_type($name, $cmd);
+ } elsif ($how eq "remove") {
+ TeXLive::TLWinGoo::unregister_file_type($name);
+ } else {
+ tlwarn("Unknown mode $how\n");
+ return 0;
+ }
+ return 1;
+}
+
+sub _do_postaction_script {
+ my ($how, $tlpobj, $pa) = @_;
+ my ($errors, %keyval) =
+ parse_into_keywords($pa, qw/file filew32/);
+
+ if ($errors) {
+ tlwarn("parsing the postaction line >>$pa<< did not succeed!\n");
+ return 0;
+ }
+
+ # file can be an arbitrary string
+ if (!defined($keyval{'file'})) {
+ tlwarn("filename of script not given\n");
+ return 0;
+ }
+ my $file = $keyval{'file'};
+ if (win32() && defined($keyval{'filew32'})) {
+ $file = $keyval{'filew32'};
+ }
+ my $texdir = `kpsewhich -var-value=SELFAUTOPARENT`;
+ chomp($texdir);
+ my @syscmd;
+ if ($file =~ m/\.pl$/i) {
+ # we got a perl script, call it via perl
+ push @syscmd, "perl", "$texdir/$file";
+ } elsif ($file =~ m/\.texlua$/i) {
+ # we got a texlua script, call it via texlua
+ push @syscmd, "texlua", "$texdir/$file";
+ } else {
+ # we got anything else, call it directly and hope it is excutable
+ push @syscmd, "$texdir/$file";
+ }
+ push @syscmd, $how, $texdir;
+ my $ret = system (@syscmd);
+ if ($ret != 0) {
+ $ret /= 256 if $ret > 0;
+ my $pwd = cwd ();
+ warn "$0: calling post action script $file did not succeed in $pwd, status $ret";
+ return 0;
+ }
+ return 1;
+}
+
+sub _do_postaction_shortcut {
+ my ($how, $tlpobj, $pa) = @_;
+ return 1 unless win32();
+ my ($errors, %keyval) =
+ parse_into_keywords($pa, qw/type name icon cmd args hide/);
+
+ if ($errors) {
+ tlwarn("parsing the postaction line >>$pa<< did not succeed!\n");
+ return 0;
+ }
+
+ # type can be either menu or desktop
+ if (!defined($keyval{'type'})) {
+ tlwarn("type of shortcut postaction not given\n");
+ return 0;
+ }
+ my $type = $keyval{'type'};
+ if (($type ne "menu") && ($type ne "desktop")) {
+ tlwarn("type of shortcut postaction $type is unknown (menu, desktop)\n");
+ return 0;
+ }
+
+ # name can be an arbitrary string
+ if (!defined($keyval{'name'})) {
+ tlwarn("name of shortcut postaction not given\n");
+ return 0;
+ }
+ my $name = $keyval{'name'};
+
+ # icon, cmd, args is optional
+ my $icon = (defined($keyval{'icon'}) ? $keyval{'icon'} : '');
+ my $cmd = (defined($keyval{'cmd'}) ? $keyval{'cmd'} : '');
+ my $args = (defined($keyval{'args'}) ? $keyval{'args'} : '');
+
+ # hide can be only 0 or 1, and defaults to 0
+ my $hide = (defined($keyval{'hide'}) ? $keyval{'hide'} : 0);
+ if (($hide ne "0") && ($hide ne "1")) {
+ tlwarn("hide of shortcut postaction $hide is unknown (0, 1)\n");
+ return 0;
+ }
+
+ if ($how eq "install") {
+ my $texdir = `kpsewhich -var-value=SELFAUTOPARENT`;
+ chomp($texdir);
+ my $texdir_bsl = conv_to_w32_path($texdir);
+ $icon =~ s!^TEXDIR/!$texdir/!;
+ $args =~ s!^TEXDIR/!$texdir/!;
+ $args = conv_to_w32_path($args);
+ if ($type eq "menu") {
+ TeXLive::TLWinGoo::add_menu_shortcut(
+ $TeXLive::TLConfig::WindowsMainMenuName,
+ $name, $icon, $cmd, $args, $hide);
+ } elsif ($type eq "desktop") {
+ TeXLive::TLWinGoo::add_desktop_shortcut(
+ $name, $icon, $cmd, $args, $hide);
+ } else {
+ tlwarn("Unknown type of shortcut: $type\n");
+ return 0;
+ }
+ } elsif ($how eq "remove") {
+ if ($type eq "menu") {
+ TeXLive::TLWinGoo::remove_menu_shortcut(
+ $TeXLive::TLConfig::WindowsMainMenuName, $name);
+ } elsif ($type eq "desktop") {
+ TeXLive::TLWinGoo::remove_desktop_shortcut($name);
+ } else {
+ tlwarn("Unknown type of shortcut: $type\n");
+ return 0;
+ }
+ } else {
+ tlwarn("Unknown mode $how\n");
+ return 0;
+ }
+ return 1;
+}
+
+sub parse_into_keywords {
+ my ($str, @keys) = @_;
+ my @words = quotewords('\s+', 0, $str);
+ my %ret;
+ my $error = 0;
+ while (@words) {
+ $_ = shift @words;
+ if (/^([^=]+)=(.*)$/) {
+ $ret{$1} = $2;
+ } else {
+ tlwarn("parser found a invalid word in parsing keys: $_\n");
+ $error++;
+ $ret{$_} = "";
+ }
+ }
+ for my $k (keys %ret) {
+ if (!member($k, @keys)) {
+ $error++;
+ tlwarn("parser found invalid keyword: $k\n");
+ }
+ }
+ return($error, %ret);
+}
=item C<untar($tarfile,$targetdir, $remove_tarfile)>
@@ -1270,13 +1566,12 @@ sub untar {
return $ret;
}
-
=item C<setup_programs($bindir, $platform)>
Populate the global C<$::progs> hash containing the paths to the
-programs C<wget>, C<tar>, C<lzmadec>. The C<$bindir> argument specifies
-the path to the location of the C<lzmadec> binaries, the C<$platform>
+programs C<wget>, C<tar>, C<xzdec>. The C<$bindir> argument specifies
+the path to the location of the C<xzdec> binaries, the C<$platform>
gives the TeX Live platform name, used as the extension on our
executables. If a program is not present in the TeX Live tree, we also
check along PATH (without the platform extension.)
@@ -1290,17 +1585,17 @@ sub setup_programs {
my $ok = 1;
$::progs{'wget'} = "wget";
- $::progs{'lzmadec'} = "lzmadec";
- $::progs{'lzma'} = "lzma";
+ $::progs{'xzdec'} = "xzdec";
+ $::progs{'xz'} = "xz";
$::progs{'tar'} = "tar";
if ($^O =~ /^MSWin(32|64)$/i) {
$::progs{'wget'} = conv_to_w32_path("$bindir/wget/wget.exe");
$::progs{'tar'} = conv_to_w32_path("$bindir/tar.exe");
- $::progs{'lzmadec'} = conv_to_w32_path("$bindir/lzma/lzmadec.win32.exe");
- $::progs{'lzma'} = conv_to_w32_path("$bindir/lzma/lzma.exe");
- for my $prog ("lzmadec", "wget") {
- my $opt = $prog eq "lzmadec" ? "--help" : "--version";
+ $::progs{'xzdec'} = conv_to_w32_path("$bindir/xz/xzdec.exe");
+ $::progs{'xz'} = conv_to_w32_path("$bindir/xz/xz.exe");
+ for my $prog ("xzdec", "wget") {
+ my $opt = $prog eq "xzdec" ? "--help" : "--version";
my $ret = system("$::progs{$prog} $opt >nul 2>&1"); # on windows
if ($ret != 0) {
warn "TeXLive::TLUtils::setup_programs (w32) failed"; # no nl for perl
@@ -1322,8 +1617,8 @@ sub setup_programs {
}
my $s = 0;
$s += setup_unix_one('wget', "$bindir/wget/wget.$platform", "--version");
- $s += setup_unix_one('lzmadec',"$bindir/lzma/lzmadec.$platform","--help");
- $s += setup_unix_one('lzma', "$bindir/lzma/lzma.$platform", "notest");
+ $s += setup_unix_one('xzdec',"$bindir/xz/xzdec.$platform","--help");
+ $s += setup_unix_one('xz', "$bindir/xz/xz.$platform", "notest");
$ok = ($s == 3); # failure return unless all are present.
}
@@ -1600,7 +1895,7 @@ improved (checking for duplicates).
sub create_fmtutil {
my ($tlpdb,$dest,$localconf) = @_;
my @lines = $tlpdb->fmtutil_cnf_lines;
- _create_config_files($tlpdb, "texmf/fmtutil/fmtutil-hdr.cnf", $dest,
+ _create_config_files($tlpdb, "texmf/web2c/fmtutil-hdr.cnf", $dest,
$localconf, 0, '#', \@lines);
}
diff --git a/Master/tlpkg/TeXLive/TLWinGoo.pm b/Master/tlpkg/TeXLive/TLWinGoo.pm
index fbc163dd39e..c4d0558ceaa 100644
--- a/Master/tlpkg/TeXLive/TLWinGoo.pm
+++ b/Master/tlpkg/TeXLive/TLWinGoo.pm
@@ -58,7 +58,6 @@ C<TeXLive::TLWinGoo> -- Additional utilities for Windows
$prog, $args, $batgui);
TeXLive::TLWinGoo::add_menu_shortcut($place, $name, $icon,
$prog, $args, $batgui);
- TeXLive::TLWinGoo::init_unshortbat($texdir);
TeXLive::TLWinGoo::remove_desktop_shortcut($name);
TeXLive::TLWinGoo::remove_menu_shortcut($place, $name);
@@ -104,7 +103,6 @@ BEGIN {
&add_menu_shortcut
&remove_desktop_shortcut
&remove_menu_shortcut
- &init_unshortbat
&create_uninstaller
&unregister_uninstaller
);
@@ -857,8 +855,7 @@ sub menu_path() {
=pod
-=item C<add_desktop_shortcut($texdir, $name, $icon,
- $prog, $args, $batgui)>
+=item C<add_desktop_shortcut($name, $icon, $prog, $args, $batgui)>
Add a desktop shortcut, with name $name and icon $icon, pointing to
program $prog with parameters $args (a string). Use a non-null
@@ -866,14 +863,10 @@ batgui parameter if the shortcut starts a gui program via a
batchfile. Then the inevitable command prompt will be hidden
rightaway, leaving only the gui program visible.
-The parameter $texdir is merely used to locate the batchfile
-unshort.bat for uninstalling desktop shortcuts, which needs to be
-updated.
-
=cut
sub add_desktop_shortcut {
- my ($texdir, $name, $icon, $prog, $args, $batgui) = @_;
+ my ($name, $icon, $prog, $args, $batgui) = @_;
# create shortcut
my ($shc, $shpath, $shfile);
@@ -884,15 +877,6 @@ sub add_desktop_shortcut {
$shc->{'ShowCmd'} = $batgui ? SW_SHOWMINNOACTIVE : SW_SHOWNORMAL;
$shfile = desktop_path().'/'.$name.'.lnk';
$shc->Save($shfile);
-
- # update batchfile for uninstalling shortcuts
- if (open UNSHORT, ">>$texdir/tlpkg/installer/unshort.bat") {
- $shfile =~ s!/!\\!g;
- print UNSHORT 'del "'.$shfile."\" 2>nul\n";
- close UNSHORT;
- } else {
- warn "Cannot open $texdir/tlpkg/installer/unshort.bat for appending: $!";
- }
}
=pod
@@ -932,39 +916,16 @@ sub add_menu_shortcut {
=pod
-=item C<init_unshortbat($texdir)>
-
-Reinitialize unshort.bat, the shortcuts uninstaller.
-
-=cut
-
-sub init_unshortbat {
- my $texdirw = shift;
- my $menupath = menu_path();
- $menupath =~ s!/!\\!g;
-
- # batchfile for uninstalling shortcuts
- if (open UNSHORT, ">$texdirw/tlpkg/installer/unshort.bat") {
- print UNSHORT 'rmdir /s /q "'.$menupath."\\TeX Live 2008\" 2>nul\n";
- close UNSHORT;
- } else {
- warn "Cannot create $texdirw/tlpkg/installer/unshort.bat: $!";
- }
-}
-
-=pod
-
=item C<remove_desktop_shortcut($name)>
-For uninstallation of an individual package. We leave unshort.bat
-alone because redundant entries are no big deal.
+For uninstallation of an individual package.
=cut
sub remove_desktop_shortcut {
my $name = shift;
unlink desktop_path().'/'.$name.'.lnk';
-}
+}
=pod
@@ -1035,7 +996,6 @@ path $td\\bin\\win32;%path%
set PERL5LIB=
\"$td\\tlpkg\\tlperl\\bin\\perl.exe\" \"$td\\texmf\\scripts\\texlive\\uninstall-win32.pl\"
if errorlevel 1 exit
-call \"$tdw\\tlpkg\\installer\\unshort.bat\"
copy \"$tdw\\tlpkg\\installer\\uninst2.bat\" \"\%TEMP\%\"
rem pause
\"\%TEMP\%\\uninst2.bat\"