From 86d7c60c406474fa856d8f87d69c7fa52ccacb1b Mon Sep 17 00:00:00 2001 From: Norbert Preining Date: Tue, 17 Apr 2012 04:09:34 +0000 Subject: include multi-repository support into main subversion repo git-svn-id: svn://tug.org/texlive/trunk@26004 c570f23f-e606-0410-a88d-b1316a301751 --- Master/tlpkg/TeXLive/TLPDB.pm | 706 +++++++++++++++++++-- Master/tlpkg/dev/dev.multi-source-support-v2.patch | 230 +++++-- 2 files changed, 812 insertions(+), 124 deletions(-) (limited to 'Master/tlpkg') diff --git a/Master/tlpkg/TeXLive/TLPDB.pm b/Master/tlpkg/TeXLive/TLPDB.pm index a644db08522..7722c0fdf2b 100644 --- a/Master/tlpkg/TeXLive/TLPDB.pm +++ b/Master/tlpkg/TeXLive/TLPDB.pm @@ -70,20 +70,31 @@ C -- A database of TeX Live Packages $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); - TeXLive::TLPDB->listdir([$dir]); $tlpdb->generate_listfiles([$destdir]); + $tlpdb->make_virtual; + $tlpdb->is_virtual; + $tlpdb->virtual_add_tlpdb($tlpdb, $tag); + $tlpdb->virtual_remove_tlpdb($tag); + $tlpdb->virtual_get_package($pkg, $tag); + $tlpdb->candidates($pkg); + $tlpdb->virtual_candidate($pkg); + $tlpdb->virtual_pinning( [@tlpkpins ] ); + =head1 DESCRIPTION =cut -use TeXLive::TLConfig; +use TeXLive::TLConfig qw($CategoriesRegexp $DefaultCategory $InfraLocation + $DatabaseName $MetaCategoriesRegexp $Archive + %TLPDBOptions %TLPDBSettings + $RelocPrefix $RelocTree); 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 TeXLive::TLWinGoo; @@ -123,8 +134,7 @@ sub new { $_listdir = $params{'listdir'} if defined($params{'listdir'}); bless $self, $class; if (defined($params{'tlpdbfile'})) { - my $nr_packages_read - = $self->from_file("$self->{'root'}/$InfraLocation/$DatabaseName"); + my $nr_packages_read = $self->from_file($params{'tlpdbfile'}, '-from-file'); if ($nr_packages_read == 0) { # that is bad, we didn't read anything, so return undef. return undef; @@ -161,6 +171,10 @@ The C adds an object of the type TLPOBJ to the TLPDB. sub add_tlpobj { my ($self,$tlp) = @_; + if ($self->is_virtual) { + tlwarn("cannot add tlpobj to a virtual tlpdb\n"); + return 0; + } $self->{'tlps'}{$tlp->name} = $tlp; } @@ -209,6 +223,10 @@ package is not present sub remove_tlpobj { my ($self,$pkg) = @_; + if ($self->is_virtual) { + tlwarn("cannot remove tlpobj from a virtual tlpdb\n"); + return 0; + } if (defined($self->{'tlps'}{$pkg})) { delete $self->{'tlps'}{$pkg}; } else { @@ -228,15 +246,22 @@ It returns the actual number of packages (TLPOBJs) read from C<$filename>. =cut sub from_file { - my ($self, $path) = @_; - if (@_ != 2) { + my ($self, $path, $arg) = @_; + if ($self->is_virtual) { + tlwarn("cannot initialize from file a virtual tlpdb\n"); + return 0; + } + if (@_ < 2) { die "$0: from_file needs filename for initialization"; } my $root_from_path = dirname(dirname($path)); if (defined($self->{'root'})) { if ($self->{'root'} ne $root_from_path) { - tlwarn("root=$self->{'root'}, root_from_path=$root_from_path\n"); - tlwarn("Initialization from different location as originally given.\nHope you are sure!\n"); + # only warn if we are not given $arg = "-from-file" + if (!defined($arg) || ($arg ne "-from-file")) { + tlwarn("root=$self->{'root'}, root_from_path=$root_from_path\n"); + tlwarn("Initialization from different location as originally given.\nHope you are sure!\n"); + } } } else { $self->root($root_from_path); @@ -362,6 +387,10 @@ the file handle given as argument. sub writeout { my $self = shift; + if ($self->is_virtual) { + tlwarn("cannot write out a virtual tlpdb\n"); + return 0; + } my $fd = (@_ ? $_[0] : STDOUT); foreach (sort keys %{$self->{'tlps'}}) { ddebug("writeout: tlpname=$_ ", $self->{'tlps'}{$_}->name, "\n"); @@ -381,6 +410,10 @@ as location. If the location is undefined, die. sub save { my $self = shift; + if ($self->is_virtual) { + tlwarn("cannot save a virtual tlpdb\n"); + return 0; + } my $path = $self->location; mkdirhier(dirname($path)); my $tmppath = "$path.tmp"; @@ -402,6 +435,9 @@ Returns the media code the respective installation resides on. sub media { my $self = shift ; + if ($self->is_virtual) { + return "virtual"; + } return $self->{'media'}; } @@ -416,6 +452,19 @@ architectures as set in the options section =cut sub available_architectures { + my $self = shift; + my @archs; + if ($self->is_virtual) { + for my $k (keys %{$self->{'tlpdbs'}}) { + TeXLive::TLUtils::push_uniq \@archs, $self->{'tlpdbs'}{$k}->available_architectures; + } + return sort @archs; + } else { + return $self->_available_architectures; + } +} + +sub _available_architectures { my $self = shift; my @archs = $self->setting("available_architectures"); if (! @archs) { @@ -444,6 +493,10 @@ adds new dependencies they are not necessarily fulfilled. sub add_tlpcontainer { my ($self, $package, $ziplocation, $archrefs, $dest) = @_; + if ($self->is_virtual) { + tlwarn("cannot add tlp container to a virtual tlpdb\n"); + return 0; + } my @archs; if (defined($archrefs)) { @archs = @$archrefs; @@ -508,6 +561,29 @@ corresponding to the I, or undef. =cut sub get_package { + my ($self,$pkg,$tag) = @_; + if ($self->is_virtual) { + if (defined($tag)) { + if (defined($self->{'packages'}{$pkg}{'tags'}{$tag})) { + return $self->{'packages'}{$pkg}{'tags'}{$tag}{'tlp'}; + } else { + debug("TLPDB::get_package: 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) = @_; if (defined($self->{'tlps'}{$pkg})) { my $ret = $self->{'tlps'}{$pkg}; @@ -519,6 +595,35 @@ sub get_package { =pod +=item C<< $tlpdb->media_of_package($pkg [, $tag]); + +returns the media type of the package. In the virtual case a tag can +be given and the media of that repository is used, otherwise the +media of the virtual candidate is given. + +=cut + +sub media_of_package { + my ($self, $pkg, $tag) = @_; + if ($self->is_virtual) { + if (defined($tag)) { + if (defined($self->{'tlpdbs'}{$tag})) { + return $self->{'tlpdbs'}{$tag}->media; + } else { + tlwarn ("tag $tag is not known.\n"); + return; + } + } else { + my (undef,undef,undef,$maxtlpdb) = $self->virtual_candidate($pkg); + return $maxtlpdb->media; + } + } else { + return $self->media; + } +} + +=pod + =item C<< $tlpdb->list_packages >> The C function returns the list of all included packages. @@ -526,6 +631,34 @@ The C function returns the list of all included packages. =cut sub list_packages { + my $self = shift; + my $arg = shift; + my $showall = 0; + if (defined($arg) && ($arg eq "-all")) { + $showall = 1; + } + if ($self->is_virtual) { + if ($showall) { + return (sort keys %{$self->{'packages'}}); + } + # we have to be careful here: If a package + # is only present in a subsidiary repository + # and the package is *not* explicitely + # pinned to it, it will not be installable. + # This is what we want. But in this case + # we don't want it to be listed by default. + # + my @pps; + for my $p (keys %{$self->{'packages'}}) { + push @pps, $p if (defined($self->{'packages'}{$p}{'target'})); + } + return (sort @pps); + } else { + return $self->_list_packages; + } +} + +sub _list_packages { my $self = shift; return (sort keys %{$self->{'tlps'}}); } @@ -544,6 +677,11 @@ package onto package) are ignored. 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.) @@ -567,7 +705,8 @@ sub expand_dependencies { 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) { @@ -576,7 +715,7 @@ sub expand_dependencies { 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; @@ -602,16 +741,19 @@ sub expand_dependencies { 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; } } } @@ -623,7 +765,9 @@ sub expand_dependencies { $changed = 1; } } - return(keys %install); + # create return list + return map { $install{$_} eq "0"?$_:"$_\@" . $install{$_} } keys %install; + #return(keys %install); } =pod @@ -635,6 +779,7 @@ containing a file named C. =cut +# TODO adapt for searching in *all* tags ??? sub find_file { my ($self,$fn) = @_; my @ret; @@ -868,6 +1013,10 @@ installation. sub root { my $self = shift; + if ($self->is_virtual) { + tlwarn("cannot set/edit root of a virtual tlpdb\n"); + return 0; + } if (@_) { $self->{'root'} = shift } return $self->{'root'}; } @@ -887,6 +1036,10 @@ special value C<__MASTER>. sub location { my $self = shift; + if ($self->is_virtual) { + tlwarn("cannot get location of a virtual tlpdb\n"); + return 0; + } return "$self->{'root'}/$InfraLocation/$DatabaseName"; } @@ -937,8 +1090,14 @@ container level is set. See Options below. sub config_src_container { my $self = shift; - if (defined($self->{'tlps'}{'00texlive.config'})) { - foreach my $d ($self->{'tlps'}{'00texlive.config'}->depends) { + my $tlp; + if ($self->is_virtual) { + $tlp = $self->{'tlpdbs'}{'main'}->get_package('00texlive.config'); + } else { + $tlp = $self->{'tlps'}{'00texlive.config'}; + } + if (defined($tlp)) { + foreach my $d ($tlp->depends) { if ($d =~ m!^container_split_src_files/(.*)$!) { return "$1"; } @@ -958,8 +1117,14 @@ container level is set. See Options below. sub config_doc_container { my $self = shift; - if (defined($self->{'tlps'}{'00texlive.config'})) { - foreach my $d ($self->{'tlps'}{'00texlive.config'}->depends) { + my $tlp; + if ($self->is_virtual) { + $tlp = $self->{'tlpdbs'}{'main'}->get_package('00texlive.config'); + } else { + $tlp = $self->{'tlps'}{'00texlive.config'}; + } + if (defined($tlp)) { + foreach my $d ($tlp->depends) { if ($d =~ m!^container_split_doc_files/(.*)$!) { return "$1"; } @@ -978,8 +1143,14 @@ Returns the currently set default container format. See Options below. sub config_container_format { my $self = shift; - if (defined($self->{'tlps'}{'00texlive.config'})) { - foreach my $d ($self->{'tlps'}{'00texlive.config'}->depends) { + my $tlp; + if ($self->is_virtual) { + $tlp = $self->{'tlpdbs'}{'main'}->get_package('00texlive.config'); + } else { + $tlp = $self->{'tlps'}{'00texlive.config'}; + } + if (defined($tlp)) { + foreach my $d ($tlp->depends) { if ($d =~ m!^container_format/(.*)$!) { return "$1"; } @@ -998,8 +1169,14 @@ Returns the currently set release. See Options below. sub config_release { my $self = shift; - if (defined($self->{'tlps'}{'00texlive.config'})) { - foreach my $d ($self->{'tlps'}{'00texlive.config'}->depends) { + my $tlp; + if ($self->is_virtual) { + $tlp = $self->{'tlpdbs'}{'main'}->get_package('00texlive.config'); + } else { + $tlp = $self->{'tlps'}{'00texlive.config'}; + } + if (defined($tlp)) { + foreach my $d ($tlp->depends) { if ($d =~ m!^release/(.*)$!) { return "$1"; } @@ -1018,8 +1195,14 @@ Returns the currently allowed minimal release. See Options below. sub config_minrelease { my $self = shift; - if (defined($self->{'tlps'}{'00texlive.config'})) { - foreach my $d ($self->{'tlps'}{'00texlive.config'}->depends) { + my $tlp; + if ($self->is_virtual) { + $tlp = $self->{'tlpdbs'}{'main'}->get_package('00texlive.config'); + } else { + $tlp = $self->{'tlps'}{'00texlive.config'}; + } + if (defined($tlp)) { + foreach my $d ($tlp->depends) { if ($d =~ m!^minrelease/(.*)$!) { return "$1"; } @@ -1039,8 +1222,14 @@ Returns the currently set revision. See Options below. sub config_revision { my $self = shift; - if (defined($self->{'tlps'}{'00texlive.config'})) { - foreach my $d ($self->{'tlps'}{'00texlive.config'}->depends) { + my $tlp; + if ($self->is_virtual) { + $tlp = $self->{'tlpdbs'}{'main'}->get_package('00texlive.config'); + } else { + $tlp = $self->{'tlps'}{'00texlive.config'}; + } + if (defined($tlp)) { + foreach my $d ($tlp->depends) { if ($d =~ m!^revision/(.*)$!) { return "$1"; } @@ -1066,12 +1255,12 @@ which contains the total size of all packages under discussion. sub sizes_of_packages { my ($self, $opt_src, $opt_doc, @packs) = @_; @packs || ( @packs = $self->list_packages() ); - my $media = $self->media; my %tlpsizes; my %tlpobjs; my $totalsize; foreach my $p (@packs) { $tlpobjs{$p} = $self->get_package($p); + my $media = $self->media_of_package($p); if (!defined($tlpobjs{$p})) { warn "STRANGE: $p not to be found in ", $self->root; next; @@ -1110,31 +1299,46 @@ sub size_of_one_package { =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, $tag) = @_; + if ($self->is_virtual) { + if (defined($tag)) { + if (defined($self->{'packages'}{$pkg}{'tags'}{$tag})) { + return $self->{'tlpdbs'}{$tag}->install_package($pkg, $totlpdb); + } else { + tlwarn("package $pkg not found in repository $tag\n"); + return; + } + } else { + my ($maxtag, $maxrev, $maxtlp, $maxtlpdb) = $self->virtual_candidate($pkg); + return $maxtlpdb->install_package($pkg, $totlpdb); + } + } else { + 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) = @_; my $fromtlpdb = $self; my $ret; die("TLPDB not initialized, cannot find tlpdb!") unless (defined($fromtlpdb)); 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; @@ -1182,7 +1386,7 @@ sub install_package { 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); @@ -1256,23 +1460,21 @@ sub install_package { $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; } @@ -1525,7 +1727,7 @@ sub remove_package { # 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"), @@ -1557,7 +1759,12 @@ sub _set_setting_value { sub _set_value_pkg { my ($self,$pkgname,$pre,$key,$value) = @_; my $k = "$pre$key"; - my $pkg = $self->{'tlps'}{$pkgname}; + my $pkg; + if ($self->is_virtual) { + $pkg = $self->{'tlpdbs'}{'main'}->get_package($pkgname); + } else { + $pkg = $self->{'tlps'}{$pkgname}; + } my @newdeps; if (!defined($pkg)) { $pkg = new TeXLive::TLPOBJ; @@ -1595,8 +1802,14 @@ sub _setting_value { sub _value_pkg { my ($self,$pkg,$pre,$key) = @_; my $k = "$pre$key"; - if (defined($self->{'tlps'}{$pkg})) { - foreach my $d ($self->{'tlps'}{$pkg}->depends) { + my $tlp; + if ($self->is_virtual) { + $tlp = $self->{'tlpdbs'}{'main'}->get_package($pkg); + } else { + $tlp = $self->{'tlps'}{$pkg}; + } + if (defined($tlp)) { + foreach my $d ($tlp->depends) { if ($d =~ m!^$k:(.*)$!) { return "$1"; } @@ -1709,7 +1922,12 @@ sub _keyshash { my ($self, $pre, $hr) = @_; my @allowed = keys %$hr; my %ret; - my $pkg = $self->{'tlps'}{'00texlive.installation'}; + my $pkg; + if ($self->is_virtual) { + $pkg = $self->{'tlpdbs'}{'main'}->get_package('00texlive.installation'); + } else { + $pkg = $self->{'tlps'}{'00texlive.installation'}; + } if (defined($pkg)) { foreach my $d ($pkg->depends) { if ($d =~ m!^$pre([^:]*):(.*)!) { @@ -1858,6 +2076,362 @@ sub language_lua_lines { =back +=head1 VIRTUAL DATABASES + +The purpose of virtual databases is to collect several data sources +and present them in one way. The normal functions will always return +the best candidate for the set of functions. + +More docs to be written + +=cut + +# +# packages are saved: +# $self->{'packages'}{$pkgname}{'tags'}{$tag}{'revision'} = $rev +# $self->{'packages'}{$pkgname}{'tags'}{$tag}{'tlp'} = $tlp +# $self->{'packages'}{$pkgname}{'target'} = $target_tag +# + +sub is_virtual { + my $self = shift; + if (defined($self->{'virtual'}) && $self->{'virtual'}) { + return 1; + } + return 0; +} + +sub make_virtual { + my $self = shift; + if (!$self->is_virtual) { + if ($self->list_packages) { + tlerror("Cannot convert a initialized tlpdb to virtual for now!\n"); + return 0; + } + $self->{'virtual'} = 1; + } + return 1; +} + +sub virtual_add_tlpdb { + my ($self, $tlpdb, $tag) = @_; + if (!$self->is_virtual) { + tlerror("Cannot add tlpdb to a non-virtual tlpdb!\n"); + return 0; + } + $self->{'tlpdbs'}{$tag} = $tlpdb; + for my $p ($tlpdb->list_packages) { + my $tlp = $tlpdb->get_package($p); + $self->{'packages'}{$p}{'tags'}{$tag}{'revision'} = $tlp->revision; + $self->{'packages'}{$p}{'tags'}{$tag}{'tlp'} = $tlp; + } + $self->check_evaluate_pinning(); + return 1; +} + +sub virtual_remove_tlpdb { + my ($self, $tag) = @_; + if (!$self->is_virtual) { + tlerror("Cannot remove tlpdb from a non-virtual tlpdb!\n"); + return 0; + } + if (!defined($self->{'tlpdbs'}{$tag})) { + tlwarn("TLPDB virtual_remove_tlpdb: unknown tag $tag\n"); + return 0; + } + for my $p ($self->{'tlpdbs'}{$tag}->list_packages) { + 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}{'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 + +sub is_repository { + my $self = shift; + my $tag = shift; + if (!$self->is_virtual) { + return ( ($tag eq $self->{'root'}) ? 1 : 0 ); + } + return ( defined($self->{'tlpdbs'}{$tag}) ? 1 : 0 ); +} + + +# returns a list of tag/rev +sub candidates { + my $self = shift; + my $pkg = shift; + my @ret = (); + if ($self->is_virtual) { + if (defined($self->{'packages'}{$pkg})) { + 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 { + my $tlp = $self->get_package($pkg); + if (defined($tlp)) { + push @ret, "main/" . $tlp->revision; + } + } + 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 + +# +sub virtual_candidate { + my ($self, $pkg) = @_; + 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] ) >> + +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 list of pins, where each pin +must be one hash ref with the following keys: +C the tag of the repository, +C the glob for matching a package +C the regexp which corresponds to the glob +C the line where the glob was found (for warning purpose). + +=cut + +sub virtual_pinning { + my $self = shift; + my (@pins) = @_; + if (!$self->is_virtual) { + tlerror("Not-virtual databases cannot have pinning data.\n"); + return 0; + } + if (!@pins) { + if (!defined($self->{'pindata'})) { + my @foo = (); + $self->{'pindata'} = \@foo; + } + return (@{$self->{'pindata'}}); + } else { + $self->{'pindata'} = \@pins; + $self->check_evaluate_pinning(); + return ($self->{'pindata'}); + } +} + +# +# current format: +# :[,,...][:] +# only supported options for now is +# revision +# meaning that, if for the selected package there is no other +# "non-revision" pinning, then all repo/package versions are compared +# using normal revision comparison, and the biggest revision number wins. +# That allows you to have the same package in several repos: +# repo1:foo:revision +# repo2:foo:revision +# repo1:* +# repo2:* +# means that: +# for package "foo" the revision numbers of "foo" in the repos "repo1", +# "repo2", and "main" are numerically compared and biggest number wins. +# for all other packages of "repo1" and "repo2", other other repositories +# are not considered. +# +# NOT IMPLEMENTED YET!!! +# +# $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 $l = shift; + my ($a, $b, $c) = split(/:/, $l); + my @ret; + my %m; + $m{'repo'} = $a; + $m{'line'} = $l; + if (defined($c)) { + $m{'options'} = $c; + } + # split the package globs + for (split(/,/, $b)) { + my %mm = %m; + $mm{'glob'} = $_; + $mm{'re'} = glob_to_regex($_); + push @ret, \%mm; + } + 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; + } + } + } + # 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"); + } +} + + +# 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); + return qr/^$regex$/; +} + +sub glob_to_regex_string +{ + my $glob = shift; + my ($regex, $in_curlies, $escaping); + local $_; + my $first_byte = 1; + for ($glob =~ m/(.)/gs) { + if ($first_byte) { + $regex .= '(?=[^\.])' unless $_ eq '.'; + $first_byte = 0; + } + if ($_ eq '/') { + $first_byte = 1; + } + if ($_ eq '.' || $_ eq '(' || $_ eq ')' || $_ eq '|' || + $_ eq '+' || $_ eq '^' || $_ eq '$' || $_ eq '@' || $_ eq '%' ) { + $regex .= "\\$_"; + } + elsif ($_ eq '*') { + $regex .= $escaping ? "\\*" : "[^/]*"; + } + elsif ($_ eq '?') { + $regex .= $escaping ? "\\?" : "[^/]"; + } + elsif ($_ eq '{') { + $regex .= $escaping ? "\\{" : "("; + ++$in_curlies unless $escaping; + } + elsif ($_ eq '}' && $in_curlies) { + $regex .= $escaping ? "}" : ")"; + --$in_curlies unless $escaping; + } + elsif ($_ eq ',' && $in_curlies) { + $regex .= $escaping ? "," : "|"; + } + elsif ($_ eq "\\") { + if ($escaping) { + $regex .= "\\\\"; + $escaping = 0; + } + else { + $escaping = 1; + } + next; + } + else { + $regex .= $_; + $escaping = 0; + } + $escaping = 0; + } + print "# $glob $regex\n" if debug; + + return $regex; +} + +sub match_glob { + print "# ", join(', ', map { "'$_'" } @_), "\n" if debug; + my $glob = shift; + my $regex = glob_to_regex $glob; + local $_; + grep { $_ =~ $regex } @_; +} + =pod =head1 OPTIONS @@ -1919,4 +2493,4 @@ GNU General Public License Version 2 or later. ### tab-width: 2 ### indent-tabs-mode: nil ### End: -# vim:set tabstop=2 expandtab: # +# vim:set tabstop=2 expandtab autoindent: # diff --git a/Master/tlpkg/dev/dev.multi-source-support-v2.patch b/Master/tlpkg/dev/dev.multi-source-support-v2.patch index 18c03dcd4ec..c32c0ff64bf 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 @@ --- texmf/scripts/texlive/tlmgr.pl | 916 ++++++++++++++++++++++++++++++++------ - texmf/scripts/texlive/tlmgrgui.pl | 292 ++++++++++-- + texmf/scripts/texlive/tlmgrgui.pl | 394 ++++++++++++++-- tlpkg/TeXLive/TLPDB.pm | 706 ++++++++++++++++++++++++++--- - 3 files changed, 1665 insertions(+), 249 deletions(-) + 3 files changed, 1767 insertions(+), 249 deletions(-) Index: tlpkg/TeXLive/TLPDB.pm =================================================================== @@ -2241,8 +2241,8 @@ Index: texmf/scripts/texlive/tlmgr.pl Index: texmf/scripts/texlive/tlmgrgui.pl =================================================================== --- texmf/scripts/texlive/tlmgrgui.pl.orig 2011-06-16 21:30:37.000000000 +0900 -+++ texmf/scripts/texlive/tlmgrgui.pl 2012-03-28 14:30:06.000129905 +0900 -@@ -1,7 +1,7 @@ ++++ texmf/scripts/texlive/tlmgrgui.pl 2012-03-29 02:38:57.124639975 +0900 +@@ -1,13 +1,17 @@ #!/usr/bin/env perl # $Id: tlmgrgui.pl 23011 2011-06-16 12:30:37Z preining $ # @@ -2251,7 +2251,17 @@ Index: texmf/scripts/texlive/tlmgrgui.pl # This file is licensed under the GNU General Public License version 2 # or any later version. # -@@ -60,8 +60,15 @@ + # GUI for tlmgr + # version 2, completely rewritten GUI + # ++# ++# TODO FOR MULTI SUPPORT ++# - colorize the General config tab, if something is changed, show it in RED ++# that can actually applied to single repo tlmgrgui, too + # TODO: Fix return codes of execute_action sub items and execute_action + # so that we can give a decent warning window + # TODO: implement path adjustment also for Windows +@@ -60,8 +64,17 @@ our @update_function_list; my $tlpdb_location; @@ -2263,11 +2273,13 @@ Index: texmf/scripts/texlive/tlmgrgui.pl +my $single_repo_mode = 1; +my %repos; +my @tags; ++ ++my $location_button; # uggg, change from far away ... + # # shortcuts for padding, expand/fill, and pack sides, anchors my @p_ii = qw/-padx 2m -pady 2m/; -@@ -97,6 +104,7 @@ +@@ -97,6 +110,7 @@ my $darktext; my $match_entry; my $loaded_text; @@ -2275,7 +2287,7 @@ Index: texmf/scripts/texlive/tlmgrgui.pl # # communication between filters and the rest -@@ -169,6 +177,8 @@ +@@ -169,6 +183,8 @@ # cmd line > tlpdb # save the two possible location for the menu $tlpdb_location = $localtlpdb->option("location"); @@ -2284,7 +2296,7 @@ Index: texmf/scripts/texlive/tlmgrgui.pl if (defined($opts{"location"})) { $cmdline_location = $opts{"location"}; } -@@ -261,14 +271,13 @@ +@@ -261,14 +277,13 @@ -selectmode => "none"); my $button_frame = $mw->Frame; @@ -2303,7 +2315,7 @@ Index: texmf/scripts/texlive/tlmgrgui.pl $loaded_text->pack(-anchor => 'e', -padx => 0, -pady => 0, -ipadx => 0, -ipady => 0, -side => 'right'); -@@ -484,8 +493,14 @@ +@@ -484,8 +499,14 @@ # # FILE MENU # @@ -2319,7 +2331,7 @@ Index: texmf/scripts/texlive/tlmgrgui.pl -command => sub { setup_location($tlpdb_location); }); if (defined($cmdline_location)) { $menu_file->add('command', -label => __("Load cmd line repository:") . " $cmdline_location", -@@ -663,7 +678,7 @@ +@@ -663,7 +684,7 @@ -sticky => "nw"); } $tf->Label(-text => __("Remote Revision:"))->grid( @@ -2328,7 +2340,7 @@ Index: texmf/scripts/texlive/tlmgrgui.pl -sticky => "nw"); if (defined($Packages{$p}{'remotecatalogueversion'})) { $tf->Label(-text => __("Remote Catalogue Version:"))->grid( -@@ -838,7 +853,7 @@ +@@ -838,7 +859,7 @@ $t .= " ($Packages{$p}{'localcatalogueversion'})"; } $g->itemCreate($p, 2, -itemtype => 'text', -style => $st, -text => $t); @@ -2337,7 +2349,7 @@ Index: texmf/scripts/texlive/tlmgrgui.pl if ($Packages{$p}{'remotecatalogueversion'}) { $t .= " ($Packages{$p}{'remotecatalogueversion'})"; } -@@ -905,9 +920,13 @@ +@@ -905,9 +926,13 @@ return 0; } # check first for the default search type, the descriptions @@ -2351,7 +2363,14 @@ Index: texmf/scripts/texlive/tlmgrgui.pl } } if (!$found) { -@@ -1052,6 +1071,13 @@ +@@ -1046,12 +1071,20 @@ + } + %changeddefaults = (); + for my $k (keys %defaults) { ++ $changeddefaults{$k}{'changed'} = 0; + $changeddefaults{$k}{'value'} = $defaults{$k}; + if ($TeXLive::TLConfig::TLPDBOptions{$k}->[0] eq "b") { + $changeddefaults{$k}{'display'} = ($defaults{$k} ? __("Yes") : __("No")); } else { if ($k eq "file_assocs") { $changeddefaults{$k}{'display'} = $fileassocdesc[$defaults{$k}]; @@ -2365,7 +2384,7 @@ Index: texmf/scripts/texlive/tlmgrgui.pl } else { $changeddefaults{$k}{'display'} = $defaults{$k}; } -@@ -1075,11 +1101,23 @@ +@@ -1075,11 +1108,23 @@ push @config_set_l, $back_config_set->Label(-text => __("Default package repository"), -anchor => "w"); @@ -2375,12 +2394,12 @@ Index: texmf/scripts/texlive/tlmgrgui.pl - $back_config_set->Button(-text => __("Change"), - -command => sub { menu_default_location($sw); }); + if ($#tlpdb_tags > 0) { -+ my @vals = map { "$_:$tlpdb_repos{$_}" } sort @tlpdb_tags; -+ my $b = $back_config_set->Button(-relief => 'flat', ++ my @vals = map { "$_:$tlpdb_repos{$_}" } sort sort_main_first @tlpdb_tags; ++ $location_button = $back_config_set->Button(-relief => 'flat', + -textvariable => \$changeddefaults{"location"}{'display'}); -+ $b->configure( -+ -command => sub { transient_show_multiple_repos($b, @vals); }); -+ push @config_set_m, $b; ++ $location_button->configure( ++ -command => sub { transient_show_multiple_repos($location_button, @vals); }); ++ push @config_set_m, $location_button; + push @config_set_r, + $back_config_set->Button(-text => __("Change"), + -command => sub { menu_multi_location($sw); }); @@ -2394,7 +2413,7 @@ Index: texmf/scripts/texlive/tlmgrgui.pl if ($mode_expert) { -@@ -1383,48 +1421,145 @@ +@@ -1383,48 +1428,240 @@ } } @@ -2497,49 +2516,92 @@ Index: texmf/scripts/texlive/tlmgrgui.pl + } +} + ++sub sort_main_first { ++ if ($a eq 'main') { ++ if ($b eq 'main') { ++ return 0; ++ } else { ++ return -1; ++ } ++ } else { ++ if ($b eq 'main') { ++ return 1; ++ } else { ++ return ($a cmp $b); ++ } ++ } ++} + +sub menu_multi_location { + my $mw = shift; + my $val; -+ my $sw = $mw->Toplevel(-title => __("Edit default package repositories")); ++ our $sw = $mw->Toplevel(-title => __("Edit default package repositories")); + $sw->transient($mw); + $sw->grab(); + $sw->Label(-text => __("Specify set of repositories to be used"))->pack(-padx => "2m", -pady => "2m"); + -+ my $f1 = $sw->Frame; -+ my @entry_tag; my $tagw = 10; -+ my @entry_loc; my $locw = 30; ++ our $f1 = $sw->Frame; ++ my @entry_tag; our $tagw = 10; ++ my @entry_loc; our $locw = 30; + my @entry_del; + my @entry_chg; + -+ my %edit_repos = %tlpdb_repos; -+ my @edit_tags = @tlpdb_tags; -+ push @entry_tag, $f1->Entry(-text => 'main', -state => 'readonly', -width => $tagw); -+ push @entry_loc, $f1->Entry(-text => $tlpdb_repos{'main'}, -width => $locw); -+ push @entry_del, $f1->Button(-text => __("Delete"), -state => 'disabled'); -+ push @entry_chg, $f1->Button(-text => __("Change"), -+ -command => sub { -+ my $ret = ask_one_repository($sw, __("Change main package repository"), -+ __("New main package repository")); -+ $edit_repos{'main'} = $ret if (defined($ret)); -+ }); -+ for my $t (sort @edit_tags) { -+ next if ($t eq "main"); -+ push @entry_tag, $f1->Entry(-textvariable => \$t, -width => $tagw); -+ push @entry_loc, $f1->Entry(-textvariable => \$edit_repos{$t}, -width => $locw); -+ push @entry_del, $f1->Button(-text => __("Delete")); -+ push @entry_chg, $f1->Button(-text => __("Change"), ++ my $addrepo_button; ++ ++ ++ sub add_buttons { ++ my ($ref) = @_; ++ my $t = $ref->{'tag'}; ++ $ref->{'tag_w'} = $f1->Entry(-textvariable => \$ref->{'tag'}, -state => ($t eq "main" ? 'readonly' : 'normal'), -width => $tagw); ++ $ref->{'val_w'} = $f1->Entry(-textvariable => \$ref->{'val'}, -width => $locw); ++ $ref->{'del_w'} = $f1->Button(-text => __("Delete"), ++ -state => ($t eq "main" ? 'disabled' : 'normal'), ++ -command => sub { ++ $ref->{'status'} = 0; ++ $ref->{'tag_w'}->configure(-state => 'disabled'); ++ $ref->{'val_w'}->configure(-state => 'disabled'); ++ $ref->{'del_w'}->configure(-state => 'disabled'); ++ $ref->{'chg_w'}->configure(-state => 'disabled'); ++ }); ++ $ref->{'chg_w'} = $f1->Button(-text => __("Change"), + -command => sub { -+ my $ret = ask_one_repository($sw, __("Change subsidiary package repository"), -+ __("New subsidiary package repository")); -+ $edit_repos{$t} = $ret if (defined($ret)); ++ my $ret = ask_one_repository($sw, __("Change " . ($t eq "main" ? "main" : "subsidiary") . " package repository"), ++ __(($t eq "main" ? "Change main" : "New subsidiary") . " package repository")); ++ $ref->{'val'} = $ret if (defined($ret)); + }); + } -+ # add some "Add ..." line? TODO -+ for my $i (0..$#entry_tag) { -+ $entry_tag[$i]->grid( $entry_loc[$i], $entry_del[$i], $entry_chg[$i], ++ ++ my %changed_repos = repository_to_array($changeddefaults{'location'}{'value'}); ++ ++ my @edit_repos; ++ push @edit_repos, { 'tag' => 'main', 'val' => $changed_repos{'main'}, 'status' => 1}; ++ for my $k (sort keys %changed_repos) { ++ next if ($k eq "main"); ++ push @edit_repos, { 'tag'=> $k, 'val' => $changed_repos{$k}, 'status' => 1 }; ++ } ++ for my $ref (@edit_repos) { ++ add_buttons($ref); ++ } ++ for my $ref (@edit_repos) { ++ my %foo = %$ref; ++ $foo{'tag_w'}->grid($foo{'val_w'}, $foo{'del_w'}, $foo{'chg_w'}, + -padx => "1m", -pady => "1m", -sticky => "nwe"); + } ++ $addrepo_button = $f1->Button(-text => __("Add repository") . "...", ++ -command => sub { ++ my $ret = ask_one_repository($sw, __("Add package repository"), ++ __("Add package repository")); ++ if (defined($ret)) { ++ $addrepo_button->gridForget; ++ my %foo = ( 'tag' => $ret, 'val' => $ret, 'status' => 1 ); ++ add_buttons(\%foo); ++ $foo{'tag_w'}->grid($foo{'val_w'}, $foo{'del_w'}, $foo{'chg_w'}, ++ -padx => "1m", -pady => "1m", -sticky => "nwe"); ++ push @edit_repos, \%foo; ++ } ++ $addrepo_button->grid(-columnspan => 2, -column => 2); ++ }); ++ $addrepo_button->grid(-columnspan => 2, -column => 2); + + $f1->pack; + @@ -2549,17 +2611,69 @@ Index: texmf/scripts/texlive/tlmgrgui.pl sub { - $changeddefaults{'location'}{'value'} = - $changeddefaults{'location'}{'display'} = $entry->get; -+ print "TODO TODO TODO ___ EDITING OF MULTIPLE NOT SUPPORTED!!!\nWE ALSO HAVE TO MAKE SURE THAT THERE IS ONE MAIN AND NOT MORE ETC ETC\n"; ++ # we have to check if something has changed ... and for consistency!!! ++ my %new_repos; ++ for my $ref (@edit_repos) { ++ my %foo = %$ref; ++ if ($foo{'status'}) { ++ if (defined($new_repos{$foo{'tag'}})) { ++ $sw->Dialog(-title => __("Warning"), ++ -text => __("Multiple defined tags (first column) are not possible, please fix it."), -buttons => [ __("Ok") ])->Show; ++ return; ++ } ++ $new_repos{$foo{'tag'}} = $foo{'val'}; ++ } ++ } ++ my $differs = 0; ++ for my $k (keys %changed_repos) { ++ if (!defined($new_repos{$k})) { ++ $differs = 1; ++ last; ++ } ++ if ($changed_repos{$k} ne $new_repos{$k}) { ++ $differs = 1; ++ last; ++ } ++ } ++ if (!$differs) { ++ # do the same the other way round ++ for my $k (keys %new_repos) { ++ if (!defined($changed_repos{$k})) { ++ $differs = 1; ++ last; ++ } ++ if ($changed_repos{$k} ne $new_repos{$k}) { ++ $differs = 1; ++ last; ++ } ++ } ++ } ++ if ($differs) { ++ # print "current repos:\n"; ++ # for my $ref (@edit_repos) { ++ # print "tag = $ref->{'tag'}\n"; ++ # print "val = $ref->{'val'}\n"; ++ # print "act = $ref->{'status'}\n"; ++ # } ++ $changeddefaults{'location'}{'value'} = array_to_repository(%new_repos); ++ $changeddefaults{'location'}{'display'} = __("multiple repositories"); ++ my @vals = map { "$_:$new_repos{$_}" } ++ sort sort_main_first keys %new_repos; ++ $location_button->configure( ++ -command => sub { transient_show_multiple_repos($location_button, @vals); }); ++ } else { ++ # print "Nothing happend!\n"; ++ } $sw->destroy; })->pack(-side => 'left',-padx => "2m", -pady => "2m"); my $cancelbutton = $f->Button(-text => __("Cancel"), -command => sub { $sw->destroy })->pack(-side => 'right',-padx => "2m", -pady => "2m"); + my $resetbutton = $f->Button(-text => __("Revert"), -+ -command => sub { print "TODO REVERT SETTINGS\n"; })->pack(-side => 'right',-padx => "2m", -pady => "2m"); ++ -command => sub { $sw->destroy; menu_multi_location($mw); })->pack(-side => 'right',-padx => "2m", -pady => "2m"); $f->pack(-expand => 'x'); $sw->bind('', [ $okbutton, 'Invoke' ]); $sw->bind('', [ $cancelbutton, 'Invoke' ]); -@@ -1554,19 +1689,27 @@ +@@ -1554,19 +1791,27 @@ sub setup_location { my $loc = shift; $location = $loc; @@ -2592,7 +2706,7 @@ Index: texmf/scripts/texlive/tlmgrgui.pl $mw->Unbusy; if (!defined($remotetlpdb)) { # something went badly wrong, maybe the newroot is wrong? -@@ -1725,7 +1868,7 @@ +@@ -1725,7 +1970,7 @@ # sub populate_Packages # sub populate_Packages { @@ -2601,7 +2715,7 @@ Index: texmf/scripts/texlive/tlmgrgui.pl my $p = $tlp->name; $Packages{$p}{'displayname'} = $p; if ($mode eq "local") { -@@ -1736,6 +1879,10 @@ +@@ -1736,6 +1981,10 @@ $Packages{$p}{'tlp'} = $tlp; } else { $Packages{$p}{'remoterevision'} = $tlp->revision; @@ -2612,7 +2726,7 @@ Index: texmf/scripts/texlive/tlmgrgui.pl $Packages{$p}{'selected'} = 0 unless defined $Packages{$p}{'selected'}; if (!defined($Packages{$p}{'tlp'})) { -@@ -1865,6 +2012,7 @@ +@@ -1865,6 +2114,7 @@ next; } delete $Packages{$p}{'remoterevision'}; @@ -2620,7 +2734,7 @@ Index: texmf/scripts/texlive/tlmgrgui.pl delete $Packages{$p}{'remotecatalogueversion'}; } if (defined($remotetlpdb)) { -@@ -1875,8 +2023,15 @@ +@@ -1875,8 +2125,15 @@ push @do_later_media, $p; next; } @@ -2638,7 +2752,7 @@ Index: texmf/scripts/texlive/tlmgrgui.pl } } my @avail_arch = $localtlpdb->available_architectures; -@@ -1886,9 +2041,16 @@ +@@ -1886,9 +2143,16 @@ tlerror("very strange, above it matched and now not anymore?!?! $p\n"); next; } @@ -2657,7 +2771,7 @@ Index: texmf/scripts/texlive/tlmgrgui.pl } else { # two cases: # - $mp.$ma where $ma is in available_archs -@@ -1926,7 +2088,7 @@ +@@ -1926,7 +2190,7 @@ } else { # only show that one if it is locally installed if (defined($Packages{$p})) { @@ -2666,7 +2780,7 @@ Index: texmf/scripts/texlive/tlmgrgui.pl } } } -@@ -2216,7 +2378,47 @@ +@@ -2216,7 +2480,47 @@ sub update_loaded_location_string { my $arg = shift; $arg || ($arg = $location); @@ -2675,7 +2789,7 @@ Index: texmf/scripts/texlive/tlmgrgui.pl + my @tags = sort keys %repos; + my @vals; + if ($#tags > 0) { -+ @vals = sort map { "$_:$repos{$_}" } @tags; ++ @vals = map { "$_:$repos{$_}" } sort sort_main_first @tags; + } else { + @vals = ( $arg ); + } -- cgit v1.2.3