diff options
| -rwxr-xr-x | Master/texmf/scripts/texlive/tlmgr.pl | 75 |
1 files changed, 71 insertions, 4 deletions
diff --git a/Master/texmf/scripts/texlive/tlmgr.pl b/Master/texmf/scripts/texlive/tlmgr.pl index abbc75ef88e..25c2256995f 100755 --- a/Master/texmf/scripts/texlive/tlmgr.pl +++ b/Master/texmf/scripts/texlive/tlmgr.pl @@ -1343,7 +1343,10 @@ sub action_backup { # ===================================================================== # sub write_w32_updater { - my ($restart_tlmgr, @w32_updated) = @_; + my ($restart_tlmgr, $ref_files_to_be_removed, @w32_updated) = @_; + my @infra_files_to_be_removed = @$ref_files_to_be_removed; + @infra_files_to_be_removed =~ s!/!\\!g; # to keep del command happy + # TODO do something with these files TODO my $media = $tlmediasrc->media; my $mediatlpdb = $tlmediasrc->tlpdb; # we have to download/copy also the src/doc files if necessary! @@ -1988,7 +1991,6 @@ sub action_update { # foreach my $pkg (@inst_packs, @inst_colls, @inst_schemes) { # skip this loop if infra update on w32 - last if (win32() && $opts{"self"}); next if ($pkg =~ m/^00texlive/); my $tlp = $localtlpdb->get_package($pkg); # we checked already that this package is present! @@ -2010,6 +2012,11 @@ sub action_update { } $updated{$pkg} = 1; next; + } elsif (win32() && $opts{"self"}) { + # we pretend that the update happened + # in order to calculate file changes properly + $updated{$pkg} = 1; + next; } if ($opts{"backup"} && !$opts{"dry-run"}) { @@ -2125,10 +2132,66 @@ sub action_update { # check that if updates to the critical packages are present all of # them have been successfully updated my $infra_update_done = 1; + my @infra_files_to_be_removed; for my $pkg (@critical) { - $infra_update_done &&= $updated{$pkg} if (defined($updated{$pkg})); + next unless (defined($updated{$pkg})); + $infra_update_done &&= $updated{$pkg}; + my (@old_infra_files, @new_infra_files); + my $oldtlp; + my $newtlp; + if ($updated{$pkg}) { + $oldtlp = $localtlpdb->get_package($pkg); + $newtlp = $tlmediatlpdb->get_package($pkg); + } else { + # update failed but we could introduce new files, that + # should be removed now as a part of restoring backup + $oldtlp = $tlmediatlpdb->get_package($pkg); + $newtlp = $localtlpdb->get_package($pkg); + } + die ("That shouldn't happen: $p not found in tlpdb") if !defined($newtlp); + die ("That shouldn't happen: $p not found in tlpdb") if !defined($oldtlp); + my @old_infra_files = $oldtlp->all_files; + my @new_infra_files = $newtlp->all_files; + my %del_files; + @del_files{@old_infra_files} = (); + delete @del_files{@new_infra_files}; + for my $k (keys %del_files) { + my @found_pkgs = $localtlpdb->find_file($k); + if ($#found_pkgs >= 0) { + my $bad_file = 1; + if (win32()) { + # on win32 the packages have not been removed already, + # so we check that the only package listed in @found_pkgs + # is the one we are working on ($pkg) + if ($#found_pkgs == 0 && $found_pkgs[0] =~ m/^$pkg:/) { + # only one package has been returned and it + # matches the current package followed by a colon + # remember the TLPDB->find_file returns + # $pkg:$file + # in this case we can ignore it + $bad_file = 0; + } + } + if ($bad_file) { + tlwarn("The file $k has disappeared from the critical" . + "package $pkg but is still present in @found_pkgs\n"); + } else { + push @infra_files_to_be_removed, $k; + } + } else { + push @infra_files_to_be_removed, $k; + } + } } + if (!win32()) { + for my $f (@infra_files_to_be_removed) { + # TODO actually unlink the stuff + #unlink("$Master/$f"); + debug("removing disappearing file $f\n"); + } + } + # check if any additional updates are asked for my $other_updates_asked_for = 0; if ($opts{"all"}) { @@ -2153,7 +2216,11 @@ sub action_update { # infra update and tlmgr restart on win32 is done by the updater batch script if (win32() && !$opts{"list"} && @critical) { info("Preparing TeX Live infrastructure update...\n"); - my $ret = write_w32_updater($restart_tlmgr, @critical); + for my $f (@infra_files_to_be_removed) { + debug("file scheduled for removal $f\n"); + } + my $ret = write_w32_updater($restart_tlmgr, + \@infra_files_to_be_removed, @critical); if ($ret) { tlwarn ("Aborting infrastructure update.\n"); $restart_tlmgr = 0 if ($opts{"dry-run"}); |