summaryrefslogtreecommitdiff
path: root/Master/texmf/scripts
diff options
context:
space:
mode:
authorNorbert Preining <preining@logic.at>2009-02-05 13:28:43 +0000
committerNorbert Preining <preining@logic.at>2009-02-05 13:28:43 +0000
commitb9477c893814746095eaf0aad80b354620ac2421 (patch)
tree7dad6a6d6bd56e7523f50a164bc7fd16920b52b4 /Master/texmf/scripts
parent1bf50b63af76bad30fceebfb740ea39ffeda518e (diff)
add the new stuff from Tomek for W32 updater
git-svn-id: svn://tug.org/texlive/trunk@12096 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/texmf/scripts')
-rwxr-xr-xMaster/texmf/scripts/texlive/tlmgr.pl152
1 files changed, 59 insertions, 93 deletions
diff --git a/Master/texmf/scripts/texlive/tlmgr.pl b/Master/texmf/scripts/texlive/tlmgr.pl
index e4416a65418..f7b3b70ccbc 100755
--- a/Master/texmf/scripts/texlive/tlmgr.pl
+++ b/Master/texmf/scripts/texlive/tlmgr.pl
@@ -1123,110 +1123,72 @@ sub action_backup {
}
#
-sub grow_w32_updater {
- my ($pkg, $opt_dry) = @_;
- my $updater_string = '';
- # these packages cannot be upgrade on w32
- # so we have to create a update program
+sub write_w32_updater {
+ my ($opt_dry, @w32_updates) = @_;
my $media = $tlmediasrc->media;
my $mediatlpdb = $tlmediasrc->tlpdb;
- my $mediatlp = $mediatlpdb->get_package($pkg);
# we have to download/copy also the src/doc files if necessary!
my $container_src_split = $mediatlpdb->config_src_container;
my $container_doc_split = $mediatlpdb->config_doc_container;
# get options about src/doc splitting from $totlpdb
+ # TT: should we local options to decide about install of doc & src?
my $opt_src = $localtlpdb->option_install_srcfiles;
- # we do install documenation files for category Documentation even if option_install_docfiles is false
- my $opt_doc = ($mediatlp->category =~ m/documentation/i) ? 1 : $localtlpdb->option_install_docfiles;
- my $do_src = ($container_src_split && $opt_src && $mediatlp->srcfiles) ? 1 : 0;
- my $do_doc = ($container_doc_split && $opt_doc && $mediatlp->docfiles) ? 1 : 0;
- my $temp = $localtlpdb->root . "/temp";
+ my $opt_doc = $localtlpdb->option_install_docfiles;
+ my $root = $localtlpdb->root;
+ my $temp = "$root/temp";
+ my $repo = $mediatlpdb->root . "/$Archive";
TeXLive::TLUtils::mkdirhier($temp);
if ($media eq 'DVD') {
tlwarn ("Creating updater from DVD currently not implemented!\n");
tlwarn ("But it should not be necessary!\n");
- } else {
- my $oldrev = $localtlpdb->get_package($pkg)->revision;
- my $newrev = $mediatlp->revision;
- my $repo = $mediatlpdb->root . '/'. $Archive;
- my @do_one_args = ($oldrev, $newrev, $repo, $temp, $opt_dry);
- $updater_string .= do_one_pkg($pkg, @do_one_args);
- $updater_string .= do_one_pkg("$pkg.src", @do_one_args) if ($do_src);
- $updater_string .= do_one_pkg("$pkg.doc", @do_one_args) if ($do_doc);
- }
- return $updater_string;
- sub do_one_pkg {
- my ($pkg, $oldrev, $newrev, $repo, $temp, $opt_dry) = @_;
- my $updater_string = '';
- my $update_info = "update: $pkg ($oldrev -^> $newrev)";
+ return 1; # abort
+ }
+ my ($mediatlp, $localtlp, $opt_real_doc, $sysret, $size, $md5, $fullname,
+ $oldrev, $newrev, $pkg_part, @pkg_parts, @updater_args);
+ foreach my $pkg (@w32_updates) {
+ $mediatlp = $mediatlpdb->get_package($pkg);
+ $localtlp = $localtlpdb->get_package($pkg);
+ $oldrev = $localtlp->revision;
+ $newrev = $mediatlp->revision;
+ # we do install documenation files for category Documentation even if option_install_docfiles is false
+ $opt_real_doc = ($mediatlp->category =~ m/documentation/i) ? 1 : $opt_doc;
+ @pkg_parts = ($pkg);
+ push(@pkg_parts, "$pkg.src") if ($container_src_split && $opt_src && $mediatlp->srcfiles);
+ push(@pkg_parts, "$pkg.doc") if ($container_doc_split && $opt_real_doc && $mediatlp->docfiles);
if ($opt_dry) {
- $update_info =~ s/\^//; # get rid of the batch escape char
- info("$update_info\n");
- } elsif ($tlmediasrc->media eq 'CD') {
- copy("$repo/$pkg.tar.lzma", "$temp");
- } else { # net
- TeXLive::TLUtils::download_file("$repo/$pkg.tar.lzma", "$temp/$pkg.tar.lzma");
- }
- # now we should have the file present
- if (!$opt_dry && ! -r "$temp/$pkg.tar.lzma") {
- tlwarn ("Couldn't get $pkg.tar.lzma, that is bad\n");
- } else {
- # add lines to the updater script string
- $updater_string = "
-tlpkg\\installer\\lzma\\lzmadec.win32.exe < temp\\$pkg.tar.lzma > temp\\$pkg.tar
-tlpkg\\installer\\tarsave.exe -x -f temp\\$pkg.tar
-tlpkg\\tlperl\\bin\\perl.exe texmf\\scripts\\texlive\\tlmgr.pl _include_tlpobj tlpkg\\tlpobj\\$pkg.tlpobj
-echo $update_info
->>%logdir%tlmgr.log echo [%date% %time%] $update_info
-del temp\\$pkg.tar.lzma temp\\$pkg.tar
-";
+ info("update: $pkg ($oldrev -> $newrev)\n");
+ next;
}
- return $updater_string;
- }
-}
-
-sub write_w32_updater {
- #TODO: think of some way to validate the update
- my $updater_string = shift;
- # assemble the updater script string
- $updater_string = <<'EOF'
-@echo off
-rem Update script for TeX Live infrastructure
-rem called automatically after creation by tlmgr.bat wrapper
-rem left only for inspection, can be safely removed
-
-setlocal
-cd /d %~dp0
-rem now we are in .../tlpkg/installer
-rem create tar.exe backup
->nul copy tar.exe tarsave.exe
-cd ..\..
-rem now we are in the root
-rem get location of the log file
-for /f "delims=" %%D in ('kpsewhich -var-value=TEXMFSYSVAR') do set "logdir=%%~fD\web2c\"
-rem set up perl environment
-set PERL5LIB=%cd%\tlpkg\tlperl\lib
-
-echo Do not close this window! TeX Live infrastructure update in progress...
-echo In case of a disaster download and run:
-echo http://mirror.ctan.org/systems/texlive/tlnet/2008/update-tlmgr-latest.exe
-EOF
-
-. $updater_string . <<'EOF'
-
-del tlpkg\installer\tarsave.exe
-rem Before we can enable self-delete, we need to validate the update somehow.
-rem start /b cmd /c del "%%~f0"
-EOF
-;
- # write the updater script to file
- open UPDATER, ">" . $localtlpdb->root . "/tlpkg/installer/updater"
- or die "Cannot create updater: $!";
- print UPDATER $updater_string;
+ foreach $pkg_part (@pkg_parts) {
+ if ($media eq 'CD') {
+ copy("$repo/$pkg_part.tar.lzma", "$temp");
+ } else { # net
+ TeXLive::TLUtils::download_file("$repo/$pkg_part.tar.lzma", "$temp/$pkg_part.tar.lzma");
+ }
+ # now we should have the file present
+ if (!-r "$temp/$pkg_part.tar.lzma") {
+ tlwarn ("Couldn't get $pkg_part.tar.lzma, that is bad\n");
+ return 1; # abort
+ }
+ # unpack lzma archive
+ $sysret = system("$root/tlpkg/installer/lzma/lzmadec.win32.exe < \"$temp/$pkg_part.tar.lzma\" > \"$temp/$pkg_part.tar\"");
+ return 1 if $sysret; # unpack failed? abort
+ unlink("$temp/$pkg_part.tar.lzma"); # we don't need that archive anymore
+ push @updater_args, $pkg_part, $oldrev, $newrev;
+ }
+ # create backup
+ ($size, $md5, $fullname) = $localtlp->make_container("tar", $root, $temp, "__BACKUP_$pkg.r$oldrev");
+ if ($size <= 0) {
+ tlwarn("Creation of backup container of $pkg failed.\n");
+ return 1; # backup failed? abort
+ }
+ }
+ return 0 if ($opt_dry); # nothing else to do
+ # write the updater script file
+ open UPDATER, ">$root/tlpkg/installer/updater" or die "Cannot create updater: $!";
+ print UPDATER 'call %~dp0w32_updater ' . join(' ',@updater_args);
close UPDATER;
- # tlwarn("UPDATER script has been created:\n");
- # tlwarn(" " . $localtlpdb->root . "\\tlpkg\\installer\\updater.bat\n");
- # print STDOUT $updater_string;
+ return 0;
}
@@ -1605,7 +1567,7 @@ sub action_update {
}
#
- my $w32_updater = '' if win32();
+ my @w32_updates if win32();
foreach my $pkg (sort @updated) {
next if ($pkg =~ m/^00texlive/);
my $tlp = $localtlpdb->get_package($pkg);
@@ -1640,7 +1602,8 @@ sub action_update {
}
if (win32() && ($pkg =~ m/$WinSpecialUpdatePackagesRegexp/)) {
- $w32_updater .= grow_w32_updater($pkg, $opts{"dry-run"});
+ # collect all infrastructure packages for later processing
+ push @w32_updates, $pkg;
} else {
if ($::machinereadable) {
machine_line($pkg, $FLAG_UPDATE, $rev, $mediarev, $sizes{$pkg});
@@ -1725,7 +1688,10 @@ sub action_update {
}
# that already checks whether we actually have to do something
- write_w32_updater($w32_updater) if (win32() && $w32_updater && !$opts{"dry-run"});
+ if (win32()) {
+ my $ret = write_w32_updater($opts{"dry-run"} || $opts{"list"}, @w32_updates);
+ tlwarn ("Aborting infrastructure update.\n") if ($ret);
+ }
if (($nrupdated == 0) && ($tlmediasrc->media ne "NET") && $opts{"all"}) {
# for all but net updates we warn if nothing is updated
tlwarn("\nNothing to update.\n");