--- /src/TeX/texlive-svn/Master/tlpkg/TeXLive/TLPDB.pm 2008-09-06 19:11:52.000000000 +0200 +++ tlpkg/TeXLive/TLPDB.pm 2008-09-09 15:11:23.000000000 +0200 @@ -819,26 +819,25 @@ =cut sub _set_option_value { - my ($self,$key,$value) = @_; + my ($self,$key,@values) = @_; my $pkg = $self->{'tlps'}{'00texlive-installation.config'}; my @newdeps; if (!defined($pkg)) { $pkg = new TeXLive::TLPOBJ; $pkg->name("00texlive-installation.config"); $pkg->category("TLCore"); - push @newdeps, "$key:$value"; + for my $v (@values) { + push @newdeps, "$key:$v"; + } } else { my $found = 0; foreach my $d ($pkg->depends) { - if ($d =~ m!^$key:!) { - $found = 1; - push @newdeps, "$key:$value"; - } else { + if ($d !~ m!^$key:!) { push @newdeps, $d; } } - if (!$found) { - push @newdeps, "$key:$value"; + for my $v (@values) { + push @newdeps, "$key:$v"; } } $pkg->depends(@newdeps); @@ -847,13 +846,14 @@ sub _option_value { my ($self,$key) = @_; + my @l = (); if (defined($self->{'tlps'}{'00texlive-installation.config'})) { foreach my $d ($self->{'tlps'}{'00texlive-installation.config'}->depends) { if ($d =~ m!^$key:(.*)$!) { - return "$1"; + push @l, "$1"; } } - return ""; + return(wantarray ? @l : (@l ? $l[0] : "") ); } return; } @@ -889,15 +889,74 @@ if (@_) { $self->_set_option_value("opt_paper", shift); } return $self->_option_value("opt_paper"); } -sub option_location { - my $self = shift; - if (@_) { $self->_set_option_value("location", shift); } - my $loc = $self->_option_value("location"); - if ($loc eq "__MASTER__") { - return $self->root; +# +=pod + +=item C<< $tlpdb->option_locations >> + +Returns a list of tag and locations, so can be assigned to a hash. + +=cut + +sub option_locations { + my $self = shift; + if (@_) { + my %foo = @_; + my @l = (); + for my $k (keys %foo) { + if ($k eq $foo{$k}) { + # no specific tag + push @l, "$k"; + } else { + push @l, "$foo{$k} $k"; + } + } + $self->_set_option_value("location", @l); } - return $self->_option_value("location"); + my @locs = $self->_option_value("location"); + # the locations might contain a tag, the lines are of format + # location tag + my @ret = (); + for my $l (@locs) { + my $loc; + my $tag; + if ($l =~ m/^([^ ]+)[[:space:]]+(.*)[[:space:]]*$/) { + $loc = "$1"; + $tag = "$2"; + debug("reading locations, found loc=$loc, tag=$tag\n"); + } else { + $loc = $tag = $l; + } + # we return a hash as list ... + if ($loc eq "__MASTER__") { + push @ret, $self->root, $self->root; + } else { + push @ret, $tag, $loc; + } + } + return(@ret); +} + +sub add_locations { + my ($self, %locs) = @_; + my %foo = $self->option_locations; + for my $l (keys %locs) { + $foo{$l} = $locs{$l}; + } + $self->option_locations(%foo); + return(%foo); +} + +sub remove_locations { + my ($self, %locs) = @_; + my %foo = $self->option_locations; + for my $l (keys %locs) { + delete $foo{$l} + } + $self->option_locations(%foo); + return(%foo); } + sub option_sys_bin { my $self = shift; if (@_) { $self->_set_option_value("opt_sys_bin", shift); } --- /src/TeX/texlive-svn/Master/texmf/scripts/texlive/tlmgr.pl 2008-09-08 17:19:03.000000000 +0200 +++ texmf/scripts/texlive/tlmgr.pl 2008-09-10 15:54:25.000000000 +0200 @@ -48,15 +48,19 @@ # used variables # the TLMedia from which we install/update -my $tlmediasrc; +my %tlmediasrc; # the tlpdb of the install media -my $tlpdb; +my %tlmediatlpdb; +# flag indicating that the tlmedia has been loaded +my $tlmedia_loaded = 0; +# hash with *all* installable packages as keys and source as value +my %media_packages; # the local tlpdb my $localtlpdb; # a hash for saving the options saved into the local tlpdb my %options; # the location from where we install -my $location; +my %locations; # option handling my $opt_location; @@ -133,6 +137,8 @@ merge_into(\%ret, action_install()); } elsif ($action =~ m/^update$/i) { merge_into(\%ret, action_update()); +} elsif ($action =~ m/^candidates$/i) { + action_candidates(); } elsif ($action =~ m/^backup$/i) { merge_into(\%ret, action_backup()); } elsif ($action =~ m/^restore$/i) { @@ -414,15 +420,13 @@ } init_local_db(); foreach my $pkg (@ARGV) { - my $tlmediatlpdb; my $tlp = $localtlpdb->get_package($pkg); my $installed = 0; if (!$tlp) { - if (!$tlmediatlpdb) { - init_tlmedia(); - $tlmediatlpdb = $tlmediasrc->tlpdb; + init_tlmedia(); + if (defined($media_packages{$pkg})) { + $tlp = $tlmediatlpdb{$media_packages{$pkg}}->get_package($pkg); } - $tlp = $tlmediatlpdb->get_package($pkg); } else { $installed = 1; } @@ -432,6 +436,7 @@ print "ShortDesc: ", $tlp->shortdesc, "\n" if ($tlp->shortdesc); print "LongDesc: ", $tlp->longdesc, "\n" if ($tlp->longdesc); print "Installed: ", ($installed?"Yes\n":"No\n"); + print "Source: ", $media_packages{$pkg}, "\n" if (!$installed); print "\n"; } else { printf STDERR "Cannot find $pkg\n"; @@ -448,17 +453,22 @@ "file" => \$opt_file) or pod2usage(2); my $r = shift @ARGV; my $ret = ""; - my $tlpdb; + my @tlpdbs; + my %packs; init_local_db(); if ($opt_global) { init_tlmedia(); - $tlpdb = $tlmediasrc->tlpdb; + for my $p (keys %media_packages) { + $packs{$p} = $tlmediatlpdb{$media_packages{$p}}; + } } else { - $tlpdb = $localtlpdb; + for my $p ($localtlpdb->list_packages) { + $packs{$p} = $localtlpdb; + } } - foreach my $pkg ($tlpdb->list_packages) { + for my $pkg (keys %packs) { if ($opt_file) { - my @ret = grep(m;$r;, $tlpdb->get_package($pkg)->all_files); + my @ret = grep(m;$r;, $packs{$pkg}->get_package($pkg)->all_files); if (@ret) { print "$pkg:\n"; foreach (@ret) { @@ -467,9 +477,9 @@ } } else { next if ($pkg =~ m/\./); - my $t = $tlpdb->get_package($pkg)->shortdesc; + my $t = $packs{$pkg}->get_package($pkg)->shortdesc; $t |= ""; - my $lt = $tlpdb->get_package($pkg)->longdesc; + my $lt = $packs{$pkg}->get_package($pkg)->longdesc; $lt |= ""; if (($pkg =~ m/$r/) || ($t =~ m/$r/) || ($lt =~ m/$r/)) { $ret .= " $pkg - $t\n"; @@ -614,7 +624,6 @@ "dry-run" => \$opt_dry) or pod2usage(2); my %ret; init_tlmedia(); - my $mediatlpdb = $tlmediasrc->tlpdb; my @todo; if ($opt_all || $opt_list) { @todo = $localtlpdb->list_packages; @@ -625,19 +634,22 @@ # we check for new packages # loop over all installed collections for my $c ($localtlpdb->collections) { - my $tlc = $mediatlpdb->get_package($c); - if (!defined($tlc)) { + my ($maxsrc, $maxrev) = install_candidate($c); + if (!defined($maxsrc)) { debug("collection $c has disappeared from the network!\n"); - } else { - # take all the dependencies of the installed collection - # *as*found* in the network tlpdb - for my $d ($tlc->depends) { - my $tlp = $localtlpdb->get_package($d); - if (!defined($tlp)) { - # there is a dep that is either new or has been forcibly removed - # report it as new/forcibly removed - info("package $d ($c) is new (or has been forcibly removed)\n"); - } + next; + } + my $tlc = $tlmediatlpdb{$maxsrc}->get_package($c); + if (!defined($tlc)) { + debug("That should not happen!!!\n"); + next; + } + for my $d ($tlc->depends) { + my $tlp = $localtlpdb->get_package($d); + if (!defined($tlp)) { + # there is a dep that is either new or has been forcibly removed + # report it as new/forcibly removed + info("package $d ($c) is new (or has been forcibly removed)\n"); } } } @@ -655,18 +667,22 @@ next; } my $rev = $tlp->revision; - my $mediatlp = $mediatlpdb->get_package($pkg); - if (!defined($mediatlp)) { - debug("$pkg cannot be found in $location\n"); + my ($maxsrc, $maxrev) = install_candidate($pkg); + if (!defined($maxsrc)) { + debug("$pkg cannot be found in any of " . values(%locations). "\n"); next; } - my $mediarev = $mediatlp->revision; - if ($rev < $mediarev) { + # if $maxsrc is defined then there is an installation candidate with + # an higher revision number + if ($rev < $maxrev) { + my $tlmediasrc = $tlmediasrc{$maxsrc}; + my $tlmediatlpdb = $tlmediatlpdb{$maxsrc}; + my $mediarev = $maxrev; $nrupdated++; if ($opt_list) { - print "$pkg: local: $rev, source: $mediarev\n"; + print "$pkg: local: $rev, source: $mediarev ($maxsrc)\n"; } elsif ($opt_dry) { - print "Installing $pkg\n"; + print "Installing $pkg ($maxsrc)\n"; } else { # first remove the package, then reinstall it # this way we get rid of useless files @@ -706,7 +722,7 @@ # these packages cannot be upgrade on win32 # so we have to create a update program my $media = $tlmediasrc->media; - my $remoteroot = $mediatlpdb->root; + my $remoteroot = $tlmediatlpdb->root; my $root = $localtlpdb->root; my $temp = "$root/temp"; TeXLive::TLUtils::mkdirhier($temp); @@ -740,8 +756,8 @@ print "update: $pkg done\n"; } } - } elsif ($rev > $mediarev) { - print "$pkg: revision in $location is less then local revision, not updating!\n"; + } else { + debug("$pkg: no installation candidate with higher rev found!\n"); next; } } @@ -761,17 +777,50 @@ ); tlwarn("UPDATER has been created, please execute tlpkg\\installer\\updater.bat\n"); } - if (($nrupdated == 0) && ($tlmediasrc->media ne "NET") && $opt_all) { - # for all but net updates we warn if nothing is updated - tlwarn("\nYour installation is set up to look on the disk for updates.\n"); - tlwarn("If you want to install from the Internet for this one time only, run\n"); - tlwarn(" tlmgr -location $TeXLiveURL\n"); - tlwarn("\nIf you want to change the default for all future updates, run\n"); - tlwarn(" tlmgr option location $TeXLiveURL\n\n"); + if (($nrupdated == 0) && $opt_all) { + my $any_net = 0; + for my $tm (values(%tlmediasrc)) { + if ($tm->media eq "NET") { + $any_net = 1; + last; + } + } + if (!$any_net) { + # for all but net updates we warn if nothing is updated + tlwarn("\nTEXT OUTDATED NEEDS REMARK FOR MULTIPLE LOCATIONS!!!\n"); + tlwarn("\nYour installation is set up to look on the disk for updates.\n"); + tlwarn("If you want to install from the Internet for this one time only, run\n"); + tlwarn(" tlmgr -location $TeXLiveURL\n"); + tlwarn("\nIf you want to change the default for all future updates, run\n"); + tlwarn(" tlmgr option location $TeXLiveURL\n\n"); + } } return(\%ret); } +sub action_candidates { + init_local_db(1); + init_tlmedia(); + foreach my $pkg (@ARGV) { + my @l = (); + for my $s (keys %tlmediasrc) { + my $tlp = $tlmediatlpdb{$s}->get_package($pkg); + if ($tlp) { + push @l, "$s (" . $tlp->revision . ")"; + } + } + if (@l) { + print "$pkg:\n"; + for my $f (@l) { + print "\t$f\n"; + } + } else { + print "No installation candidate for $pkg\ņ"; + } + } +} + + sub action_install { if ($opt_gui) { action_gui("install"); @@ -786,11 +835,38 @@ my %ret; init_tlmedia(); foreach my $pkg (@ARGV) { + my $package = $pkg; + my $tag; + my $maxsrc; + if ($pkg =~ m!^([^/]+)/(.*)$!) { + $package = "$1"; + $tag = "$2"; + if (defined($tlmediatlpdb{$tag})) { + if (defined($tlmediatlpdb{$tag}->get_package($package))) { + # we can actually install from there + $maxsrc = $tag; + } else { + tlwarn("Package $package not found in source $tag\n"); + tlwarn("Skipping installation of $pkg\n"); + next; + } + } else { + tlwarn("The tag $tag for installing $package is not defined!\n"); + tlwarn("Skipping installation of $pkg\n"); + next; + } + } else { + ($maxsrc) = install_candidate($pkg); + if (!defined($maxsrc)) { + tlwarn("No installation candidate for $pkg found!\n"); + } + } + if ($opt_dry) { - print "install: $pkg\n"; + print "install: $package (from $maxsrc)\n"; } else { # install the packages and run postinstall actions (that is the 0) - merge_into(\%ret, $tlmediasrc->install_package($pkg, $localtlpdb, $opt_nodepends, 0)); + merge_into(\%ret, $tlmediasrc{$maxsrc}->install_package($package, $localtlpdb, $opt_nodepends, 0)); } } if ($opt_dry) { @@ -805,13 +881,17 @@ my $what = shift @ARGV; $what || ($what = ""); init_tlmedia(); - my @whattolist; + my @whattolist = (); if ($what =~ m/^collection/i) { - @whattolist = $tlmediasrc->tlpdb->collections; + for my $s (values %tlmediatlpdb) { + push @whattolist, $s->collections; + } } elsif ($what =~ m/^scheme/i) { - @whattolist = $tlmediasrc->tlpdb->schemes; + for my $s (values %tlmediatlpdb) { + push @whattolist, $s->schemes; + } } else { - @whattolist = $tlmediasrc->tlpdb->list_packages; + @whattolist = keys(%media_packages); } foreach (@whattolist) { if (defined($localtlpdb->get_package($_))) { @@ -819,7 +899,7 @@ } else { print " "; } - my $foo = $tlmediasrc->tlpdb->get_package($_)->shortdesc; + my $foo = $tlmediatlpdb{$media_packages{$_}}->get_package($_)->shortdesc; print "$_: ", defined($foo) ? $foo : "(shortdesc missing)" , "\n"; } return; @@ -833,17 +913,68 @@ $what = "show" unless defined($what); init_local_db(); if ($what =~ m/^location$/i) { - # changes the default location - my $loc = shift @ARGV; - if ($loc) { - # normalize the path - $loc = abs_path($loc); - print "Setting default installation source to $loc!\n"; - $localtlpdb->option_location($loc); - $localtlpdb->save; + # the location argument is treated as follows + # location loc1 loc2 loc3 + # location loc1,loc2,loc3 + # sets the list of locations to these three + # location add loc1 [loc2 ...] + # add the location loc to the list + # location remove loc1 [loc2 ...] + # remove the location from the list + my $first = shift @ARGV; + $first || ($first = "show"); + my $mode = "replace"; + my @locargs = (); + if ($first =~ m/^add$/i) { $mode = "add"; } + elsif ($first =~ m/^remove$/i) { $mode = "remove"; } + else { push @locargs, $first unless ($first eq "show"); } + push @locargs, @ARGV; + my @locs; + for my $a (@locargs) { + push @locs, split(/,/,$a); + } + my %locs; + for my $l (@locs) { + if ($l =~ m;^(.+)=(.+)$;) { + $locs{$2} = "$1"; + } else { + $locs{$l} = $l; + } + } + if ($mode eq "add") { + if (@locs) { + print "Adding @locs to the list of installation sources!\n"; + $localtlpdb->add_locations(%locs); + } else { + tlwarn("Need some argument for location add!\n"); + exit(1); + } + } elsif ($mode eq "remove") { + if (@locs) { + print "Removing @locs from the list of installation sources!\n"; + $localtlpdb->remove_locations(%locs); + } else { + tlwarn("Need some argument for location remove!\n"); + exit(1); + } } else { - print "Default installation source: ", $localtlpdb->option_location, "\n"; + if (@locs) { + print "Settings @locs as list of installation sources!\n"; + $localtlpdb->option_locations(%locs); + } else { + my %lo = $localtlpdb->option_locations; + for my $t (keys %lo) { + print "Installation source: "; + if ($t eq $lo{$t}) { + # no tag specified + print "$t\n"; + } else { + print "$lo{$t} (tag $t)\n"; + } + } + } } + $localtlpdb->save; } elsif ($what =~ m/^docfiles$/i) { # changes the default docfiles my $loc = shift @ARGV; @@ -903,10 +1034,16 @@ # list the available architectures # initialize the TLMedia from $location init_tlmedia(); - my $mediatlpdb = $tlmediasrc->tlpdb; + # collect all available architectures from all media sources + my %avail_archs; + for my $tlpdb (values %tlmediatlpdb) { + for my $a ($tlpdb->available_architectures) { + $avail_archs{$a} = 1; + } + } my @already_installed_arch = $localtlpdb->available_architectures; print "Available architectures:\n"; - foreach my $a ($mediatlpdb->available_architectures) { + foreach my $a (keys %avail_archs) { if (member($a,@already_installed_arch)) { print "(i) $a\n"; } else { @@ -918,9 +1055,15 @@ exit(0); } elsif ($what =~ m/^add$/i) { init_tlmedia(); - my $mediatlpdb = $tlmediasrc->tlpdb; + # collect all available architectures from all media sources + my %avail_archs; + for my $tlpdb (values %tlmediatlpdb) { + for my $a ($tlpdb->available_architectures) { + $avail_archs{$a} = 1; + } + } my @already_installed_arch = $localtlpdb->available_architectures; - my @available_arch = $mediatlpdb->available_architectures; + my @available_arch = keys %avail_archs; my @todoarchs; foreach my $a (@ARGV) { if (TeXLive::TLUtils::member($a, @already_installed_arch)) { @@ -943,7 +1086,13 @@ if ($opt_dry) { print "Installing $pkg.$a\n"; } else { - merge_into(\%ret, $tlmediasrc->install_package("$pkg.$a", $localtlpdb, 0, 0)); + my ($maxsrc) = install_candidate("$pkg.$a"); + if (defined($maxsrc)) { + debug("pkg = $pkg, maxsrc = $maxsrc\n"); + merge_into(\%ret, $tlmediasrc{$maxsrc}->install_package("$pkg.$a", $localtlpdb, 0, 0)); + } else { + tlwarn("No installation candidate for $pkg on $a found!\n"); + } } } } @@ -951,9 +1100,14 @@ } if (TeXLive::TLUtils::member('win32', @todoarchs)) { # install the necessary win32 stuff - merge_into (\%ret, $tlmediasrc->install_package("bin-tlperl.win32", $localtlpdb, 1, 0)); - merge_into (\%ret, $tlmediasrc->install_package("bin-tlgs.win32", $localtlpdb, 1, 0)); - merge_into (\%ret, $tlmediasrc->install_package("bin-tlpsv.win32", $localtlpdb, 1, 0)); + for my $p (qw/bin-tlperl bin-tlgs bin-tlpsv/) { + my ($maxsrc) = install_candidate("bin-tlperl.win32"); + if (defined($maxsrc)) { + merge_into (\%ret, $tlmediasrc{$maxsrc}->install_package("$p.win32", $localtlpdb, 1, 0)); + } else { + tlwarn("No installation candidate for $p on win32 found!\n"); + } + } } # update the option_archs list of installed archs my @larchs = $localtlpdb->option_available_architectures; @@ -1026,18 +1180,30 @@ } } # let cmd line options override the settings in localtlpdb - my $loc = $localtlpdb->option_location; - if (defined($loc)) { - $location = $loc; - } + %locations = $localtlpdb->option_locations; if (defined($opt_location)) { - $location = $opt_location; + %locations = (); + for my $c (split /,/, $opt_location) { + $locations{$c} = $c; + } } - if (!defined($location)) { + if (! keys(%locations)) { die("No installation source found, nor in the texlive.tlpdb nor on the cmd line.\nPlease specify one!"); } - # normalize the location - $location = abs_path($location); + # normalize all paths + for my $c (keys %locations) { + if ($c eq $locations{$c}) { + my $newc = abs_path($c); + if ($c ne $newc) { + delete $locations{$c}; + $locations{$newc} = $newc; + } + } else { + my $foo = $locations{$c}; + $foo = abs_path($foo); + $locations{$c} = $foo; + } + } } sub action_gui { @@ -1209,18 +1375,66 @@ # initialize a tlmedia object and returns it, or dies # sub init_tlmedia { - if (($location =~ m/$TeXLiveServerURL/) || - ($location =~ m/^ctan$/i)) { - $location = give_ctan_mirror(); - info("Using mirror $location\n"); - } - # $tlmediasrc is a global function - $tlmediasrc = TeXLive::TLMedia->new($location); - die($loadmediasrcerror . $location) unless defined($tlmediasrc); + return if $tlmedia_loaded; + my $found = 0; + for my $t (keys %locations) { + my $l = $locations{$t}; + my $location = $l; + if (($location =~ m/$TeXLiveServerURL/) || + ($location =~ m/^ctan$/i)) { + $location = give_ctan_mirror(); + info("Using mirror $location\n"); + } + # $tlmediasrc is a global function + $tlmediasrc{$t} = TeXLive::TLMedia->new($location); + if (defined($tlmediasrc{$t})) { + $found++; + $tlmediatlpdb{$t} = $tlmediasrc{$t}->tlpdb; + } else { + info($loadmediasrcerror . $location); + } + } + if (!$found) { + # we didn't find any useable installation media, die here! + die("Cannot find any useable installation source in one of the following locations:\n", values(%locations), "\nStopping here!"); + } + # now we initialize the %media_packages + my @allpkgs; + for my $s (keys %tlmediasrc) { + # will create duplicate entries, but who cares, we are doing hashing then + push @allpkgs, $tlmediatlpdb{$s}->list_packages; + } + for my $p (@allpkgs) { + next if defined($media_packages{$p}); + next if ($p =~ m/00texlive/); + ($media_packages{$p}) = install_candidate($p); + } + $tlmedia_loaded = 1; } - +# +# +sub install_candidate { + my $pkg = shift; + my $maxrev = -1; + my $maxsrc; + for my $s (keys %tlmediasrc) { + my $tlp = $tlmediatlpdb{$s}->get_package($pkg); + if ($tlp) { + my $r = $tlp->revision; + if ($maxrev < $r) { + $maxrev = $r; + $maxsrc = $s; + } + } + } + if ($maxsrc) { + # something was found ($maxsrc, $maxrev, $maxtlp, $maxtlmedia) + return ($maxsrc, $maxrev, $tlmediatlpdb{$maxsrc}->get_package($pkg), $tlmediasrc{$maxsrc}); + } + return; +} # # return all the directories from which all content will be removed