summaryrefslogtreecommitdiff
path: root/Master/tlpkg/dev/dev.multi-source-support-v2.patch
diff options
context:
space:
mode:
authorNorbert Preining <preining@logic.at>2011-05-09 01:52:35 +0000
committerNorbert Preining <preining@logic.at>2011-05-09 01:52:35 +0000
commitec216a6e55d3417a6ae60c5fa91b19aba65113a4 (patch)
tree6c6e1c8409bacd88b322e983cd1483c9ceee4fa3 /Master/tlpkg/dev/dev.multi-source-support-v2.patch
parentb8249ffa853fb863a4bb169e38f749b58312be15 (diff)
update multi-repo support patch
git-svn-id: svn://tug.org/texlive/trunk@22364 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/dev/dev.multi-source-support-v2.patch')
-rw-r--r--Master/tlpkg/dev/dev.multi-source-support-v2.patch440
1 files changed, 275 insertions, 165 deletions
diff --git a/Master/tlpkg/dev/dev.multi-source-support-v2.patch b/Master/tlpkg/dev/dev.multi-source-support-v2.patch
index 576d04b815e..e87a772a1f3 100644
--- a/Master/tlpkg/dev/dev.multi-source-support-v2.patch
+++ b/Master/tlpkg/dev/dev.multi-source-support-v2.patch
@@ -1,8 +1,8 @@
Index: tlpkg/TeXLive/TLPDB.pm
===================================================================
---- tlpkg/TeXLive/TLPDB.pm (revision 22273)
+--- tlpkg/TeXLive/TLPDB.pm (revision 22343)
+++ tlpkg/TeXLive/TLPDB.pm (working copy)
-@@ -73,10 +73,18 @@
+@@ -73,17 +73,27 @@
$tlpdb->install_package($pkg, $dest_tlpdb, $nopostinstall, $fallbacktlpdb);
$tlpdb->remove_package($pkg, %options);
@@ -17,12 +17,23 @@ Index: tlpkg/TeXLive/TLPDB.pm
+ $tlpdb->virtual_get_package($pkg, $tag);
+ $tlpdb->candidates($pkg);
+ $tlpdb->virtual_candidate($pkg);
-+ $tlpdb->virtual_pinning( [\%tlpkpins ] );
++ $tlpdb->virtual_pinning( [@tlpkpins ] );
+
=head1 DESCRIPTION
=cut
-@@ -160,6 +168,10 @@
+
+-use TeXLive::TLConfig;
++use TeXLive::TLConfig qw($CategoriesRegexp $DefaultCategory $InfraLocation
++ $DatabaseName $MetaCategoriesRegexp $Archive
++ %TLPDBOptions %TLPDBSettings);
+ use TeXLive::TLUtils qw(dirname mkdirhier member win32 info log debug ddebug
+- tlwarn basename download_file merge_into);
++ tlwarn basename download_file merge_into tldie);
+ use TeXLive::TLPOBJ;
+
+ use Cwd 'abs_path';
+@@ -158,6 +168,10 @@
sub add_tlpobj {
my ($self,$tlp) = @_;
@@ -33,7 +44,7 @@ Index: tlpkg/TeXLive/TLPDB.pm
$self->{'tlps'}{$tlp->name} = $tlp;
}
-@@ -208,6 +220,10 @@
+@@ -206,6 +220,10 @@
sub remove_tlpobj {
my ($self,$pkg) = @_;
@@ -44,7 +55,7 @@ Index: tlpkg/TeXLive/TLPDB.pm
if (defined($self->{'tlps'}{$pkg})) {
delete $self->{'tlps'}{$pkg};
} else {
-@@ -228,6 +244,10 @@
+@@ -226,6 +244,10 @@
sub from_file {
my ($self, $path) = @_;
@@ -55,7 +66,7 @@ Index: tlpkg/TeXLive/TLPDB.pm
if (@_ != 2) {
die "$0: from_file needs filename for initialization";
}
-@@ -352,6 +372,10 @@
+@@ -350,6 +372,10 @@
sub writeout {
my $self = shift;
@@ -66,7 +77,7 @@ Index: tlpkg/TeXLive/TLPDB.pm
my $fd = (@_ ? $_[0] : STDOUT);
foreach (sort keys %{$self->{'tlps'}}) {
ddebug("writeout: tlpname=$_ ", $self->{'tlps'}{$_}->name, "\n");
-@@ -371,6 +395,10 @@
+@@ -369,6 +395,10 @@
sub save {
my $self = shift;
@@ -77,7 +88,7 @@ Index: tlpkg/TeXLive/TLPDB.pm
my $path = $self->location;
mkdirhier(dirname($path));
my $tmppath = "$path.tmp";
-@@ -392,6 +420,9 @@
+@@ -390,6 +420,9 @@
sub media {
my $self = shift ;
@@ -87,7 +98,7 @@ Index: tlpkg/TeXLive/TLPDB.pm
return $self->{'media'};
}
-@@ -407,6 +438,18 @@
+@@ -405,6 +438,18 @@
sub available_architectures {
my $self = shift;
@@ -106,7 +117,7 @@ Index: tlpkg/TeXLive/TLPDB.pm
my @archs = $self->setting("available_architectures");
if (! @archs) {
# fall back to the old method checking tex\.*
-@@ -434,6 +477,10 @@
+@@ -432,6 +477,10 @@
sub add_tlpcontainer {
my ($self, $package, $ziplocation, $archrefs, $dest) = @_;
@@ -117,7 +128,7 @@ Index: tlpkg/TeXLive/TLPDB.pm
my @archs;
if (defined($archrefs)) {
@archs = @$archrefs;
-@@ -499,6 +546,16 @@
+@@ -497,6 +546,16 @@
sub get_package {
my ($self,$pkg) = @_;
@@ -134,7 +145,7 @@ Index: tlpkg/TeXLive/TLPDB.pm
if (defined($self->{'tlps'}{$pkg})) {
my $ret = $self->{'tlps'}{$pkg};
return $self->{'tlps'}{$pkg};
-@@ -509,6 +566,35 @@
+@@ -507,6 +566,35 @@
=pod
@@ -170,7 +181,7 @@ Index: tlpkg/TeXLive/TLPDB.pm
=item C<< $tlpdb->list_packages >>
The C<list_packages> function returns the list of all included packages.
-@@ -517,6 +603,15 @@
+@@ -515,6 +603,15 @@
sub list_packages {
my $self = shift;
@@ -186,7 +197,7 @@ Index: tlpkg/TeXLive/TLPDB.pm
return (sort keys %{$self->{'tlps'}});
}
-@@ -625,6 +720,7 @@
+@@ -623,6 +720,7 @@
=cut
@@ -194,7 +205,7 @@ Index: tlpkg/TeXLive/TLPDB.pm
sub find_file {
my ($self,$fn) = @_;
my @ret;
-@@ -858,6 +954,10 @@
+@@ -856,6 +954,10 @@
sub root {
my $self = shift;
@@ -205,7 +216,7 @@ Index: tlpkg/TeXLive/TLPDB.pm
if (@_) { $self->{'root'} = shift }
return $self->{'root'};
}
-@@ -876,7 +976,11 @@
+@@ -874,7 +976,11 @@
=cut
sub location {
@@ -218,7 +229,7 @@ Index: tlpkg/TeXLive/TLPDB.pm
return "$self->{'root'}/$InfraLocation/$DatabaseName";
}
-@@ -927,8 +1031,14 @@
+@@ -925,8 +1031,14 @@
sub config_src_container {
my $self = shift;
@@ -235,7 +246,7 @@ Index: tlpkg/TeXLive/TLPDB.pm
if ($d =~ m!^container_split_src_files/(.*)$!) {
return "$1";
}
-@@ -948,8 +1058,14 @@
+@@ -946,8 +1058,14 @@
sub config_doc_container {
my $self = shift;
@@ -252,7 +263,7 @@ Index: tlpkg/TeXLive/TLPDB.pm
if ($d =~ m!^container_split_doc_files/(.*)$!) {
return "$1";
}
-@@ -968,8 +1084,14 @@
+@@ -966,8 +1084,14 @@
sub config_container_format {
my $self = shift;
@@ -269,7 +280,7 @@ Index: tlpkg/TeXLive/TLPDB.pm
if ($d =~ m!^container_format/(.*)$!) {
return "$1";
}
-@@ -988,8 +1110,14 @@
+@@ -986,8 +1110,14 @@
sub config_release {
my $self = shift;
@@ -286,7 +297,7 @@ Index: tlpkg/TeXLive/TLPDB.pm
if ($d =~ m!^release/(.*)$!) {
return "$1";
}
-@@ -1008,8 +1136,14 @@
+@@ -1006,8 +1136,14 @@
sub config_minrelease {
my $self = shift;
@@ -303,7 +314,7 @@ Index: tlpkg/TeXLive/TLPDB.pm
if ($d =~ m!^minrelease/(.*)$!) {
return "$1";
}
-@@ -1029,8 +1163,14 @@
+@@ -1027,8 +1163,14 @@
sub config_revision {
my $self = shift;
@@ -320,7 +331,7 @@ Index: tlpkg/TeXLive/TLPDB.pm
if ($d =~ m!^revision/(.*)$!) {
return "$1";
}
-@@ -1056,12 +1196,12 @@
+@@ -1054,12 +1196,12 @@
sub sizes_of_packages {
my ($self, $opt_src, $opt_doc, @packs) = @_;
@packs || ( @packs = $self->list_packages() );
@@ -334,7 +345,7 @@ Index: tlpkg/TeXLive/TLPDB.pm
if (!defined($tlpobjs{$p})) {
warn "STRANGE: $p not to be found in ", $self->root;
next;
-@@ -1085,7 +1225,7 @@
+@@ -1083,7 +1225,7 @@
$size += $tlpobj->srccontainersize if $opt_src;
$size += $tlpobj->doccontainersize if $opt_doc;
} else {
@@ -343,7 +354,7 @@ Index: tlpkg/TeXLive/TLPDB.pm
# installation of src and doc file
$size = $tlpobj->runsize;
$size += $tlpobj->srcsize if $opt_src;
-@@ -1108,6 +1248,16 @@
+@@ -1106,6 +1248,16 @@
sub install_package {
my ($self, $pkg, $totlpdb, $nopostinstall, $fallbackmedia) = @_;
@@ -360,7 +371,16 @@ Index: tlpkg/TeXLive/TLPDB.pm
my $fromtlpdb = $self;
my $ret;
die("TLPDB not initialized, cannot find tlpdb!") unless (defined($fromtlpdb));
-@@ -1547,7 +1697,12 @@
+@@ -1170,7 +1322,7 @@
+ next;
+ }
+ } elsif (&media eq 'NET') {
+- $container = "$root/$Archive/$pkg.$DefaultContainerExtension";
++ $container = "$root/$Archive/$pkg.$TeXLive::TLConfig::DefaultContainerExtension";
+ }
+ $self->_install_package ($container, $reloc, \@installfiles, $totlpdb)
+ || return(0);
+@@ -1545,7 +1697,12 @@
sub _set_value_pkg {
my ($self,$pkgname,$pre,$key,$value) = @_;
my $k = "$pre$key";
@@ -374,7 +394,7 @@ Index: tlpkg/TeXLive/TLPDB.pm
my @newdeps;
if (!defined($pkg)) {
$pkg = new TeXLive::TLPOBJ;
-@@ -1585,8 +1740,14 @@
+@@ -1583,8 +1740,14 @@
sub _value_pkg {
my ($self,$pkg,$pre,$key) = @_;
my $k = "$pre$key";
@@ -391,7 +411,7 @@ Index: tlpkg/TeXLive/TLPDB.pm
if ($d =~ m!^$k:(.*)$!) {
return "$1";
}
-@@ -1699,7 +1860,12 @@
+@@ -1697,7 +1860,12 @@
my ($self, $pre, $hr) = @_;
my @allowed = keys %$hr;
my %ret;
@@ -405,7 +425,7 @@ Index: tlpkg/TeXLive/TLPDB.pm
if (defined($pkg)) {
foreach my $d ($pkg->depends) {
if ($d =~ m!^$pre([^:]*):(.*)!) {
-@@ -1848,6 +2014,292 @@
+@@ -1846,6 +2014,326 @@
=back
@@ -421,8 +441,9 @@ Index: tlpkg/TeXLive/TLPDB.pm
+
+#
+# packages are saved:
-+# $self->{$pkgname}{$tag}{'revision'} = $rev
-+# $self->{$pkgname}{$tag}{'tlp'} = $tlp
++# $self->{$pkgname}{'tags'}{$tag}{'revision'} = $rev
++# $self->{$pkgname}{'tags'}{$tag}{'tlp'} = $tlp
++# $self->{$pkgname}{'target'} = $target_tag
+#
+
+sub is_virtual {
@@ -454,9 +475,10 @@ Index: tlpkg/TeXLive/TLPDB.pm
+ $self->{'tlpdbs'}{$tag} = $tlpdb;
+ for my $p ($tlpdb->list_packages) {
+ my $tlp = $tlpdb->get_package($p);
-+ $self->{'packages'}{$p}{$tag}{'revision'} = $tlp->revision;
-+ $self->{'packages'}{$p}{$tag}{'tlp'} = $tlp;
++ $self->{'packages'}{$p}{'tags'}{$tag}{'revision'} = $tlp->revision;
++ $self->{'packages'}{$p}{'tags'}{$tag}{'tlp'} = $tlp;
+ }
++ $self->check_evaluate_pinning();
+ return 1;
+}
+
@@ -471,33 +493,68 @@ Index: tlpkg/TeXLive/TLPDB.pm
+ return 0;
+ }
+ for my $p ($self->{'tlpdbs'}{$tag}->list_packages) {
-+ delete $self->{'packages'}{$p}{$tag};
++ delete $self->{'packages'}{$p}{'tags'}{$tag};
+ }
+ delete $self->{'tlpdbs'}{$tag};
++ $self->check_evaluate_pinning();
+ return 1;
+}
+
+sub virtual_get_package {
+ my ($self, $pkg, $tag) = @_;
-+ if (defined($self->{'packages'}{$pkg}{$tag})) {
-+ return $self->{'packages'}{$pkg}{$tag}{'tlp'};
++ if (defined($self->{'packages'}{$pkg}{'tags'}{$tag})) {
++ return $self->{'packages'}{$pkg}{'tags'}{$tag}{'tlp'};
+ } else {
+ tlwarn("pkg $pkg not found in tag $tag\n");
+ return;
+ }
+}
+
++=item C<< $tlpdb->candidates ( $pkg ) >>
++
++Returns the list of candidates for the given package in the
++format
++
++ tag/revision
++
++If the returned list is empty, then the database was not virtual and
++no install candidate was found.
++
++If the returned list contains undef as first element, the database
++is virtual, and no install candidate was found.
++
++The remaining elements in the list are all repositories that provide
++that package.
++
++Note that there might not be an install candidate, but still the
++package is provided by a sub-repository. This can happen if a package
++is present only in the sub-repository and there is no explicit pin
++for that package in the pinning file.
++
++=cut
++
++
+# returns a list of tag/rev
+sub candidates {
-+ my ($self, $pkg) = @_;
++ my $self = shift;
++ my $pkg = shift;
+ my @ret = ();
+ if ($self->is_virtual) {
+ if (defined($self->{'packages'}{$pkg})) {
-+ for my $t (keys %{$self->{'packages'}{$pkg}}) {
-+ my $bla = "$t/" . $self->{'packages'}{$pkg}{$t}{'revision'};
-+ $bla .= "/" . $self->virtual_pin_tag_value($pkg, $t)
-+ if ($self->virtual_pinning);
-+ push @ret, $bla;
++ my $t = $self->{'packages'}{$pkg}{'target'};
++ if (defined($t)) {
++ push @ret, "$t/" . $self->{'packages'}{$pkg}{'tags'}{$t}{'revision'};
++ } else {
++ $t = "";
++ # no target found, but maybe available somewhere else,
++ # we return undef as first one
++ push @ret, undef;
++ }
++ # make sure that we always check for main as repo
++ my @repos = keys %{$self->{'packages'}{$pkg}};
++ for my $r (sort keys %{$self->{'packages'}{$pkg}{'tags'}}) {
++ push @ret, "$r/" . $self->{'packages'}{$pkg}{'tags'}{$r}{'revision'}
++ if ($t ne $r);
+ }
+ }
+ } else {
@@ -509,117 +566,114 @@ Index: tlpkg/TeXLive/TLPDB.pm
+ return @ret;
+}
+
++=item C<< $tlpdb->candidate ( ) >>
++
++Returns either a list of four undef, if no install candidate is found,
++or the following information on the install candidate as list: the tag
++name of the repository, the revision number of the package in the
++candidate repository, the tlpobj of the package in the candidate
++repository, and the candidate repository's TLPDB itself.
++
++=cut
++
+#
-+# computation of install candidates from a list of packagess
-+# this can later be extended to include pinning
+sub virtual_candidate {
+ my ($self, $pkg) = @_;
-+ my $maxrev = -1;
-+ my $maxtag;
-+ #
-+ my $usepinning = $self->virtual_pinning ? 1 : 0;
-+ #
-+ if (defined($self->{'packages'}{$pkg})) {
-+ for my $t (keys %{$self->{'packages'}{$pkg}}) {
-+ my $r;
-+ if ($usepinning) {
-+ $r = $self->virtual_pin_tag_value($pkg, $t);
-+ } else {
-+ $r = $self->{'packages'}{$pkg}{$t}{'revision'};
-+ }
-+ if ($maxrev < $r) {
-+ $maxrev = $r;
-+ $maxtag = $t;
-+ }
-+ }
-+ }
-+ if (defined($maxtag)) {
-+ # something was found ($maxsrc, $maxrev, $maxtlp, $maxtlmedia)
-+ return ($maxtag, $maxrev, $self->{'packages'}{$pkg}{$maxtag}{'tlp'},
-+ $self->{'tlpdbs'}{$maxtag});
++ my $t = $self->{'packages'}{$pkg}{'target'};
++ if (defined($t)) {
++ return ($t, $self->{'packages'}{$pkg}{'tags'}{$t}{'revision'},
++ $self->{'packages'}{$pkg}{'tags'}{$t}{'tlp'}, $self->{'tlpdbs'}{$t});
+ }
+ return(undef,undef,undef,undef);
+}
+
-+=item C<< $tlpdb->virtual_pinning ( [\%pinning_data] ) >>
-+
-+By default the computation of candidates is based on the maximum value
-+of revisions. By setting up pinning data the selection method will
-+switch to pinning. See VIRTUAL DATABASE and PINNING below.
++=item C<< $tlpdb->virtual_pinning ( [@pinning_data] ) >>
+
+Without any argument returns the pinning data, or undef. Be reminded that an
+empty pinning data will behave differently to no pinning data.
+
-+With an argument it must be a ref to a hash containing pinning data
-+in the format described below under PINNING.
++With an argument it must be a list of pins, where each pin
++must be one hash ref with the following keys:
++C<repo> the tag of the repository,
++C<glob> the glob for matching a package
++C<re> the regexp which corresponds to the glob
++C<line> the line where the glob was found (for warning purpose).
+
+=cut
+
+sub virtual_pinning {
+ my $self = shift;
-+ my $pinref = shift;
++ my (@pins) = @_;
+ if (!$self->is_virtual) {
+ tlerror("Not-virtual databases cannot have pinning data.\n");
+ return 0;
+ }
-+ if (!defined($pinref)) {
-+ return ($self->{'pindata'});
++ if (!@pins) {
++ if (!defined($self->{'pindata'})) {
++ my @foo = ();
++ $self->{'pindata'} = \@foo;
++ }
++ return (@{$self->{'pindata'}});
+ } else {
-+ $self->{'pindata'} = $pinref;
++ $self->{'pindata'} = \@pins;
++ $self->check_evaluate_pinning();
+ return ($self->{'pindata'});
+ }
+}
+
-+
-+# compute the pin value from the %tlpkgpins hash
-+# $pins{'catchall'}{$tag} = $pin *:tlcontrib:600
-+# $pins{'glob'}{$pkgglob}{$tag} = $pin texlive*:tlcritical:700
-+# $pins{'name'}{$pkg}{$tag} = $pin pgf:tlcontrib:200
-+#
-+# pins are evaluate according to their level of specifics. First the catch all,
-+# then the one with globs, then the full package names. THe laters *override*
-+# the formers.
-+# Example:
-+# *:main:500
-+# *:tlcontrib:300
-+# context*:tlcontrib:600
-+# context-foobar:privaterepo:900
-+# in this case all packages from main would get 500, all from tlcontrib 300,
-+# so less important. BUt packages matching "context*" would be installed
-+# from tlcontrib, but that again is overriden from context-foobar which
-+# will be installed from privaterepo.
-+# Thus order is not important (besides the case that one puts the same line
-+# two times!)
-+sub virtual_pin_tag_value {
++# $pin{'repo'} = $repo;
++# $pin{'glob'} = $glob;
++# $pin{'re'} = $re;
++# $pin{'line'} = $line; # for debug/warning purpose
++sub make_pin_data_from_line {
+ my $self = shift;
-+ my ($pkg, $tag) = @_;
-+ my %pins = %{$self->{'pindata'}};
-+ # default pin
-+ debug("setting pin $pkg/$tag to 500 (default)\n");
-+ my $pin = 500;
-+ # first the catch all cases
-+ if (defined($pins{'catchall'}{$tag})) {
-+ $pin = $pins{'catchall'}{$tag};
-+ debug("setting pin $pkg/$tag to $pin (catchall case for $tag)\n");
++ my $l = shift;
++ my ($a, $b) = split(/:/, $l);
++ my @ret;
++ my %m;
++ $m{'repo'} = $a;
++ $m{'line'} = $l;
++ # split the package globs
++ for (split(/,/, $b)) {
++ my %mm = %m;
++ $mm{'glob'} = $_;
++ $mm{'re'} = glob_to_regex($_);
++ push @ret, \%mm;
+ }
-+ # next the glob matching
-+ my %pinglobs = %{$pins{'glob'}};
-+ for my $gl (keys %pinglobs) {
-+ my $re = glob_to_regex($gl);
-+ if ($pkg =~ m/$re/) {
-+ if (defined($pins{'glob'}{$gl}{$tag})) {
-+ $pin = $pins{'glob'}{$gl}{$tag};
-+ debug("setting pin $pkg/$tag to $pin (glob case for $gl)\n");
++ return @ret;
++}
++
++sub check_evaluate_pinning {
++ my $self = shift;
++ my @pins = (defined($self->{'pindata'}) ? @{$self->{'pindata'}} : ());
++ #
++ # run through the pin lines and make sure that all the conditions
++ # and requirements are obeyed
++ my %pkgs = %{$self->{'packages'}};
++ # main:*
++ my ($mainpin) = $self->make_pin_data_from_line("main:*");
++ # the default main:* is always considered to be matched
++ $mainpin->{'hit'} = 1;
++ push @pins, $mainpin;
++ for my $pkg (keys %pkgs) {
++ PINS: for my $pp (@pins) {
++ my $pre = $pp->{'re'};
++ if (($pkg =~ m/$pre/) &&
++ (defined($self->{'packages'}{$pkg}{'tags'}{$pp->{'repo'}}))) {
++ $self->{'packages'}{$pkg}{'target'} = $pp->{'repo'};
++ # register that this pin was hit
++ $pp->{'hit'} = 1;
++ last PINS;
+ }
+ }
+ }
-+ # finally normal pkg names
-+ if (defined($pins{'name'}{$pkg}{$tag})) {
-+ $pin = $pins{'name'}{$pkg}{$tag};
-+ debug("setting pin $pkg/$tag to $pin (name case)\n");
++ # check that all pinning lines where hit
++ for my $p (@pins) {
++ next if defined($p->{'hit'});
++ tlwarn("pinning warning: the entry in line\n ", $p->{'line'},
++ "\nconcerning the package pattern ", $p->{'glob'},
++ "\nis not matched by any package!\n");
+ }
-+ debug("final pin for $pkg/$tag = $pin\n");
-+ return $pin;
+}
+
+
@@ -698,9 +752,61 @@ Index: tlpkg/TeXLive/TLPDB.pm
=pod
=head1 OPTIONS
+Index: tlpkg/TeXLive/TLUtils.pm
+===================================================================
+--- tlpkg/TeXLive/TLUtils.pm (revision 22343)
++++ tlpkg/TeXLive/TLUtils.pm (working copy)
+@@ -62,6 +62,7 @@
+ TeXLive::TLUtils::setup_programs($bindir, $platform);
+ TeXLive::TLUtils::tlcmp($file, $file);
+ TeXLive::TLUtils::nulldev();
++ TeXLive::TLUtils::get_full_line($fh);
+
+ =head2 Installer Functions
+
+@@ -180,6 +181,7 @@
+ &setup_persistent_downloads
+ &mktexupd
+ &nulldev
++ &get_full_line
+ );
+ @EXPORT = qw(setup_programs download_file process_logging_options
+ tldie tlwarn info log debug ddebug dddebug debug_hash
+@@ -2424,6 +2426,31 @@
+ return (&win32)? 'nul' : '/dev/null';
+ }
+
++=item C<get_full_line ($fh)>
++
++returns the next line from the file handle $fh, taking
++continuation lines into account (last character of a line is \, and
++no quoting is parsed).
++
++=cut
++
++# open my $f, '<', $file_name or die;
++# while (my $l = get_full_line($f)) { ... }
++# close $f or die;
++sub get_full_line {
++ my ($fh) = @_;
++ my $line = <$fh>;
++ return undef unless defined $line;
++ return $line unless $line =~ s/\\\r?\n$//;
++ my $cont = get_full_line($fh);
++ if (!defined($cont)) {
++ tlwarn('Continuation disallowed at end of file');
++ $cont = "";
++ }
++ $cont =~ s/^\s*//;
++ return $line . $cont;
++}
++
+
+ =back
+
Index: texmf/scripts/texlive/tlmgr.pl
===================================================================
---- texmf/scripts/texlive/tlmgr.pl (revision 22273)
+--- texmf/scripts/texlive/tlmgr.pl (revision 22344)
+++ texmf/scripts/texlive/tlmgr.pl (working copy)
@@ -124,6 +124,7 @@
"package-logfile" => "=s",
@@ -745,7 +851,7 @@ Index: texmf/scripts/texlive/tlmgr.pl
&& !$opts{"dry-run"}
&& !$opts{"repository"}
) {
-@@ -3123,7 +3136,145 @@
+@@ -3123,7 +3136,150 @@
return;
}
@@ -872,15 +978,20 @@ Index: texmf/scripts/texlive/tlmgr.pl
+ init_tlmedia();
+ my @cand = $remotetlpdb->candidates($what);
+ if (@cand) {
-+ print "Candidate(s) for $what (* marks the installation candidate):\n";
-+ my $maxtag = "main";
-+ if ($#cand >= 1) {
-+ ($maxtag) = $remotetlpdb->virtual_candidate($what);
++ 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";
+ }
-+ for my $a (@cand) {
-+ my ($t,$r) = split(/\//, $a, 2);
-+ print (($maxtag eq $t) ? "*" : " ");
-+ print "$t: $r\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";
@@ -891,7 +1002,7 @@ Index: texmf/scripts/texlive/tlmgr.pl
# OPTION
#
sub action_option {
-@@ -4470,6 +4621,70 @@
+@@ -4470,6 +4626,74 @@
#
sub init_tlmedia
{
@@ -920,28 +1031,32 @@ Index: texmf/scripts/texlive/tlmgr.pl
+ $remotetlpdb->make_virtual;
+
+ my $locstr = $repos{'main'};
++ my $tlmdb = setup_one_remotetlpdb($locstr);
++ $remotetlpdb->virtual_add_tlpdb($tlmdb, "main");
+ for my $t (@tags) {
-+ my $tlmdb = setup_one_remotetlpdb($repos{$t});
-+ $remotetlpdb->virtual_add_tlpdb($tlmdb, $t);
-+ $locstr .= " $repos{$t}" if ($t ne 'main');
++ 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);
++ my @pins = read_pinning_file($opts{"pin-file"});
++ if (@pins) {
++ $remotetlpdb->virtual_pinning(@pins);
+ }
+ } else {
-+ # check for pinning file in TEXMFLOCAL/tlpkg/pinning
++ # 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\n");
-+ if (-r "$TEXMFLOCAL/tlpkg/pinning") {
-+ my %pins = read_pinning_file("$TEXMFLOCAL/tlpkg/pinning");
-+ if (%pins) {
-+ info("tlmgr: using pinning file $TEXMFLOCAL/tlpkg/pinning\n");
-+ $remotetlpdb->virtual_pinning(\%pins);
++ 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);
+ }
+ }
+ }
@@ -962,7 +1077,7 @@ Index: texmf/scripts/texlive/tlmgr.pl
if (defined($remotetlpdb) && ($remotetlpdb->root eq $location)) {
# nothing to be done
return;
-@@ -4483,11 +4698,29 @@
+@@ -4483,11 +4707,29 @@
$location =~ s,^$TeXLiveServerURL,$mirrorbase,;
}
@@ -992,7 +1107,7 @@ Index: texmf/scripts/texlive/tlmgr.pl
# 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 +4865,35 @@
+@@ -4632,8 +4874,30 @@
close($tlfh);
}
}
@@ -1002,28 +1117,23 @@ Index: texmf/scripts/texlive/tlmgr.pl
+sub read_pinning_file {
+ my $pf = shift;
-+ my %pins = ();
-+ if (!open(FOO, "<$pf")) {
++ my @pins;
++ my $pfh;
++ if (!open($pfh, "<$pf")) {
+ tlwarn("Pinning file $pf cannot be read: $!\n");
+ return;
+ }
+ debug("Reading pinning file $pf\n");
-+ for my $l (<FOO>) {
++ while (my $l = TeXLive::TLUtils::get_full_line($pfh)) {
+ chomp($l);
-+ my ($a, $b, $c) = split(/:/, $l);
-+ if ($a eq "*") {
-+ $pins{'catchall'}{$b} = $c;
-+ debug("found catchall pin line: $a : $b : $c\n");
-+ } elsif ($a =~ m/[\*\?]/) {
-+ $pins{'glob'}{$a}{$b} = $c;
-+ debug("found glob pin line: $a : $b : $c\n");
-+ } else {
-+ $pins{'name'}{$a}{$b} = $c;
-+ debug("found name pin line: $a : $b : $c\n");
-+ }
++ # 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(FOO);
-+ return %pins;
++ close($pfh);
++ return @pins;
+}