diff options
Diffstat (limited to 'Master')
| -rw-r--r-- | Master/tlpkg/dev/dev.multi-source-support-v2.patch | 1265 |
1 files changed, 754 insertions, 511 deletions
diff --git a/Master/tlpkg/dev/dev.multi-source-support-v2.patch b/Master/tlpkg/dev/dev.multi-source-support-v2.patch index 1e01217d56a..f0396eb217f 100644 --- a/Master/tlpkg/dev/dev.multi-source-support-v2.patch +++ b/Master/tlpkg/dev/dev.multi-source-support-v2.patch @@ -1,485 +1,13 @@ -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 22399) +--- tlpkg/TeXLive/TLPDB.pm (revision 22412) +++ tlpkg/TeXLive/TLPDB.pm (working copy) -@@ -73,17 +73,27 @@ - $tlpdb->install_package($pkg, $dest_tlpdb, $nopostinstall, $fallbacktlpdb); +@@ -70,20 +70,30 @@ + $tlpdb->settings; + $tlpdb->setting($key, [$value]); + $tlpdb->sizes_of_packages($opt_src, $opt_doc [, @packs ]); +- $tlpdb->install_package($pkg, $dest_tlpdb, $nopostinstall, $fallbacktlpdb); ++ $tlpdb->install_package($pkg, $dest_tlpdb); $tlpdb->remove_package($pkg, %options); - @@ -604,24 +132,37 @@ Index: tlpkg/TeXLive/TLPDB.pm my @archs; if (defined($archrefs)) { @archs = @$archrefs; -@@ -497,6 +546,16 @@ +@@ -496,6 +545,29 @@ + =cut sub get_package { - my ($self,$pkg) = @_; ++ my ($self,$pkg,$tag) = @_; + if ($self->is_virtual) { -+ my ($maxsrc, $maxrev, $maxtlp, $maxtlmedia) = $self->virtual_candidate($pkg); -+ return $maxtlp; ++ if (defined($tag)) { ++ if (defined($self->{'packages'}{$pkg}{'tags'}{$tag})) { ++ return $self->{'packages'}{$pkg}{'tags'}{$tag}{'tlp'}; ++ } else { ++ tlwarn("package $pkg not found in repository $tag\n"); ++ return; ++ } ++ } else { ++ $tag = $self->{'packages'}{$pkg}{'target'}; ++ if (defined($tag)) { ++ return $self->{'packages'}{$pkg}{'tags'}{$tag}{'tlp'}; ++ } else { ++ return; ++ } ++ } + } else { + return $self->_get_package($pkg); + } +} + +sub _get_package { -+ my ($self,$pkg) = @_; + my ($self,$pkg) = @_; if (defined($self->{'tlps'}{$pkg})) { my $ret = $self->{'tlps'}{$pkg}; - return $self->{'tlps'}{$pkg}; -@@ -507,6 +566,35 @@ +@@ -507,6 +579,35 @@ =pod @@ -657,7 +198,7 @@ Index: tlpkg/TeXLive/TLPDB.pm =item C<< $tlpdb->list_packages >> The C<list_packages> function returns the list of all included packages. -@@ -515,6 +603,15 @@ +@@ -515,6 +616,15 @@ sub list_packages { my $self = shift; @@ -673,7 +214,72 @@ Index: tlpkg/TeXLive/TLPDB.pm return (sort keys %{$self->{'tlps'}}); } -@@ -623,6 +720,7 @@ +@@ -532,6 +642,11 @@ + The next (or first) argument is the target TLPDB, then a list of + packages. + ++In the virtual case, ++if a package name is tagged with C<@repository-tag> then all the ++dependencies will still be expanded between all included databases. ++Only in case of .ARCH dependencies the repository-tag is sticky. ++ + We return the closure of the package list with respect to the depends + operator. (Sorry, that was for mathematicians.) + +@@ -555,7 +670,8 @@ + my %install = (); + my @archs = $totlpdb->available_architectures; + for my $p (@_) { +- $install{$p} = 1; ++ my ($pp, $aa) = split('@', $p); ++ $install{$pp} = (defined($aa) ? $aa : 0);; + } + my $changed = 1; + while ($changed) { +@@ -564,7 +680,7 @@ + ddebug("pre_select = @pre_select\n"); + for my $p (@pre_select) { + next if ($p =~ m/^00texlive/); +- my $pkg = $self->get_package($p); ++ my $pkg = $self->get_package($p, ($install{$p}?$install{$p}:undef)); + if (!defined($pkg)) { + debug("W: $p is mentioned somewhere but not available, disabling\n"); + $install{$p} = 0; +@@ -590,16 +706,19 @@ + if ($p_dep =~ m/^(.*)\.ARCH$/) { + my $foo = "$1"; + foreach $a (@archs) { +- $install{"$foo.$a"} = 1 if defined($self->get_package("$foo.$a")); ++ # install .ARCH packages from the same sub repository as the ++ # main packages ++ $install{"$foo.$a"} = $install{$foo} ++ if defined($self->get_package("$foo.$a")); + } + } elsif ($p_dep =~ m/^(.*)\.win32$/) { + # a win32 package should *only* be installed if we are installing + # the win32 arch + if (grep(/^win32$/,@archs)) { +- $install{$p_dep} = 1; ++ $install{$p_dep} = 0; + } + } else { +- $install{$p_dep} = 1 unless $only_arch; ++ $install{$p_dep} = 0 unless $only_arch; + } + } + } +@@ -611,7 +730,9 @@ + $changed = 1; + } + } +- return(keys %install); ++ # create return list ++ return map { $install{$_} eq "0"?$_:"$_\@" . $install{$_} } keys %install; ++ #return(keys %install); + } + + =pod +@@ -623,6 +744,7 @@ =cut @@ -681,7 +287,7 @@ Index: tlpkg/TeXLive/TLPDB.pm sub find_file { my ($self,$fn) = @_; my @ret; -@@ -856,6 +954,10 @@ +@@ -856,6 +978,10 @@ sub root { my $self = shift; @@ -692,7 +298,7 @@ Index: tlpkg/TeXLive/TLPDB.pm if (@_) { $self->{'root'} = shift } return $self->{'root'}; } -@@ -874,7 +976,11 @@ +@@ -874,7 +1000,11 @@ =cut sub location { @@ -705,7 +311,7 @@ Index: tlpkg/TeXLive/TLPDB.pm return "$self->{'root'}/$InfraLocation/$DatabaseName"; } -@@ -925,8 +1031,14 @@ +@@ -925,8 +1055,14 @@ sub config_src_container { my $self = shift; @@ -722,7 +328,7 @@ Index: tlpkg/TeXLive/TLPDB.pm if ($d =~ m!^container_split_src_files/(.*)$!) { return "$1"; } -@@ -946,8 +1058,14 @@ +@@ -946,8 +1082,14 @@ sub config_doc_container { my $self = shift; @@ -739,7 +345,7 @@ Index: tlpkg/TeXLive/TLPDB.pm if ($d =~ m!^container_split_doc_files/(.*)$!) { return "$1"; } -@@ -966,8 +1084,14 @@ +@@ -966,8 +1108,14 @@ sub config_container_format { my $self = shift; @@ -756,7 +362,7 @@ Index: tlpkg/TeXLive/TLPDB.pm if ($d =~ m!^container_format/(.*)$!) { return "$1"; } -@@ -986,8 +1110,14 @@ +@@ -986,8 +1134,14 @@ sub config_release { my $self = shift; @@ -773,7 +379,7 @@ Index: tlpkg/TeXLive/TLPDB.pm if ($d =~ m!^release/(.*)$!) { return "$1"; } -@@ -1006,8 +1136,14 @@ +@@ -1006,8 +1160,14 @@ sub config_minrelease { my $self = shift; @@ -790,7 +396,7 @@ Index: tlpkg/TeXLive/TLPDB.pm if ($d =~ m!^minrelease/(.*)$!) { return "$1"; } -@@ -1027,8 +1163,14 @@ +@@ -1027,8 +1187,14 @@ sub config_revision { my $self = shift; @@ -807,7 +413,7 @@ Index: tlpkg/TeXLive/TLPDB.pm if ($d =~ m!^revision/(.*)$!) { return "$1"; } -@@ -1054,12 +1196,12 @@ +@@ -1054,12 +1220,12 @@ sub sizes_of_packages { my ($self, $opt_src, $opt_doc, @packs) = @_; @packs || ( @packs = $self->list_packages() ); @@ -821,7 +427,7 @@ Index: tlpkg/TeXLive/TLPDB.pm if (!defined($tlpobjs{$p})) { warn "STRANGE: $p not to be found in ", $self->root; next; -@@ -1083,7 +1225,7 @@ +@@ -1083,7 +1249,7 @@ $size += $tlpobj->srccontainersize if $opt_src; $size += $tlpobj->doccontainersize if $opt_doc; } else { @@ -830,24 +436,68 @@ Index: tlpkg/TeXLive/TLPDB.pm # installation of src and doc file $size = $tlpobj->runsize; $size += $tlpobj->srcsize if $opt_src; -@@ -1106,6 +1248,16 @@ +@@ -1098,31 +1264,46 @@ + + =pod + +-=item C<< $tlpdb->install_package($pkg, $dest_tlpdb, $nopostinstall, $fallbacktlpdb) >> ++=item C<< $tlpdb->install_package($pkg, $dest_tlpdb [, $tag]) >> + + Installs the package $pkg into $dest_tlpdb. ++If C<$tag> is present and the tlpdb is virtual, tries to install $pkg ++from the repository tagged with $tag. + + =cut sub install_package { - my ($self, $pkg, $totlpdb, $nopostinstall, $fallbackmedia) = @_; +- my ($self, $pkg, $totlpdb, $nopostinstall, $fallbackmedia) = @_; ++ my ($self, $pkg, $totlpdb, $tag) = @_; + if ($self->is_virtual) { -+ my ($maxtag, $maxrev, $maxtlp, $maxtlpdb) = $self->virtual_candidate($pkg); -+ return $maxtlpdb->install_package($pkg, $totlpdb, $nopostinstall, $fallbackmedia); ++ if (defined($tag)) { ++ if (defined($self->{'packages'}{$pkg}{'tags'}{$t})) { ++ return $self->{'tlpdbs'}{$t}->install_package($pkg, $totlpdb); ++ } else { ++ tlwarn("package $pkg not found in repository $t\n"); ++ return; ++ } ++ } else { ++ my ($maxtag, $maxrev, $maxtlp, $maxtlpdb) = $self->virtual_candidate($pkg); ++ return $maxtlpdb->install_package($pkg, $totlpdb); ++ } + } else { -+ return $self->not_virtual_install_package($pkg, $totlpdb, $nopostinstall, $fallbackmedia); ++ if (defined($tag)) { ++ tlwarn("not a virtual database, ignoring tag $tag on installation of $pkg\n"); ++ } ++ return $self->not_virtual_install_package($pkg, $totlpdb); + } ++ return; +} + +sub not_virtual_install_package { -+ my ($self, $pkg, $totlpdb, $nopostinstall, $fallbackmedia) = @_; ++ my ($self, $pkg, $totlpdb) = @_; my $fromtlpdb = $self; my $ret; die("TLPDB not initialized, cannot find tlpdb!") unless (defined($fromtlpdb)); -@@ -1170,7 +1322,7 @@ + my $tlpobj = $fromtlpdb->get_package($pkg); + if (!defined($tlpobj)) { +- if (defined($fallbackmedia)) { +- if ($ret = $fallbackmedia->install_package($pkg,$totlpdb, $nopostinstall)) { +- debug("installed $pkg from fallback\n"); +- return $ret; +- } else { +- tlwarn("$0: Cannot find package $pkg (in fallback, either)\n"); +- return 0; +- } +- } else { +- tlwarn("$0: Cannot find package $pkg\n"); +- return 0; +- } ++ tlwarn("$0: Cannot find package $pkg\n"); ++ return 0; + } else { + my $container_src_split = $fromtlpdb->config_src_container; + my $container_doc_split = $fromtlpdb->config_doc_container; +@@ -1170,7 +1351,7 @@ next; } } elsif (&media eq 'NET') { @@ -856,7 +506,54 @@ Index: tlpkg/TeXLive/TLPDB.pm } $self->_install_package ($container, $reloc, \@installfiles, $totlpdb) || return(0); -@@ -1545,7 +1697,12 @@ +@@ -1244,23 +1425,21 @@ + $totlpdb->save; + # compute the return value + TeXLive::TLUtils::announce_execute_actions("enable", $tlpobj); +- if (!$nopostinstall) { +- # do the postinstallation actions +- # +- # Run the post installation code in the postaction tlpsrc entries +- # in case we are on w32 and the admin did install for himself only +- # we switch off admin mode +- if (win32() && admin() && !$totlpdb->option("w32_multi_user")) { +- non_admin(); +- } +- # for now desktop_integration maps to both installation +- # of desktop shortcuts and menu items, but we can split them later +- &TeXLive::TLUtils::do_postaction("install", $tlpobj, +- $totlpdb->option("file_assocs"), +- $totlpdb->option("desktop_integration"), +- $totlpdb->option("desktop_integration"), +- $totlpdb->option("post_code")); ++ # do the postinstallation actions ++ # ++ # Run the post installation code in the postaction tlpsrc entries ++ # in case we are on w32 and the admin did install for himself only ++ # we switch off admin mode ++ if (win32() && admin() && !$totlpdb->option("w32_multi_user")) { ++ non_admin(); + } ++ # for now desktop_integration maps to both installation ++ # of desktop shortcuts and menu items, but we can split them later ++ &TeXLive::TLUtils::do_postaction("install", $tlpobj, ++ $totlpdb->option("file_assocs"), ++ $totlpdb->option("desktop_integration"), ++ $totlpdb->option("desktop_integration"), ++ $totlpdb->option("post_code")); + } + return 1; + } +@@ -1513,7 +1692,7 @@ + # the postaction code part cannot be evaluated now since the + # files are already removed. + # Again, desktop integration maps to desktop and menu links +- if (!$nopostinstall) { ++ if (!$opts{'nopostinstall'}) { + &TeXLive::TLUtils::do_postaction("remove", $tlp, + $localtlpdb->option("file_assocs"), + $localtlpdb->option("desktop_integration"), +@@ -1545,7 +1724,12 @@ sub _set_value_pkg { my ($self,$pkgname,$pre,$key,$value) = @_; my $k = "$pre$key"; @@ -870,7 +567,7 @@ Index: tlpkg/TeXLive/TLPDB.pm my @newdeps; if (!defined($pkg)) { $pkg = new TeXLive::TLPOBJ; -@@ -1583,8 +1740,14 @@ +@@ -1583,8 +1767,14 @@ sub _value_pkg { my ($self,$pkg,$pre,$key) = @_; my $k = "$pre$key"; @@ -887,7 +584,7 @@ Index: tlpkg/TeXLive/TLPDB.pm if ($d =~ m!^$k:(.*)$!) { return "$1"; } -@@ -1697,7 +1860,12 @@ +@@ -1697,7 +1887,12 @@ my ($self, $pre, $hr) = @_; my @allowed = keys %$hr; my %ret; @@ -901,7 +598,7 @@ Index: tlpkg/TeXLive/TLPDB.pm if (defined($pkg)) { foreach my $d ($pkg->depends) { if ($d =~ m!^$pre([^:]*):(.*)!) { -@@ -1846,6 +2014,326 @@ +@@ -1846,6 +2041,329 @@ =back @@ -1154,7 +851,10 @@ Index: tlpkg/TeXLive/TLPDB.pm + + +# implementation copied from Text/Glob.pm (copyright Richard Clamp). -+ ++# changes made: ++# remove $strict_leading_dot and $strict_wildcard_slash if calls ++# and execute the code unconditionally, as we do not change the ++# default settings of 1 of these two variables. +sub glob_to_regex { + my $glob = shift; + my $regex = glob_to_regex_string($glob); @@ -1230,7 +930,7 @@ Index: tlpkg/TeXLive/TLPDB.pm =head1 OPTIONS Index: tlpkg/TeXLive/TLUtils.pm =================================================================== ---- tlpkg/TeXLive/TLUtils.pm (revision 22399) +--- tlpkg/TeXLive/TLUtils.pm (revision 22412) +++ tlpkg/TeXLive/TLUtils.pm (working copy) @@ -62,6 +62,7 @@ TeXLive::TLUtils::setup_programs($bindir, $platform); @@ -1280,3 +980,546 @@ Index: tlpkg/TeXLive/TLUtils.pm =back +Index: texmf/scripts/texlive/tlmgr.pl +=================================================================== +--- texmf/scripts/texlive/tlmgr.pl (revision 22412) ++++ 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 = $mediarev; ++ my @addargs; ++ if ($remotetlpdb->is_virtual) { ++ $mediarevstr .= "\@$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"} + ) { +@@ -2986,6 +3030,14 @@ + @packs = $remotetlpdb->expand_dependencies($localtlpdb, @packs) unless $opts{"no-depends"}; + } + # ++ # expand dependencies returns a list pkg@tag in case of a virtual ++ # remote db. ++ my %packs; ++ for my $p (@packs) { ++ my ($pp, $aa) = split('@', $p); ++ $packs{$pp} = (defined($aa) ? $aa : 0); ++ } ++ # + # installation order of packages: + # first all normal packages, then collections, then schemes + # isn't already installed, but the collection already updated, it will +@@ -2993,7 +3045,7 @@ + my @inst_packs; + my @inst_colls; + my @inst_schemes; +- for my $pkg (sort @packs) { ++ for my $pkg (sort keys %packs) { + # we do name checking here, not to load all tlpobj again and again + if ($pkg =~ m/^scheme-/) { + push @inst_schemes, $pkg; +@@ -3012,7 +3064,11 @@ + my @todo; + for my $pkg (@inst_packs, @inst_colls, @inst_schemes) { + my $pkgrev = 0; +- my $mediatlp = $remotetlpdb->get_package($pkg); ++ # if the package name is asked from a specific repository, use ++ # that one, otherwise leave the decision to $remotetlpdb by not ++ # giving a final argument ++ my $mediatlp = $remotetlpdb->get_package($pkg, ++ ($packs{$pkg} ? $packs{$pkg} : undef)); + if (!defined($mediatlp)) { + tlwarn("package $pkg not present in package repository.\n"); + next; +@@ -3060,13 +3116,26 @@ + my ($estrem, $esttot) = TeXLive::TLUtils::time_estimate($totalsize, + $donesize, $starttime); + my $kb = int($sizes{$pkg} / 1024) + 1; ++ my @addargs = (); ++ my $tagstr = ""; ++ if ($remotetlpdb->is_virtual) { ++ if ($packs{$pkg} ne "0") { ++ push @addargs, $packs{$pkg}; ++ $tagstr = " \@" . $packs{$pkg}; ++ } else { ++ my ($maxtag,undef,undef,undef) = $remotetlpdb->virtual_candidate($pkg); ++ push @addargs, $maxtag; ++ $tagstr = " \@" . $maxtag; ++ } ++ } + if ($::machinereadable) { +- machine_line($pkg, $flag, "-", $revs{$pkg}, $sizes{$pkg}, $estrem, $esttot); ++ machine_line($pkg, $flag, "-", $revs{$pkg}, $sizes{$pkg}, $estrem, $esttot, @addargs); + } else { +- info("[$currnr/$totalnr, $estrem/$esttot] ${re}install: $pkg [${kb}k]\n"); ++ info("[$currnr/$totalnr, $estrem/$esttot] ${re}install: $pkg$tagstr [${kb}k]\n"); + } + if (!$opts{"dry-run"}) { +- $remotetlpdb->install_package($pkg, $localtlpdb); ++ $remotetlpdb->install_package($pkg, $localtlpdb, ++ ($packs{$pkg} ? $packs{$pkg} : undef) ); + logpackage("${re}install: $pkg"); + } + $donesize += $sizes{$pkg}; +@@ -3123,7 +3192,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 +4682,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 +4763,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 +4930,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), |