Add tlmediasrcs etc hashes that collect all the available hashes, and add init_tlmedias that initializes all these hashs. Adapt init_tlmedia to work in both cases (old style/new style) add action "candidates" for checking which packages are available --- texmf/scripts/texlive/tlmgr.pl | 123 ++++++++++++++++++++++++++++++++++------- 1 file changed, 102 insertions(+), 21 deletions(-) Index: Master/texmf/scripts/texlive/tlmgr.pl =================================================================== --- Master.orig/texmf/scripts/texlive/tlmgr.pl 2010-05-02 02:02:39.000000000 +0900 +++ Master/texmf/scripts/texlive/tlmgr.pl 2010-05-02 02:02:43.000000000 +0900 @@ -91,8 +91,13 @@ our %config; # hash of config settings from config file our $tlmediasrc; # media from which we install/update +our %tlmediasrcs; our $tlmediatlpdb; +our %tlmediatlpdbs; our $location; # location from which the new packages come +our %locations; +# hash with *all* installable packages as keys and source as value +our %media_packages; our $localtlmedia; # local installation which we are munging our $localtlpdb; # local installation which we are munging @@ -458,6 +463,9 @@ } elsif ($action =~ m/^repository$/i) { action_repository(); finish(0); + } elsif ($action =~ m/^candidates$/i) { + action_candidates(); + finish(0); } elsif ($action =~ m/^list$/i) { action_list(); finish(0); @@ -3120,6 +3128,32 @@ } +# CANDIDATES +# +sub action_candidates { + init_local_db(1); + init_tlmedias(); + foreach my $pkg (@ARGV) { + my @l = (); + for my $s (keys %tlmediasrcs) { + info("trying $s ...\n"); + my $tlp = $tlmediatlpdbs{$s}->get_package($pkg); + if ($tlp) { + push @l, "$s (" . $tlp->revision . ")"; + } + } + if (@l) { + info("$pkg:\n"); + for my $f (@l) { + info("\t$f\n"); + } + } else { + info("No installation candidate for $pkg\n"); + } + } +} + + # ARCH # sub action_arch { @@ -4228,28 +4262,53 @@ } +sub init_tlmedias +{ + %locations = repository_to_array($localtlpdb->option("location")); + for my $l (keys %locations) { + printf "Init $l\n"; + init_tlmedia($l); + } +} + # initialize the global $tlmediasrc object, or die. # uses the global $location. # sub init_tlmedia { - if (defined($tlmediatlpdb) && ($tlmediatlpdb->root eq $location)) { + my $tag = shift; + # defaults for normal operation with one location setting + my $loc = $location; + my $tlmdb = $tlmediatlpdb; + # if a tag is given, so called via init_tlmedias, redefine the settings + if (defined($tag)) { + $loc = $locations{$tag}; + $tlmdb = $tlmediatlpdbs{$tag}; + } + + + if (defined($tlmdb) && ($tlmdb->root eq $loc)) { # nothing to be done return; } # choose a mirror if we are asked. - if ($location =~ m/^ctan$/i) { - $location = give_ctan_mirror(); - } elsif ($location =~ m,^$TeXLiveServerURL,) { + if ($loc =~ m/^ctan$/i) { + $loc = give_ctan_mirror(); + } elsif ($loc =~ m,^$TeXLiveServerURL,) { my $mirrorbase = TeXLive::TLUtils::give_ctan_mirror_base(); - $location =~ s,^$TeXLiveServerURL,$mirrorbase,; + $loc =~ s,^$TeXLiveServerURL,$mirrorbase,; + } + # + # if we are in the normal case do not forget to update the locations + if (!defined($tag)) { + $location = $loc; } # this "location-url" line should not be changed since GUI programs # depend on it: - print "location-url\t$location\n" if $::machinereadable; - info("tlmgr: package repository $location\n"); + print "location-url\t$loc\n" if $::machinereadable; + info("tlmgr: package repository $loc\n"); # if we talk about a net location try to download the hash of the tlpdb # - if that is possible, check for the locally saved file and if the hash @@ -4260,9 +4319,9 @@ # not work my $local_copy_tlpdb_used = 0; - if ($location =~ m;^(http|ftp)://;) { + if ($loc =~ m;^(http|ftp)://;) { # first check that the saved tlpdb is present at all - my $loc_digest = Digest::MD5::md5_hex($location); + my $loc_digest = Digest::MD5::md5_hex($loc); my $loc_copy_of_remote_tlpdb = "$Master/$InfraLocation/texlive.tlpdb.$loc_digest"; ddebug("loc_digest = $loc_digest\n"); @@ -4271,7 +4330,7 @@ ddebug("loc copy found!\n"); # we found the tlpdb matching the current location # check for the remote hash - my $path = "$location/$InfraLocation/$DatabaseName.md5"; + my $path = "$loc/$InfraLocation/$DatabaseName.md5"; ddebug("remote path of digest = $path\n"); my $fh = TeXLive::TLUtils::download_file($path, "|"); my $rem_digest; @@ -4288,8 +4347,14 @@ END_NO_INTERNET # above text duplicated in TLPDB.pm, sorry. - $tlmediasrc = TeXLive::TLMedia->new(-location => $location, - -tlpdbfile => $loc_copy_of_remote_tlpdb); + if (defined($tag)) { + $tlmediasrcs{$tag} = TeXLive::TLMedia->new(-location => $loc, + -tlpdbfile => $loc_copy_of_remote_tlpdb); + } else { + $tlmediasrc = TeXLive::TLMedia->new(-location => $loc, + -tlpdbfile => $loc_copy_of_remote_tlpdb); + } + $local_copy_tlpdb_used = 1; } else { ddebug("found remote digest: $rem_digest\n"); @@ -4297,8 +4362,13 @@ ddebug("rem_copy_digest = $rem_copy_digest\n"); if ($rem_copy_digest eq $rem_digest) { debug("md5 of local copy identical with remote hash\n"); - $tlmediasrc = TeXLive::TLMedia->new(-location => $location, + if (defined($tag)) { + $tlmediasrcs{$tag} = TeXLive::TLMedia->new(-location => $loc, -tlpdbfile => $loc_copy_of_remote_tlpdb); + } else { + $tlmediasrc = TeXLive::TLMedia->new(-location => $loc, + -tlpdbfile => $loc_copy_of_remote_tlpdb); + } $local_copy_tlpdb_used = 1; } } @@ -4306,23 +4376,34 @@ } if (!$local_copy_tlpdb_used) { # $tlmediasrc is a global variable - $tlmediasrc = TeXLive::TLMedia->new(-location => $location); + if (defined($tag)) { + $tlmediasrcs{$tag} = TeXLive::TLMedia->new(-location => $loc); + } else { + $tlmediasrc = TeXLive::TLMedia->new(-location => $loc); + } + } + if (defined($tag)) { + die($loadmediasrcerror . $location) unless defined($tlmediasrcs{$tag}); + $tlmediatlpdbs{$tag} = $tlmediasrcs{$tag}->tlpdb; + $tlmdb = $tlmediatlpdbs{$tag}; + } else { + die($loadmediasrcerror . $location) unless defined($tlmediasrc); + $tlmediatlpdb = $tlmediasrc->tlpdb; + $tlmdb = $tlmediatlpdb; } - die($loadmediasrcerror . $location) unless defined($tlmediasrc); - $tlmediatlpdb = $tlmediasrc->tlpdb; # if the release from the remote TLPDB does not agree with the # TLConfig::ReleaseYear in the first 4 places break out here. # Why only the first four places: some optional network distributions # might use # release/2009-foobar - my $texlive_release = $tlmediatlpdb->config_release; + my $texlive_release = $tlmdb->config_release; if (!defined($texlive_release) || $texlive_release !~ m/^$TeXLive::TLConfig::ReleaseYear/) { die "The release version of the installation source and the installation media\ndo not agree: source: $texlive_release, media: $TeXLive::TLConfig::ReleaseYear\nPlease fix your location $location"; } # check for being frozen - if ($tlmediatlpdb->option("frozen")) { + if ($tlmdb->option("frozen")) { my $frozen_msg = <writeout($tlfh); + $tlmdb->writeout($tlfh); close($tlfh); } }