diff options
| -rw-r--r-- | Master/tlpkg/dev/dev.multi-source-support-v2.patch | 814 |
1 files changed, 478 insertions, 336 deletions
diff --git a/Master/tlpkg/dev/dev.multi-source-support-v2.patch b/Master/tlpkg/dev/dev.multi-source-support-v2.patch index e87a772a1f3..649177ba952 100644 --- a/Master/tlpkg/dev/dev.multi-source-support-v2.patch +++ b/Master/tlpkg/dev/dev.multi-source-support-v2.patch @@ -1,6 +1,482 @@ +Index: texmf/scripts/texlive/tlmgr.pl +=================================================================== +--- texmf/scripts/texlive/tlmgr.pl (revision 22399) ++++ texmf/scripts/texlive/tlmgr.pl (working copy) +@@ -124,6 +124,7 @@ + "package-logfile" => "=s", + "persistent-downloads" => "!", + "no-execute-actions" => 1, ++ "pin-file" => "=s", + "pause" => 1, + "print-platform|print-arch" => 1, + "version" => 1, +@@ -480,6 +481,12 @@ + } elsif ($action =~ m/^option$/i) { + action_option(); + finish(0); ++ } 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); +@@ -1941,7 +1948,12 @@ + # intersection, don't check A\B and B\A + next if $newpkgs_full{$p}; + next if $removals_full{$p}; +- next if ($remotetlpdb->get_package($p)->category ne "Collection"); ++ my $remotetlp = $remotetlpdb->get_package($p); ++ if (!defined($remotetlp)) { ++ tlwarn("Strange, $p mentioned but not found anywhere!\n"); ++ next; ++ } ++ next if ($remotetlp->category ne "Collection"); + my $tlp = $localtlpdb->get_package($p); + if (!defined($tlp)) { + if ($opts{"reinstall-forcibly-removed"}) { +@@ -2042,12 +2054,15 @@ + $ret = 1; + shift; + } +- my ($pkg, $flag, $lrev, $rrev, @args) = @_; ++ my ($pkg, $flag, $lrev, $rrev, $size, $runtime, $esttot, $tag) = @_; + $lrev ||= "-"; + $rrev ||= "-"; + $flag ||= "?"; +- my $str = "$pkg\t$flag\t$lrev\t$rrev\t"; +- $str .= join("\t", @args) if (@args); ++ $size ||= "-"; ++ $runtime ||= "-"; ++ $esttot ||= "-"; ++ $tag ||= "-"; ++ my $str = join("\t", $pkg, $flag, $lrev, $rrev, $size, $runtime, $esttot, $tag); + $str .= "\n"; + return($str) if $ret; + print $str; +@@ -2571,19 +2586,32 @@ + my $unwind_package; + my $remove_unwind_container = 0; + my $rev = $tlp->revision; +- my $mediatlp = $remotetlpdb->get_package($pkg); ++ my $mediatlp; ++ my $maxtag; ++ if ($remotetlpdb->is_virtual) { ++ ($maxtag, undef, $mediatlp, undef) = ++ $remotetlpdb->virtual_candidate($pkg); ++ } else { ++ $mediatlp = $remotetlpdb->get_package($pkg); ++ } + if (!defined($mediatlp)) { + debug("$pkg cannot be found in $location\n"); + next; + } + my $mediarev = $mediatlp->revision; ++ my $mediarevstr = $mediarev; ++ my @addargs = (); ++ if ($remotetlpdb->is_virtual) { ++ push @addargs, $maxtag; ++ $mediarevstr .= "\@$maxtag"; ++ } + $nrupdated++; + if ($opts{"list"}) { + if ($::machinereadable) { +- machine_line($pkg, $FLAG_UPDATE, $rev, $mediarev, $sizes{$pkg}); ++ machine_line($pkg, $FLAG_UPDATE, $rev, $mediarev, $sizes{$pkg}, "-", "-", @addargs); + } else { + my $kb = int($sizes{$pkg} / 1024) + 1; +- info("$pkg [${kb}k]: local: $rev, source: $mediarev (update)\n"); ++ info("$pkg [${kb}k]: local: $rev, source: $mediarevstr (update)\n"); + } + $updated{$pkg} = 1; + next; +@@ -2624,10 +2652,10 @@ + } + + if ($::machinereadable) { +- machine_line($pkg, $FLAG_UPDATE, $rev, $mediarev, $sizes{$pkg}, $estrem, $esttot); ++ machine_line($pkg, $FLAG_UPDATE, $rev, $mediarev, $sizes{$pkg}, $estrem, $esttot, @addargs); + } else { + my $kb = int ($sizes{$pkg} / 1024) + 1; +- info("[$currnr/$totalnr, $estrem/$esttot] update: $pkg [${kb}k] ($rev -> $mediarev)"); ++ info("[$currnr/$totalnr, $estrem/$esttot] update: $pkg [${kb}k] ($rev -> $mediarevstr)"); + } + $donesize += $sizes{$pkg}; + $currnr++; +@@ -2670,7 +2698,7 @@ + } + if ($remotetlpdb->install_package($pkg, $localtlpdb)) { + # installation succeeded because we got a reference +- logpackage("update: $pkg ($rev -> $mediarev)"); ++ logpackage("update: $pkg ($rev -> $mediarevstr)"); + unlink($unwind_package) if $remove_unwind_container; + # remember successful update + $updated{$pkg} = 1; +@@ -2698,7 +2726,7 @@ + # now in fact we should do some cleanup, removing files and + # dirs from the new package before re-installing the old one. + # TODO +- logpackage("failed update: $pkg ($rev -> $mediarev)"); ++ logpackage("failed update: $pkg ($rev -> $mediarevstr)"); + tlwarn("\n\nInstallation of new version of $pkg did fail, trying to unwind.\n"); + if (win32()) { + # w32 is notorious for not releasing a file immediately +@@ -2739,12 +2767,25 @@ + unless $::machinereadable; + } else { + # install new packages +- my $mediatlp = $remotetlpdb->get_package($pkg); ++ my $mediatlp; ++ my $maxtag; ++ if ($remotetlpdb->is_virtual) { ++ ($maxtag, undef, $mediatlp, undef) = ++ $remotetlpdb->virtual_candidate($pkg); ++ } else { ++ $mediatlp = $remotetlpdb->get_package($pkg); ++ } + if (!defined($mediatlp)) { + tlwarn("\nShould not happen: $pkg not found in $location"); + next; + } + my $mediarev = $mediatlp->revision; ++ my $mediarevstr; ++ my @addargs; ++ if ($remotetlpdb->is_virtual) { ++ $mediarevstr = "$mediarev\@$maxtag"; ++ push @addargs, $maxtag; ++ } + my ($estrem, $esttot); + if (!$opts{"list"}) { + ($estrem, $esttot) = TeXLive::TLUtils::time_estimate($totalsize, +@@ -2754,14 +2795,16 @@ + my @maargs = ($pkg, $FLAG_AUTOINSTALL, "-", $mediatlp->revision, $sizes{$pkg}); + if (!$opts{"list"}) { + push @maargs, $estrem, $esttot; ++ } else { ++ push @maargs, undef, undef; + } +- machine_line(@maargs); ++ machine_line(@maargs, @addargs); + } else { + my $kb = int($sizes{$pkg} / 1024) + 1; + if ($opts{"list"}) { +- info("$pkg [${kb}k]: local: <absent>, source: " . $mediatlp->revision . " (auto-install)\n"); ++ info("$pkg [${kb}k]: local: <absent>, source: $mediarevstr (auto-install)\n"); + } else { +- info("[$currnr/$totalnr, $estrem/$esttot] auto-install: $pkg [${kb}k]\n"); ++ info("[$currnr/$totalnr, $estrem/$esttot] auto-install: $pkg ($mediarevstr) [${kb}k]\n"); + } + } + $currnr++; +@@ -2769,7 +2812,7 @@ + next if ($opts{"dry-run"} || $opts{"list"}); + if ($remotetlpdb->install_package($pkg, $localtlpdb)) { + # installation succeeded because we got a reference +- logpackage("auto-install new: $pkg ($mediarev)"); ++ logpackage("auto-install new: $pkg ($mediarevstr)"); + $nrupdated++; + } else { + tlwarn("$0: couldn't install new package $pkg\n"); +@@ -2908,6 +2951,7 @@ + if (!(@new || @updated)) { + info("tlmgr: no updates available\n"); + if ($remotetlpdb->media ne "NET" ++ && $remotetlpdb->media ne "virtual" + && !$opts{"dry-run"} + && !$opts{"repository"} + ) { +@@ -3123,7 +3167,150 @@ + return; + } + ++# REPOSITORY ++# ++# this action manages the list of repositories ++# tlmgr repository list -> lists repositories ++# tlmgr repository add path [tag] -> add repository with optional tag ++# tlmgr repository remove [path|tag] -> removes repository or tag ++# tlmgr repository set path[#tag] [path[#tag] ...] -> sets the list ++# + ++sub array_to_repository { ++ my %r = @_; ++ my @ret; ++ for my $k (keys %r) { ++ my $v = $r{$k}; ++ if ($k eq $v) { ++ push @ret, $k; ++ } else { ++ push @ret, "$v#$k"; ++ } ++ } ++ return "@ret"; ++} ++sub repository_to_array { ++ my $r = shift; ++ my %r; ++ for my $rr (split ' ', $r) { ++ if ($rr =~ m/^([^#]+)#(.*)$/) { ++ $r{$2} = $1; ++ } else { ++ $r{$rr} = $rr; ++ } ++ } ++ return %r; ++} ++sub action_repository { ++ init_local_db(); ++ my $what = shift @ARGV; ++ $what = "list" if !defined($what); ++ my %repos = repository_to_array($localtlpdb->option("location")); ++ if ($what =~ m/^list$/i) { ++ print "List of repositories (with tags if set):\n"; ++ for my $k (keys %repos) { ++ my $v = $repos{$k}; ++ print "\t$v"; ++ if ($k ne $v) { ++ print " ($k)"; ++ } ++ print "\n"; ++ } ++ return; ++ } ++ if ($what eq "add") { ++ my $p = shift @ARGV; ++ if (!defined($p)) { ++ tlwarn("You need to give a new repository aas argument to add\n"); ++ return; ++ } ++ my $t = shift @ARGV; ++ $t = $p if (!defined($t)); ++ if (defined($repos{$t})) { ++ tlwarn("This repository or its tag is already defined, no action\n"); ++ return; ++ } ++ # TODO more checks needed? ++ # if there was till now only *one* repository and that without ++ # a tag, we give that one the "main" tag which is necessary ++ # for proper operation! ++ my @tags = keys %repos; ++ if ($#tags == 0) { ++ # we have only one repository, check if it has the main tag ++ my $maintag = $tags[0]; ++ if ($maintag ne 'main') { ++ $repos{'main'} = $repos{$maintag}; ++ delete $repos{$maintag}; ++ } ++ } ++ $repos{$t} = $p; ++ $localtlpdb->option("location", array_to_repository(%repos)); ++ $localtlpdb->save; ++ return; ++ } ++ if ($what eq "remove") { ++ my $p = shift @ARGV; ++ if (!defined($p)) { ++ tlwarn("Which repository should be removed?\n"); ++ return; ++ } ++ my $found = 0; ++ for my $k (keys %repos) { ++ if ($k eq $p || $repos{$k} eq $p) { ++ $found = 1; ++ delete $repos{$k}; ++ } ++ } ++ if (!$found) { ++ tlwarn("Cannot find the repository $p\n"); ++ } else { ++ $localtlpdb->option("location", array_to_repository(%repos)); ++ $localtlpdb->save; ++ } ++ return; ++ } ++ if ($what eq "set") { ++ %repos = repository_to_array("@ARGV"); ++ $localtlpdb->option("location", array_to_repository(%repos)); ++ $localtlpdb->save; ++ return; ++ } ++ # we are still here, unknown command to repository ++ tlwarn("tlmgr: unknown directive to tlmgr repository: $what\n"); ++ return; ++} ++ ++sub action_candidates { ++ my $what = shift @ARGV; ++ if (!defined($what)) { ++ tlwarn("tlmgr: action candidates needs a package name as argument\n"); ++ return; ++ } ++ init_local_db(); ++ init_tlmedia(); ++ my @cand = $remotetlpdb->candidates($what); ++ if (@cand) { ++ my $first = shift @cand; ++ if (defined($first)) { ++ my ($t,$r) = split(/\//, $first, 2); ++ print "Install candidate for $what from $t ($r)\n"; ++ } else { ++ print "No install candidate for $what found.\n"; ++ } ++ # already shifted away the first element ++ if ($#cand >= 0) { ++ print "Other repositories providing this package:\n"; ++ for my $a (@cand) { ++ my ($t,$r) = split(/\//, $a, 2); ++ print "$t ($r)\n"; ++ } ++ } ++ } else { ++ print "Package $what not found.\n"; ++ } ++ return; ++} ++ + # OPTION + # + sub action_option { +@@ -4470,6 +4657,74 @@ + # + sub init_tlmedia + { ++ # first check if $location contains multiple locations ++ # in this case we go to virtual mode ++ #my %repos = repository_to_array($localtlpdb->option("location")); ++ my %repos = repository_to_array($location); ++ my @tags = keys %repos; ++ # check if we are only one tag/repo ++ if ($#tags == 0) { ++ # go to normal mode ++ _init_tlmedia(); ++ return; ++ } ++ # we are still here, so we have more tags ++ ++ # check that there is a main repository ++ if (!TeXLive::TLUtils::member('main', @tags)) { ++ tldie("Cannot find main repository, you have to tag one as main!\n"); ++ } ++ ++ # TODO TODO ++ # - abstract the set up of a single media tlpdb ++ # - make clear how to check for a already loaded remotetlpdb ++ $remotetlpdb = TeXLive::TLPDB->new(); ++ $remotetlpdb->make_virtual; ++ ++ my $locstr = $repos{'main'}; ++ my $tlmdb = setup_one_remotetlpdb($locstr); ++ $remotetlpdb->virtual_add_tlpdb($tlmdb, "main"); ++ for my $t (@tags) { ++ if ($t ne 'main') { ++ my $tlmdb = setup_one_remotetlpdb($repos{$t}); ++ $remotetlpdb->virtual_add_tlpdb($tlmdb, $t); ++ $locstr .= " $repos{$t}"; ++ } ++ } ++ ++ # now check/setup pinning ++ # TODO for now no default pinning file! ++ if ($opts{"pin-file"}) { ++ my @pins = read_pinning_file($opts{"pin-file"}); ++ if (@pins) { ++ $remotetlpdb->virtual_pinning(@pins); ++ } ++ } else { ++ # check for pinning file in TEXMFLOCAL/tlpkg/pinning.txt ++ chomp (my $TEXMFLOCAL = `kpsewhich -var-value=TEXMFLOCAL`); ++ debug("trying to load pinning file $TEXMFLOCAL/tlpkg/pinning.txt\n"); ++ if (-r "$TEXMFLOCAL/tlpkg/pinning.txt") { ++ my @pins = read_pinning_file("$TEXMFLOCAL/tlpkg/pinning.txt"); ++ if (@pins) { ++ info("tlmgr: using pinning file $TEXMFLOCAL/tlpkg/pinning.txt\n"); ++ $remotetlpdb->virtual_pinning(@pins); ++ } ++ } ++ } ++ ++ ++ # this "location-url" line should not be changed since GUI programs ++ # depend on it: ++ print "location-url\t$locstr\n" if $::machinereadable; ++ info("tlmgr: package repository $locstr\n"); ++ ++} ++ ++ ++ ++ ++sub _init_tlmedia ++{ + if (defined($remotetlpdb) && ($remotetlpdb->root eq $location)) { + # nothing to be done + return; +@@ -4483,11 +4738,29 @@ + $location =~ s,^$TeXLiveServerURL,$mirrorbase,; + } + ++ $remotetlpdb = setup_one_remotetlpdb($location); + # 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"); ++} + ++sub setup_one_remotetlpdb ++{ ++ my $location = shift; ++ my $remotetlpdb; ++ ++ # TODO ++ # check if that is already loaded!!! ++ ++ # choose a mirror if we are asked. ++ if ($location =~ m/^ctan$/i) { ++ $location = give_ctan_mirror(); ++ } elsif ($location =~ m,^$TeXLiveServerURL,) { ++ my $mirrorbase = TeXLive::TLUtils::give_ctan_mirror_base(); ++ $location =~ s,^$TeXLiveServerURL,$mirrorbase,; ++ } ++ + # 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 + # agrees load the local copy if present instead of the remote one, +@@ -4632,8 +4905,30 @@ + close($tlfh); + } + } ++ ++ return($remotetlpdb); + } + ++sub read_pinning_file { ++ my $pf = shift; ++ my @pins; ++ my $pfh; ++ if (!open($pfh, "<$pf")) { ++ tlwarn("Pinning file $pf cannot be read: $!\n"); ++ return; ++ } ++ debug("Reading pinning file $pf\n"); ++ while (my $l = TeXLive::TLUtils::get_full_line($pfh)) { ++ chomp($l); ++ # comments and empty lines are allowed ++ next if ($l =~ m/^\s*#/); ++ next if ($l =~ m/^\s*$/); ++ my ($a, $b) = split(/:/, $l); ++ push @pins, $remotetlpdb->make_pin_data_from_line($l); ++ } ++ close($pfh); ++ return @pins; ++} + + + # finish handles the -pause option (wait for input from stdin), Index: tlpkg/TeXLive/TLPDB.pm =================================================================== ---- tlpkg/TeXLive/TLPDB.pm (revision 22343) +--- tlpkg/TeXLive/TLPDB.pm (revision 22399) +++ tlpkg/TeXLive/TLPDB.pm (working copy) @@ -73,17 +73,27 @@ $tlpdb->install_package($pkg, $dest_tlpdb, $nopostinstall, $fallbacktlpdb); @@ -754,7 +1230,7 @@ Index: tlpkg/TeXLive/TLPDB.pm =head1 OPTIONS Index: tlpkg/TeXLive/TLUtils.pm =================================================================== ---- tlpkg/TeXLive/TLUtils.pm (revision 22343) +--- tlpkg/TeXLive/TLUtils.pm (revision 22399) +++ tlpkg/TeXLive/TLUtils.pm (working copy) @@ -62,6 +62,7 @@ TeXLive::TLUtils::setup_programs($bindir, $platform); @@ -804,337 +1280,3 @@ Index: tlpkg/TeXLive/TLUtils.pm =back -Index: texmf/scripts/texlive/tlmgr.pl -=================================================================== ---- texmf/scripts/texlive/tlmgr.pl (revision 22344) -+++ texmf/scripts/texlive/tlmgr.pl (working copy) -@@ -124,6 +124,7 @@ - "package-logfile" => "=s", - "persistent-downloads" => "!", - "no-execute-actions" => 1, -+ "pin-file" => "=s", - "pause" => 1, - "print-platform|print-arch" => 1, - "version" => 1, -@@ -480,6 +481,12 @@ - } elsif ($action =~ m/^option$/i) { - action_option(); - finish(0); -+ } 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); -@@ -1941,7 +1948,12 @@ - # intersection, don't check A\B and B\A - next if $newpkgs_full{$p}; - next if $removals_full{$p}; -- next if ($remotetlpdb->get_package($p)->category ne "Collection"); -+ my $remotetlp = $remotetlpdb->get_package($p); -+ if (!defined($remotetlp)) { -+ tlwarn("Strange, $p mentioned but not found anywhere!\n"); -+ next; -+ } -+ next if ($remotetlp->category ne "Collection"); - my $tlp = $localtlpdb->get_package($p); - if (!defined($tlp)) { - if ($opts{"reinstall-forcibly-removed"}) { -@@ -2908,6 +2920,7 @@ - if (!(@new || @updated)) { - info("tlmgr: no updates available\n"); - if ($remotetlpdb->media ne "NET" -+ && $remotetlpdb->media ne "virtual" - && !$opts{"dry-run"} - && !$opts{"repository"} - ) { -@@ -3123,7 +3136,150 @@ - return; - } - -+# REPOSITORY -+# -+# this action manages the list of repositories -+# tlmgr repository list -> lists repositories -+# tlmgr repository add path [tag] -> add repository with optional tag -+# tlmgr repository remove [path|tag] -> removes repository or tag -+# tlmgr repository set path[#tag] [path[#tag] ...] -> sets the list -+# - -+sub array_to_repository { -+ my %r = @_; -+ my @ret; -+ for my $k (keys %r) { -+ my $v = $r{$k}; -+ if ($k eq $v) { -+ push @ret, $k; -+ } else { -+ push @ret, "$v#$k"; -+ } -+ } -+ return "@ret"; -+} -+sub repository_to_array { -+ my $r = shift; -+ my %r; -+ for my $rr (split ' ', $r) { -+ if ($rr =~ m/^([^#]+)#(.*)$/) { -+ $r{$2} = $1; -+ } else { -+ $r{$rr} = $rr; -+ } -+ } -+ return %r; -+} -+sub action_repository { -+ init_local_db(); -+ my $what = shift @ARGV; -+ $what = "list" if !defined($what); -+ my %repos = repository_to_array($localtlpdb->option("location")); -+ if ($what =~ m/^list$/i) { -+ print "List of repositories (with tags if set):\n"; -+ for my $k (keys %repos) { -+ my $v = $repos{$k}; -+ print "\t$v"; -+ if ($k ne $v) { -+ print " ($k)"; -+ } -+ print "\n"; -+ } -+ return; -+ } -+ if ($what eq "add") { -+ my $p = shift @ARGV; -+ if (!defined($p)) { -+ tlwarn("You need to give a new repository aas argument to add\n"); -+ return; -+ } -+ my $t = shift @ARGV; -+ $t = $p if (!defined($t)); -+ if (defined($repos{$t})) { -+ tlwarn("This repository or its tag is already defined, no action\n"); -+ return; -+ } -+ # TODO more checks needed? -+ # if there was till now only *one* repository and that without -+ # a tag, we give that one the "main" tag which is necessary -+ # for proper operation! -+ my @tags = keys %repos; -+ if ($#tags == 0) { -+ # we have only one repository, check if it has the main tag -+ my $maintag = $tags[0]; -+ if ($maintag ne 'main') { -+ $repos{'main'} = $repos{$maintag}; -+ delete $repos{$maintag}; -+ } -+ } -+ $repos{$t} = $p; -+ $localtlpdb->option("location", array_to_repository(%repos)); -+ $localtlpdb->save; -+ return; -+ } -+ if ($what eq "remove") { -+ my $p = shift @ARGV; -+ if (!defined($p)) { -+ tlwarn("Which repository should be removed?\n"); -+ return; -+ } -+ my $found = 0; -+ for my $k (keys %repos) { -+ if ($k eq $p || $repos{$k} eq $p) { -+ $found = 1; -+ delete $repos{$k}; -+ } -+ } -+ if (!$found) { -+ tlwarn("Cannot find the repository $p\n"); -+ } else { -+ $localtlpdb->option("location", array_to_repository(%repos)); -+ $localtlpdb->save; -+ } -+ return; -+ } -+ if ($what eq "set") { -+ %repos = repository_to_array("@ARGV"); -+ $localtlpdb->option("location", array_to_repository(%repos)); -+ $localtlpdb->save; -+ return; -+ } -+ # we are still here, unknown command to repository -+ tlwarn("tlmgr: unknown directive to tlmgr repository: $what\n"); -+ return; -+} -+ -+sub action_candidates { -+ my $what = shift @ARGV; -+ if (!defined($what)) { -+ tlwarn("tlmgr: action candidates needs a package name as argument\n"); -+ return; -+ } -+ init_local_db(); -+ init_tlmedia(); -+ my @cand = $remotetlpdb->candidates($what); -+ if (@cand) { -+ my $first = shift @cand; -+ if (defined($first)) { -+ my ($t,$r) = split(/\//, $first, 2); -+ print "Install candidate for $what from $t ($r)\n"; -+ } else { -+ print "No install candidate for $what found.\n"; -+ } -+ # already shifted away the first element -+ if ($#cand >= 0) { -+ print "Other repositories providing this package:\n"; -+ for my $a (@cand) { -+ my ($t,$r) = split(/\//, $a, 2); -+ print "$t ($r)\n"; -+ } -+ } -+ } else { -+ print "Package $what not found.\n"; -+ } -+ return; -+} -+ - # OPTION - # - sub action_option { -@@ -4470,6 +4626,74 @@ - # - sub init_tlmedia - { -+ # first check if $location contains multiple locations -+ # in this case we go to virtual mode -+ #my %repos = repository_to_array($localtlpdb->option("location")); -+ my %repos = repository_to_array($location); -+ my @tags = keys %repos; -+ # check if we are only one tag/repo -+ if ($#tags == 0) { -+ # go to normal mode -+ _init_tlmedia(); -+ return; -+ } -+ # we are still here, so we have more tags -+ -+ # check that there is a main repository -+ if (!TeXLive::TLUtils::member('main', @tags)) { -+ tldie("Cannot find main repository, you have to tag one as main!\n"); -+ } -+ -+ # TODO TODO -+ # - abstract the set up of a single media tlpdb -+ # - make clear how to check for a already loaded remotetlpdb -+ $remotetlpdb = TeXLive::TLPDB->new(); -+ $remotetlpdb->make_virtual; -+ -+ my $locstr = $repos{'main'}; -+ my $tlmdb = setup_one_remotetlpdb($locstr); -+ $remotetlpdb->virtual_add_tlpdb($tlmdb, "main"); -+ for my $t (@tags) { -+ if ($t ne 'main') { -+ my $tlmdb = setup_one_remotetlpdb($repos{$t}); -+ $remotetlpdb->virtual_add_tlpdb($tlmdb, $t); -+ $locstr .= " $repos{$t}"; -+ } -+ } -+ -+ # now check/setup pinning -+ # TODO for now no default pinning file! -+ if ($opts{"pin-file"}) { -+ my @pins = read_pinning_file($opts{"pin-file"}); -+ if (@pins) { -+ $remotetlpdb->virtual_pinning(@pins); -+ } -+ } else { -+ # check for pinning file in TEXMFLOCAL/tlpkg/pinning.txt -+ chomp (my $TEXMFLOCAL = `kpsewhich -var-value=TEXMFLOCAL`); -+ debug("trying to load pinning file $TEXMFLOCAL/tlpkg/pinning.txt\n"); -+ if (-r "$TEXMFLOCAL/tlpkg/pinning.txt") { -+ my @pins = read_pinning_file("$TEXMFLOCAL/tlpkg/pinning.txt"); -+ if (@pins) { -+ info("tlmgr: using pinning file $TEXMFLOCAL/tlpkg/pinning.txt\n"); -+ $remotetlpdb->virtual_pinning(@pins); -+ } -+ } -+ } -+ -+ -+ # this "location-url" line should not be changed since GUI programs -+ # depend on it: -+ print "location-url\t$locstr\n" if $::machinereadable; -+ info("tlmgr: package repository $locstr\n"); -+ -+} -+ -+ -+ -+ -+sub _init_tlmedia -+{ - if (defined($remotetlpdb) && ($remotetlpdb->root eq $location)) { - # nothing to be done - return; -@@ -4483,11 +4707,29 @@ - $location =~ s,^$TeXLiveServerURL,$mirrorbase,; - } - -+ $remotetlpdb = setup_one_remotetlpdb($location); - # 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"); -+} - -+sub setup_one_remotetlpdb -+{ -+ my $location = shift; -+ my $remotetlpdb; -+ -+ # TODO -+ # check if that is already loaded!!! -+ -+ # choose a mirror if we are asked. -+ if ($location =~ m/^ctan$/i) { -+ $location = give_ctan_mirror(); -+ } elsif ($location =~ m,^$TeXLiveServerURL,) { -+ my $mirrorbase = TeXLive::TLUtils::give_ctan_mirror_base(); -+ $location =~ s,^$TeXLiveServerURL,$mirrorbase,; -+ } -+ - # 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 - # agrees load the local copy if present instead of the remote one, -@@ -4632,8 +4874,30 @@ - close($tlfh); - } - } -+ -+ return($remotetlpdb); - } - -+sub read_pinning_file { -+ my $pf = shift; -+ my @pins; -+ my $pfh; -+ if (!open($pfh, "<$pf")) { -+ tlwarn("Pinning file $pf cannot be read: $!\n"); -+ return; -+ } -+ debug("Reading pinning file $pf\n"); -+ while (my $l = TeXLive::TLUtils::get_full_line($pfh)) { -+ chomp($l); -+ # comments and empty lines are allowed -+ next if ($l =~ m/^\s*#/); -+ next if ($l =~ m/^\s*$/); -+ my ($a, $b) = split(/:/, $l); -+ push @pins, $remotetlpdb->make_pin_data_from_line($l); -+ } -+ close($pfh); -+ return @pins; -+} - - - # finish handles the -pause option (wait for input from stdin), |