diff options
author | Norbert Preining <preining@logic.at> | 2011-04-27 16:01:23 +0000 |
---|---|---|
committer | Norbert Preining <preining@logic.at> | 2011-04-27 16:01:23 +0000 |
commit | e6fdf875e91bf1013e861b2ef46db6b43dda1a61 (patch) | |
tree | b311ece82cb3182efd6b434f88ef8f672145a6fd /Master/tlpkg/dev | |
parent | 73cbc642103524865daca10dcc65aa47907dc8dd (diff) |
add various new dev patches
git-svn-id: svn://tug.org/texlive/trunk@22220 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/dev')
4 files changed, 2462 insertions, 0 deletions
diff --git a/Master/tlpkg/dev/dev.merge-tlmedia-into-tlpdb-and-get-rid-of-it.README b/Master/tlpkg/dev/dev.merge-tlmedia-into-tlpdb-and-get-rid-of-it.README new file mode 100644 index 00000000000..5392fb9ce9d --- /dev/null +++ b/Master/tlpkg/dev/dev.merge-tlmedia-into-tlpdb-and-get-rid-of-it.README @@ -0,0 +1,20 @@ +merge-tlmedia-into-tlpdb-and-get-rid-of-it + +purpose of this patch is to get rid of TLMedia again, as it was an +interesting idea but created only much pain due to duplications +of variables, as we always had to use the tlpdb also directly. + +This patch moves the two genuine functions from TLMedia + install_package + remove_package +and related/needed functions into TLPDB. + +In this course also the naming of the various variables has changed, now +there is only + remotetlpdb + subsuming the former tlmediatlpdb, tlmediasrc + localtlpdb + subsuming the former localtlmedia, localtlpdb + + + diff --git a/Master/tlpkg/dev/dev.merge-tlmedia-into-tlpdb-and-get-rid-of-it.patch b/Master/tlpkg/dev/dev.merge-tlmedia-into-tlpdb-and-get-rid-of-it.patch new file mode 100644 index 00000000000..ad89630bbed --- /dev/null +++ b/Master/tlpkg/dev/dev.merge-tlmedia-into-tlpdb-and-get-rid-of-it.patch @@ -0,0 +1,1516 @@ +Index: tlpkg/TeXLive/TLPDB.pm +=================================================================== +--- tlpkg/TeXLive/TLPDB.pm (revision 22215) ++++ tlpkg/TeXLive/TLPDB.pm (working copy) +@@ -36,11 +36,12 @@ + $tlpdb->writeout; + $tlpdb->writeout(FILEHANDLE); + $tlpdb->save; ++ $tlpdb->media; + $tlpdb->available_architectures(); + $tlpdb->add_tlpcontainer($pkg, $ziploc [, $archrefs [, $dest ]] ); + $tlpdb->add_tlpobj($tlpobj); + $tlpdb->needed_by($pkg); +- $tlpdb->remove_package($pkg); ++ $tlpdb->remove_tlpobj($pkg); + $tlpdb->get_package("packagename"); + $tlpdb->list_packages; + $tlpdb->expand_dependencies(["-only-arch",] $totlpdb, @list); +@@ -55,6 +56,7 @@ + $tlpdb->language_lua_lines; + $tlpdb->package_revision("packagename"); + $tlpdb->location; ++ $tlpdb->platform; + $tlpdb->config_src_container; + $tlpdb->config_doc_container; + $tlpdb->config_container_format; +@@ -68,7 +70,10 @@ + $tlpdb->settings; + $tlpdb->setting($key, [$value]); + $tlpdb->sizes_of_packages($opt_src, $opt_doc [, @packs ]); ++ $tlpdb->install_package($pkg, $dest_tlpdb, $nopostinstall, $fallbacktlpdb); ++ $tlpdb->remove_package($pkg, %options); + ++ + TeXLive::TLPDB->listdir([$dir]); + $tlpdb->generate_listfiles([$destdir]); + +@@ -79,8 +84,8 @@ + use TeXLive::TLConfig qw($CategoriesRegexp $DefaultCategory $InfraLocation + $DatabaseName $MetaCategoriesRegexp $Archive + %TLPDBOptions %TLPDBSettings); +-use TeXLive::TLUtils qw(dirname mkdirhier member win32 info debug ddebug +- tlwarn); ++use TeXLive::TLUtils qw(dirname mkdirhier member win32 info log debug ddebug ++ tlwarn basename download_file merge_into); + use TeXLive::TLPOBJ; + + use Cwd 'abs_path'; +@@ -116,6 +121,15 @@ + }; + $_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"); ++ if ($nr_packages_read == 0) { ++ # that is bad, we didn't read anything, so return undef. ++ return undef; ++ } ++ return $self; ++ } + if (defined($self->{'root'})) { + my $nr_packages_read + = $self->from_file("$self->{'root'}/$InfraLocation/$DatabaseName"); +@@ -185,14 +199,14 @@ + + =pod + +-=item C<< $tlpdb->remove_package($pkg) >> ++=item C<< $tlpdb->remove_tlpobj($pkg) >> + + Remove the package named C<$pkg> from the tlpdb. Gives a warning if the + package is not present + + =cut + +-sub remove_package { ++sub remove_tlpobj { + my ($self,$pkg) = @_; + if (defined($self->{'tlps'}{$pkg})) { + delete $self->{'tlps'}{$pkg}; +@@ -228,6 +242,27 @@ + } + my $retfh; + my $tlpdbfile; ++ # do media detection ++ my $rootpath = $self->root; ++ if ($rootpath =~ m,http://|ftp://,) { ++ $media = 'NET'; ++ } else { ++ if ($rootpath =~ m,file://*(.*)$,) { ++ $rootpath = "/$1"; ++ } ++ if (-d "$rootpath/texmf/web2c") { ++ $media = 'local_uncompressed'; ++ } elsif (-d "$rootpath/$Archive") { ++ $media = 'local_compressed'; ++ } else { ++ # we cannot find the right type, return undefined, that should ++ # make people notice ++ return 0; ++ } ++ } ++ $self->{'media'} = $media; ++ # ++ # actually load the TLPDB + if ($path =~ m;^((http|ftp)://|file:\/\/*);) { + debug("TLPDB.pm: trying to initialize from $path\n"); + # if we have xzdec available we try the xz file +@@ -349,6 +384,19 @@ + + =pod + ++=item C<< $tlpdb->media >> ++ ++Returns the media code the respective installation resides on. ++ ++=cut ++ ++sub media { ++ my $self = shift ; ++ return $self->{'media'}; ++} ++ ++=pod ++ + =item C<< $tlpdb->available_architectures >> + + The C<available_architectures> functions returns the list of available +@@ -640,10 +688,11 @@ + + sub package_revision { + my ($self,$pkg) = @_; +- if (defined($self->{'tlps'}{$pkg})) { +- return($self->{'tlps'}{$pkg}->revision); ++ my $tlp = $self->get_package($pkg); ++ if (defined($tlp)) { ++ return $tlp->revision; + } else { +- return(undef); ++ return; + } + } + +@@ -661,9 +710,9 @@ + sub generate_packagelist { + my $self = shift; + my $fd = (@_ ? $_[0] : STDOUT); +- foreach (sort keys %{$self->{'tlps'}}) { +- print $fd $self->{'tlps'}{$_}->name, " ", +- $self->{'tlps'}{$_}->revision, "\n"; ++ foreach (sort $self->list_packages) { ++ print $fd $self->get_package($_)->name, " ", ++ $self->get_package($_)->revision, "\n"; + } + foreach ($self->available_architectures) { + print $fd "$_ -1\n"; +@@ -686,8 +735,8 @@ + if (not(defined($destdir))) { + $destdir = TeXLive::TLPDB->listdir; + } +- foreach (sort keys %{$self->{'tlps'}}) { +- $tlp = $self->{'tlps'}{$_}; ++ foreach (sort $self->list_package) { ++ $tlp = $self->get_package($_); + $self->_generate_listfile($tlp, $destdir); + } + } +@@ -833,6 +882,27 @@ + + =pod + ++=item C<< $tlpdb->platform >> ++ ++returns the platform of this installation. ++ ++=cut ++ ++# deduce the platform of the referenced media as follows: ++# - if the $tlpdb->setting("platform") is there it overrides the detected ++# setting ++# - if it is not there call TLUtils::platform() ++sub platform { ++ # try to deduce the platform ++ my $self = shift; ++ my $ret = $self->setting("platform"); ++ return $ret if defined $ret; ++ # the platform setting wasn't found in the tlpdb, try TLUtils::platform ++ return TeXLive::TLUtils::platform(); ++} ++ ++=pod ++ + =item C<< $tlpdb->listdir >> + + The function C<listdir> allows to read and set the packages variable +@@ -986,21 +1056,7 @@ + sub sizes_of_packages { + my ($self, $opt_src, $opt_doc, @packs) = @_; + @packs || ( @packs = $self->list_packages() ); +- my $root = $self->root; +- my $media; +- if ($root =~ m!^(ctan$|(http|ftp)://)!i) { +- $media = 'NET'; +- } else { +- $root =~ s!file://*!/!i; +- $root = abs_path($root); +- if (-d "$root/$Archive") { +- $media = 'local_compressed'; +- } elsif (-d "$root/texmf/web2c") { +- $media = 'local_uncompressed'; +- } else { +- die "$0: that should not happen, no proper location found!"; +- } +- } ++ my $media = $self->media; + my %tlpsizes; + my %tlpobjs; + my $totalsize; +@@ -1010,23 +1066,7 @@ + warn "STRANGE: $p not to be found in ", $self->root; + next; + } +- if ($media ne 'local_uncompressed') { +- # we use the container size as the measuring unit since probably +- # downloading will be the limiting factor +- $tlpsizes{$p} = $tlpobjs{$p}->containersize; +- $tlpsizes{$p} += $tlpobjs{$p}->srccontainersize if $opt_src; +- $tlpsizes{$p} += $tlpobjs{$p}->doccontainersize if $opt_doc; +- } else { +- # we have to add the respective sizes, that is checking for +- # installation of src and doc file +- $tlpsizes{$p} = $tlpobjs{$p}->runsize; +- $tlpsizes{$p} += $tlpobjs{$p}->srcsize if $opt_src; +- $tlpsizes{$p} += $tlpobjs{$p}->docsize if $opt_doc; +- my %foo = %{$tlpobjs{$p}->binsize}; +- for my $k (keys %foo) { $tlpsizes{$p} += $foo{$k}; } +- # all the packages sizes are in blocks, so transfer that to bytes +- $tlpsizes{$p} *= $TeXLive::TLConfig::BlockSize; +- } ++ $tlpsizes{$p} = $self->size_of_one_package($media, $tlpobjs{$p}, $opt_src, $opt_doc); + $totalsize += $tlpsizes{$p}; + } + if ($totalsize) { +@@ -1035,11 +1075,461 @@ + return \%tlpsizes; + } + ++sub size_of_one_package { ++ my ($self, $media, $tlpobj, $opt_src, $opt_doc) = @_; ++ my $size = 0; ++ if ($media ne 'local_uncompressed') { ++ # we use the container size as the measuring unit since probably ++ # downloading will be the limiting factor ++ $size = $tlpobj->containersize; ++ $size += $tlpobj->srccontainersize if $opt_src; ++ $size += $tlpobj->doccontainersize if $opt_doc; ++ } else { ++ # we have to add the respective sizes, that is checking for ++ # installation of src and doc file ++ $size = $tlpobj->runsize; ++ $size += $tlpobj->srcsize if $opt_src; ++ $size += $tlpobj->docsize if $opt_doc; ++ my %foo = %{$tlpobj->binsize}; ++ for my $k (keys %foo) { $size += $foo{$k}; } ++ # all the packages sizes are in blocks, so transfer that to bytes ++ $size *= $TeXLive::TLConfig::BlockSize; ++ } ++ return $size; ++} + ++=pod + ++=item C<< $tlpdb->install_package($pkg, $dest_tlpdb, $nopostinstall, $fallbacktlpdb) >> + ++Installs the package $pkg into $dest_tlpdb. ++ ++=cut ++ ++sub install_package { ++ my ($self, $pkg, $totlpdb, $nopostinstall, $fallbackmedia) = @_; ++ 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; ++ } ++ } else { ++ my $container_src_split = $fromtlpdb->config_src_container; ++ my $container_doc_split = $fromtlpdb->config_doc_container; ++ # get options about src/doc splitting from $totlpdb ++ my $opt_src = $totlpdb->option("install_srcfiles"); ++ my $opt_doc = $totlpdb->option("install_docfiles"); ++ my $real_opt_doc = $opt_doc; ++ my $reloc = 1 if $tlpobj->relocated; ++ my $container; ++ my @installfiles; ++ my $root = $self->root; ++ print "LOCATION = $root\n"; ++ # make sure that there is no terminal / in $root, otherwise we ++ # will get double // somewhere ++ $root =~ s!/$!!; ++ foreach ($tlpobj->runfiles) { ++ # s!^!$root/!; ++ push @installfiles, $_; ++ } ++ foreach ($tlpobj->allbinfiles) { ++ # s!^!$root/!; ++ push @installfiles, $_; ++ } ++ if ($opt_src) { ++ foreach ($tlpobj->srcfiles) { ++ # s!^!$root/!; ++ push @installfiles, $_; ++ } ++ } ++ if ($real_opt_doc) { ++ foreach ($tlpobj->docfiles) { ++ # s!^!$root/!; ++ push @installfiles, $_; ++ } ++ } ++ my $media = $self->media; ++ if ($media eq 'local_uncompressed') { ++ $container = \@installfiles; ++ } elsif ($media eq 'local_compressed') { ++ if (-r "$root/$Archive/$pkg.zip") { ++ $container = "$root/$Archive/$pkg.zip"; ++ } elsif (-r "$root/$Archive/$pkg.tar.xz") { ++ $container = "$root/$Archive/$pkg.tar.xz"; ++ } else { ++ tlwarn("Cannot find a package $pkg (.zip or .xz) in $root/$Archive\n"); ++ next; ++ } ++ } elsif (&media eq 'NET') { ++ $container = "$root/$Archive/$pkg.$DefaultContainerExtension"; ++ } ++ $self->_install_package ($container, $reloc, \@installfiles, $totlpdb) ++ || return(0); ++ # if we are installing from local_compressed or NET we have to fetch the respective ++ # source and doc packages $pkg.source and $pkg.doc and install them, too ++ if (($media eq 'NET') || ($media eq 'local_compressed')) { ++ # we install split containers under the following conditions: ++ # - the container were split generated ++ # - src/doc files should be installed ++ # (- the package is not already a split one (like .i386-linux)) ++ # the above test has been removed because it would mean that ++ # texlive.infra.doc.tar.xz ++ # will never be installed, and we do already check that there ++ # are at all src/doc files, which in split packages of the form ++ # foo.ARCH are not present. And if they are present, than that is fine, ++ # too (bin-foobar.win32.doc.tar.xz) ++ # - there are actually src/doc files present ++ if ($container_src_split && $opt_src && $tlpobj->srcfiles) { ++ my $srccontainer = $container; ++ $srccontainer =~ s/(\.tar\.xz|\.zip)$/.source$1/; ++ $self->_install_package ($srccontainer, $reloc, \@installfiles, $totlpdb) ++ || return(0); ++ } ++ if ($container_doc_split && $real_opt_doc && $tlpobj->docfiles) { ++ my $doccontainer = $container; ++ $doccontainer =~ s/(\.tar\.xz|\.zip)$/.doc$1/; ++ $self->_install_package ($doccontainer, $reloc, \@installfiles, $totlpdb) ++ || return(0); ++ } ++ # ++ # if we installed from NET/local_compressed and we got a relocatable container ++ # make sure that the stray texmf-dist/tlpkg directory is removed ++ # in USER MODE that should NOT be done because we keep the information ++ # there, but for now do it unconditionally ++ if ($tlpobj->relocated) { ++ my $reloctree = $totlpdb->root . "/" . $TeXLive::TLConfig::RelocTree; ++ my $tlpkgdir = $reloctree . "/" . $TeXLive::TLConfig::InfraLocation; ++ my $tlpod = $tlpkgdir . "/tlpobj"; ++ TeXLive::TLUtils::rmtree($tlpod) if (-d $tlpod); ++ # we try to remove the tlpkg directory, that will succeed only ++ # if it is empty. So in normal installations it won't be, but ++ # if we are installing a relocated package it is texmf-dist/tlpkg ++ # which will be (hopefully) empty ++ rmdir($tlpkgdir) if (-d "$tlpkgdir"); ++ } ++ } ++ # we don't want to have wrong information in the tlpdb, so remove the ++ # src/doc files if they are not installed ... ++ if (!$opt_src) { ++ $tlpobj->clear_srcfiles; ++ } ++ if (!$real_opt_doc) { ++ $tlpobj->clear_docfiles; ++ } ++ # if a package is relocatable we have to cancel the reloc prefix ++ # and unset the relocated setting ++ # before we save it to the local tlpdb ++ if ($tlpobj->relocated) { ++ $tlpobj->cancel_reloc_prefix; ++ $tlpobj->relocated(0); ++ } ++ # we have to write out the tlpobj file since it is contained in the ++ # archives (.tar.xz) but at DVD install time we don't have them ++ my $tlpod = $totlpdb->root . "/tlpkg/tlpobj"; ++ mkdirhier( $tlpod ); ++ open(TMP,">$tlpod/".$tlpobj->name.".tlpobj") or ++ die("Cannot open tlpobj file for ".$tlpobj->name); ++ $tlpobj->writeout(\*TMP); ++ close(TMP); ++ $totlpdb->add_tlpobj($tlpobj); ++ $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")); ++ } ++ } ++ return 1; ++} ++ ++# ++# _install_package ++# actually does the installation work ++# returns 1 on success and 0 on error ++# ++sub _install_package { ++ my ($self, $what, $reloc, $filelistref, $totlpdb) = @_; ++ ++ my $media = $self->media; ++ my $target = $totlpdb->root; ++ my $tempdir = "$target/temp"; ++ ++ my @filelist = @$filelistref; ++ ++ # we assume that $::progs has been set up! ++ my $wget = $::progs{'wget'}; ++ my $xzdec = $::progs{'xzdec'}; ++ if (!defined($wget) || !defined($xzdec)) { ++ tlwarn("_install_package: programs not set up properly, strange.\n"); ++ return(0); ++ } ++ ++ if (ref $what) { ++ # we are getting a ref to a list of files, so install from DVD ++ my $root = $self->root; ++ foreach my $file (@$what) { ++ # @what is taken, not @filelist! ++ # is this still needed? ++ my $dn=dirname($file); ++ mkdirhier("$target/$dn"); ++ TeXLive::TLUtils::copy "$root/$file", "$target/$dn"; ++ } ++ # we always assume that copy will work ++ return(1); ++ } elsif ($what =~ m,\.tar(\.xz)?$,) { ++ my $type = defined($1) ? "xz" : "tar"; ++ ++ $target .= "/$TeXLive::TLConfig::RelocTree" if $reloc; ++ ++ # this is the case when we install from local_compressed or the NET, or a backup ++ # ++ # in all other cases we create temp files .tar.xz (or use the present ++ # one), xzdec them, and then call tar ++ ++ my $fn = basename($what); ++ my $pkg = $fn; ++ $pkg =~ s/\.tar(\.xz)?$//; ++ mkdirhier("$tempdir"); ++ my $tarfile; ++ my $remove_tarfile = 1; ++ if ($type eq "xz") { ++ my $xzfile = "$tempdir/$fn"; ++ $tarfile = "$tempdir/$fn"; $tarfile =~ s/\.xz$//; ++ my $xzfile_quote = $xzfile; ++ my $tarfile_quote = $tarfile; ++ my $target_quote = $target; ++ if (win32()) { ++ $xzfile =~ s!/!\\!g; ++ $xzfile_quote = "\"$xzfile\""; ++ $tarfile =~ s!/!\\!g; ++ $tarfile_quote = "\"$tarfile\""; ++ $target =~ s!/!\\!g; ++ $target_quote = "\"$target\""; ++ } ++ if ($what =~ m,http://|ftp://,) { ++ # we are installing from the NET ++ # download the file and put it into temp ++ if (!download_file($what, $xzfile) || (! -r $xzfile)) { ++ tlwarn("Downloading \n"); ++ tlwarn(" $what\n"); ++ tlwarn("did not succeed, please retry.\n"); ++ unlink($tarfile, $xzfile); ++ return(0); ++ } ++ } else { ++ # we are installing from local compressed files ++ # copy it to temp ++ TeXLive::TLUtils::copy($what, $tempdir); ++ } ++ debug("un-xzing $xzfile to $tarfile\n"); ++ system("$xzdec < $xzfile_quote > $tarfile_quote"); ++ if (! -f $tarfile) { ++ tlwarn("_install_package: Unpacking $xzfile failed, please retry.\n"); ++ unlink($tarfile, $xzfile); ++ return(0); ++ } ++ unlink($xzfile); ++ } else { ++ $tarfile = "$tempdir/$fn"; ++ if ($what =~ m,http://|ftp://,) { ++ if (!download_file($what, $tarfile) || (! -r $tarfile)) { ++ tlwarn("Downloading \n"); ++ tlwarn(" $what\n"); ++ tlwarn("failed, please retry.\n"); ++ unlink($tarfile); ++ return(0); ++ } ++ } else { ++ $tarfile = $what; ++ $remove_tarfile = 0; ++ } ++ } ++ my $ret = TeXLive::TLUtils::untar($tarfile, $target, $remove_tarfile); ++ # remove the $pkg.tlpobj, we recreate it anyway again ++ unlink ("$target/tlpkg/tlpobj/$pkg.tlpobj") ++ if (-r "$target/tlpkg/tlpobj/$pkg.tlpobj"); ++ return $ret; ++ } else { ++ tlwarn("_install_package: Don't know how to install $what\n"); ++ return(0); ++ } ++} ++ + =pod + ++=item << $tlpdb->remove_package($pkg, %options) >> ++ ++removes a single pacakge with all the files and the entry in the db. ++ ++=cut ++ ++# ++# remove_package removes a single package with all files (including the ++# # tlpobj files) and the entry from the tlpdb. ++sub remove_package { ++ my ($self, $pkg, %opts) = @_; ++ my $localtlpdb = $self; ++ my $tlp = $localtlpdb->get_package($pkg); ++ if (!defined($tlp)) { ++ tlwarn ("$pkg: package not present, cannot remove\n"); ++ } else { ++ my $currentarch = $self->platform(); ++ if ($pkg eq "texlive.infra" || $pkg eq "texlive.infra.$currentarch") { ++ log ("Not removing $pkg, it is essential!\n"); ++ return 0; ++ } ++ # we have to chdir to $localtlpdb->root ++ my $Master = $localtlpdb->root; ++ chdir ($Master) || die "chdir($Master) failed: $!"; ++ my @files = $tlp->all_files; ++ # also remove the .tlpobj file ++ push @files, "tlpkg/tlpobj/$pkg.tlpobj"; ++ # and the ones from src/doc splitting ++ if (-r "tlpkg/tlpobj/$pkg.source.tlpobj") { ++ push @files, "tlpkg/tlpobj/$pkg.source.tlpobj"; ++ } ++ if (-r "tlpkg/tlpobj/$pkg.doc.tlpobj") { ++ push @files, "tlpkg/tlpobj/$pkg.doc.tlpobj"; ++ } ++ # ++ # some packages might be relocated, thus having the RELOC prefix ++ # in user mode we just remove the prefix, in normal mode we ++ # replace it with texmf-dist ++ # since we don't have user mode ++ if ($tlp->relocated) { ++ for (@files) { ++ s:^$RelocPrefix/:$RelocTree/:; ++ } ++ } ++ # ++ # we want to check that a file is only listed in one package, so ++ # in case that a file to be removed is listed in another package ++ # we will warn and *not* remove it ++ my %allfiles; ++ for my $p ($localtlpdb->list_packages) { ++ next if ($p eq $pkg); # we have to skip the to be removed package ++ for my $f ($localtlpdb->get_package($p)->all_files) { ++ $allfiles{$f} = $p; ++ } ++ } ++ my @goodfiles = (); ++ my @badfiles = (); ++ my @debugfiles = (); ++ for my $f (@files) { ++ # in usermode we have to add texmf-dist again for comparison ++ if (defined($allfiles{$f})) { ++ # this file should be removed but is mentioned somewhere, too ++ # take into account if we got a warn list ++ if (defined($opts{'remove-warn-files'})) { ++ my %a = %{$opts{'remove-warn-files'}}; ++ if (defined($a{$f})) { ++ push @badfiles, $f; ++ } else { ++ # NO NOTHING HERE!!! ++ # DON'T PUSH IT ON @goodfiles, it will be removed, which we do ++ # NOT want. We only want to supress the warning! ++ push @debugfiles, $f; ++ } ++ } else { ++ push @badfiles, $f; ++ } ++ } else { ++ push @goodfiles, $f; ++ } ++ } ++ if ($#debugfiles >= 0) { ++ debug("The following files will not be removed due to the removal of $pkg.\n"); ++ debug("But we do not warn on it because they are moved to other packages.\n"); ++ for my $f (@debugfiles) { ++ debug(" $f - $allfiles{$f}\n"); ++ } ++ } ++ if ($#badfiles >= 0) { ++ # warn the user ++ tlwarn("The following files should be removed due to the removal of $pkg,\n"); ++ tlwarn("but are part of another package, too.\n"); ++ for my $f (@badfiles) { ++ tlwarn(" $f - $allfiles{$f}\n"); ++ } ++ } ++ # ++ # Run only the postaction code thing now since afterwards the ++ # files will be gone ... ++ if (defined($opts{'nopostinstall'}) && $opts{'nopostinstall'}) { ++ &TeXLive::TLUtils::do_postaction("remove", $tlp, ++ 0, # option_file_assocs, ++ 0, # option_desktop_integration, menu part ++ 0, # option_desktop_integration, desktop part ++ $localtlpdb->option("post_code")); ++ } ++ # ++ my @removals = &TeXLive::TLUtils::removed_dirs (@goodfiles); ++ # now do the removal ++ for my $entry (@goodfiles) { ++ unlink $entry; ++ } ++ for my $d (@removals) { ++ rmdir $d; ++ } ++ $localtlpdb->remove_tlpobj($pkg); ++ TeXLive::TLUtils::announce_execute_actions("disable", $tlp); ++ # should we save at each removal??? ++ # advantage: the tlpdb actually reflects what is installed ++ # disadvantage: removing a collection calls the save routine several times ++ # still I consider it better that the tlpdb is in a consistent state ++ $localtlpdb->save; ++ # ++ # 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() && !$localtlpdb->option("w32_multi_user")) { ++ non_admin(); ++ } ++ # ++ # Run the post installation code in the postaction tlpsrc entries ++ # 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) { ++ &TeXLive::TLUtils::do_postaction("remove", $tlp, ++ $localtlpdb->option("file_assocs"), ++ $localtlpdb->option("desktop_integration"), ++ $localtlpdb->option("desktop_integration"), ++ 0); ++ } ++ } ++ return 1; ++} ++ ++ ++=pod ++ + =item C<< $tlpdb->option($key [, $val]) >> + =item C<< $tlpdb->setting($key [, $val]) >> + +@@ -1080,7 +1570,7 @@ + } + } + $pkg->depends(@newdeps); +- $self->{'tlps'}{$pkgname} = $pkg; ++ $self->add_tlpobj($pkg); + } + + sub _option_value { +Index: texmf/scripts/texlive/tlmgr.pl +=================================================================== +--- texmf/scripts/texlive/tlmgr.pl (revision 22215) ++++ texmf/scripts/texlive/tlmgr.pl (working copy) +@@ -77,7 +77,6 @@ + use strict; + + use TeXLive::TLConfig; +-use TeXLive::TLMedia; + use TeXLive::TLPDB; + use TeXLive::TLPOBJ; + use TeXLive::TLUtils; +@@ -92,10 +91,8 @@ + binmode(STDERR, ":utf8"); + + our %config; # hash of config settings from config file +-our $tlmediasrc; # media from which we install/update +-our $tlmediatlpdb; ++our $remotetlpdb; + our $location; # location from which the new packages come +-our $localtlmedia; # local installation which we are munging + our $localtlpdb; # local installation which we are munging + + # flags for machine-readable form +@@ -412,7 +409,6 @@ + $::version_string .= "\nTLUtils: " . TeXLive::TLUtils->module_revision(); + $::version_string .= "\nTLPOBJ: " . TeXLive::TLPOBJ->module_revision(); + $::version_string .= "\nTLPDB: " . TeXLive::TLPDB->module_revision(); +- $::version_string .= "\nTLMedia: " . TeXLive::TLMedia->module_revision(); + $::version_string .= "\nTLPaper: " . TeXLive::TLPaper->module_revision(); + $::version_string .= "\nTLWinGoo: " . TeXLive::TLWinGoo->module_revision(); + $::version_string .= "\n"; +@@ -830,7 +826,7 @@ + my $foo = 0; + info ("remove $pkg\n"); + if (!$opts{"dry-run"}) { +- $foo = $localtlmedia->remove_package($pkg); ++ $foo = $localtlpdb->remove_package($pkg); + logpackage("remove: $pkg"); + } + if ($foo) { +@@ -851,7 +847,7 @@ + if (!defined($already_removed{$pkg})) { + info ("remove $pkg\n"); + if (!$opts{"dry-run"}) { +- if ($localtlmedia->remove_package($pkg)) { ++ if ($localtlpdb->remove_package($pkg)) { + # removal was successful + logpackage("remove: $pkg"); + $already_removed{$pkg} = 1; +@@ -942,11 +938,11 @@ + my $tlp = $localtlpdb->get_package($pkg); + my $installed = 0; + if (!$tlp) { +- if (!$tlmediatlpdb) { ++ if (!$remotetlpdb) { + init_tlmedia(); + } +- $tlp = $tlmediatlpdb->get_package($pkg); +- $tlpdb = $tlmediatlpdb; ++ $tlp = $remotetlpdb->get_package($pkg); ++ $tlpdb = $remotetlpdb; + } else { + $installed = 1; + } +@@ -956,10 +952,10 @@ + @colls = $localtlpdb->needed_by($pkg); + if (!@colls) { + # not referenced in the local tlpdb, so try the remote here, too +- if (!$tlmediatlpdb) { ++ if (!$remotetlpdb) { + init_tlmedia(); + } +- @colls = $tlmediatlpdb->needed_by($pkg); ++ @colls = $remotetlpdb->needed_by($pkg); + } + } + # some packages might depend on other packages, so do not +@@ -1101,7 +1097,7 @@ + # - if non-admin + # --> ignore opt_w32_multi_user and do user path adjustment + if (!$opts{"w32mode"}) { +- $winadminmode = $localtlmedia->tlpdb->option("w32_multi_user"); ++ $winadminmode = $localtlpdb->option("w32_multi_user"); + if (!TeXLive::TLWinGoo::admin()) { + if ($winadminmode) { + tlwarn("The TLPDB specifies system wide path adjustments\nbut you don't have admin privileges.\nFor user path adjustment please use\n\t--w32mode user\n"); +@@ -1139,29 +1135,29 @@ + if ($what =~ m/^add$/i) { + if (win32()) { + TeXLive::TLUtils::w32_add_to_path( +- $localtlmedia->location . "/bin/win32", ++ $localtlpdb->root . "/bin/win32", + $winadminmode); + TeXLive::TLWinGoo::broadcast_env(); + } else { +- TeXLive::TLUtils::add_symlinks($localtlmedia->tlpdb->root, +- $localtlmedia->platform(), +- $localtlmedia->tlpdb->option("sys_bin"), +- $localtlmedia->tlpdb->option("sys_man"), +- $localtlmedia->tlpdb->option("sys_info")); ++ TeXLive::TLUtils::add_symlinks($localtlpdb->root, ++ $localtlpdb->platform(), ++ $localtlpdb->option("sys_bin"), ++ $localtlpdb->option("sys_man"), ++ $localtlpdb->option("sys_info")); + } + } elsif ($what =~ m/^remove$/i) { + if (win32()) { + TeXLive::TLUtils::w32_remove_from_path( +- $localtlmedia->location . "/bin/win32", ++ $localtlpdb->root . "/bin/win32", + $winadminmode); + TeXLive::TLWinGoo::broadcast_env(); + } else { + # remove symlinks +- TeXLive::TLUtils::remove_symlinks($localtlmedia->tlpdb->root, +- $localtlmedia->platform(), +- $localtlmedia->tlpdb->option("sys_bin"), +- $localtlmedia->tlpdb->option("sys_man"), +- $localtlmedia->tlpdb->option("sys_info")); ++ TeXLive::TLUtils::remove_symlinks($localtlpdb->root, ++ $localtlpdb->platform(), ++ $localtlpdb->option("sys_bin"), ++ $localtlpdb->option("sys_man"), ++ $localtlpdb->option("sys_info")); + } + } else { + # that should not happen +@@ -1251,7 +1247,7 @@ + init_local_db(); + if ($opts{"global"}) { + init_tlmedia(); +- $tlpdb = $tlmediasrc->tlpdb; ++ $tlpdb = $remotetlpdb; + } else { + $tlpdb = $localtlpdb; + } +@@ -1409,8 +1405,8 @@ + tlwarn("Cannot read $restore_file, no action taken\n"); + return; + } +- $localtlmedia->remove_package($pkg); +- TeXLive::TLMedia->_install_package($restore_file , 0, [] ,$localtlpdb); ++ $localtlpdb->remove_package($pkg); ++ TeXLive::TLPDB->_install_package($restore_file , 0, [] ,$localtlpdb); + logpackage("restore: $pkg ($rev)"); + # now we have to read the .tlpobj file and add it to the DB + my $tlpobj = TeXLive::TLPOBJ->new; +@@ -1713,18 +1709,17 @@ + my ($restart_tlmgr, $ref_files_to_be_removed, @w32_updated) = @_; + my @infra_files_to_be_removed = @$ref_files_to_be_removed; + # TODO do something with these files TODO +- my $media = $tlmediasrc->media; +- my $mediatlpdb = $tlmediasrc->tlpdb; ++ my $media = $remotetlpdb->media; + # we have to download/copy also the src/doc files if necessary! +- my $container_src_split = $mediatlpdb->config_src_container; +- my $container_doc_split = $mediatlpdb->config_doc_container; ++ my $container_src_split = $remotetlpdb->config_src_container; ++ my $container_doc_split = $remotetlpdb->config_doc_container; + # get options about src/doc splitting from $totlpdb + # TT: should we use local options to decide about install of doc & src? + my $opt_src = $localtlpdb->option("install_srcfiles"); + my $opt_doc = $localtlpdb->option("install_docfiles"); + my $root = $localtlpdb->root; + my $temp = "$root/temp"; +- my $repo = $mediatlpdb->root . "/$Archive"; ++ my $repo = $remotetlpdb->root . "/$Archive"; + TeXLive::TLUtils::mkdirhier($temp); + tlwarn("Backup option not implemented for infrastructure update.\n") if ($opts{"backup"}); + if ($media eq 'local_uncompressed') { +@@ -1734,7 +1729,7 @@ + } + my (@upd_tar, @upd_tlpobj, @upd_info, @rst_tar, @rst_tlpobj, @rst_info); + foreach my $pkg (@w32_updated) { +- my $mediatlp = $mediatlpdb->get_package($pkg); ++ my $mediatlp = $remotetlpdb->get_package($pkg); + my $localtlp = $localtlpdb->get_package($pkg); + my $oldrev = $localtlp->revision; + my $newrev = $mediatlp->revision; +@@ -1913,15 +1908,15 @@ + # + my @all_schmscolls = (); + for my $p ($localtlpdb->schemes) { +- push (@all_schmscolls, $p) if defined($tlmediatlpdb->get_package($p)); ++ push (@all_schmscolls, $p) if defined($remotetlpdb->get_package($p)); + } + for my $p ($localtlpdb->collections) { +- push (@all_schmscolls, $p) if defined($tlmediatlpdb->get_package($p)); ++ push (@all_schmscolls, $p) if defined($remotetlpdb->get_package($p)); + } + my @localexpansion_full = + $localtlpdb->expand_dependencies($localtlpdb, @all_schmscolls); + my @remoteexpansion_full = +- $tlmediatlpdb->expand_dependencies($localtlpdb, @all_schmscolls); ++ $remotetlpdb->expand_dependencies($localtlpdb, @all_schmscolls); + + # compute new/remove/forcerm based on the full expansions + for my $p (@remoteexpansion_full) { +@@ -1942,7 +1937,7 @@ + # intersection, don't check A\B and B\A + next if $newpkgs_full{$p}; + next if $removals_full{$p}; +- next if ($tlmediatlpdb->get_package($p)->category ne "Collection"); ++ next if ($remotetlpdb->get_package($p)->category ne "Collection"); + my $tlp = $localtlpdb->get_package($p); + if (!defined($tlp)) { + if ($opts{"reinstall-forcibly-removed"}) { +@@ -1956,7 +1951,7 @@ + # forcibly removed. Again, expand those against the remote tlpdb + # and remove the expanded packages from the list of localexpansion. + my @pkgs_from_forcerm_colls = +- $tlmediatlpdb->expand_dependencies($localtlpdb, keys %forcermpkgs_full); ++ $remotetlpdb->expand_dependencies($localtlpdb, keys %forcermpkgs_full); + # + # the package in @pkgs_from_forcerm_colls would be auto-installed, so + # check for that: +@@ -2033,7 +2028,7 @@ + # tlmgr update --no-depends-at-all foo + # will absolutely only update foo not even taking .ARCH into account + # +-# TLMedia->install_package INSTALLS ONLY ONE PACKAGE, no deps whatsoever ++# TLPDB->install_package INSTALLS ONLY ONE PACKAGE, no deps whatsoever + # anymore. That has all to be done by hand. + # + sub machine_line { +@@ -2083,7 +2078,7 @@ + + # check for updates to tlmgr and die unless either --force or --list or --self + # is given +- my @critical = check_for_critical_updates($localtlpdb, $tlmediatlpdb); ++ my @critical = check_for_critical_updates($localtlpdb, $remotetlpdb); + my $dry_run_cont = $opts{"dry-run"} && ($opts{"dry-run"} < 0); + if ( !$dry_run_cont && !$opts{"self"} && @critical) { + critical_updates_warning(); +@@ -2185,11 +2180,11 @@ + + if (!($opts{"self"} && @critical) || ($opts{"self"} && $opts{"list"})) { + # update all .ARCH dependencies, too, unless $opts{"no-depends-at-all"}: +- @todo = $tlmediatlpdb->expand_dependencies("-only-arch", $localtlpdb, @todo) ++ @todo = $remotetlpdb->expand_dependencies("-only-arch", $localtlpdb, @todo) + unless $opts{"no-depends-at-all"}; + # + # update general deps unless $opts{"no-depends"}: +- @todo = $tlmediatlpdb->expand_dependencies("-no-collections",$localtlpdb,@todo) ++ @todo = $remotetlpdb->expand_dependencies("-no-collections",$localtlpdb,@todo) + unless $opts{"no-depends"}; + # + # filter out critical packages +@@ -2298,7 +2293,7 @@ + next; + } + # install new packages +- my $mediatlp = $tlmediatlpdb->get_package($pkg); ++ my $mediatlp = $remotetlpdb->get_package($pkg); + if (!defined($mediatlp)) { + tlwarn("\nShould not happen: $pkg not found in $location"); + next; +@@ -2308,7 +2303,7 @@ + next; + } + my $rev = $tlp->revision; +- my $mediatlp = $tlmediatlpdb->get_package($pkg); ++ my $mediatlp = $remotetlpdb->get_package($pkg); + if (!defined($mediatlp)) { + debug("$pkg cannot be found in $location\n"); + next; +@@ -2360,7 +2355,7 @@ + # get something wrong back, namely the total size of all packages + my %sizes; + if (@alltodo) { +- %sizes = %{$tlmediatlpdb->sizes_of_packages( ++ %sizes = %{$remotetlpdb->sizes_of_packages( + $localtlpdb->option("install_srcfiles"), + $localtlpdb->option("install_docfiles"), @alltodo)}; + } else { +@@ -2394,7 +2389,7 @@ + } + } + for my $p (@updated, @new) { +- my $pkg = $tlmediatlpdb->get_package($p); ++ my $pkg = $remotetlpdb->get_package($p); + tlwarn("Should not happen: $p not found in $location\n") if (!$pkg); + next; + for my $f ($pkg->all_files) { +@@ -2438,7 +2433,7 @@ + info("not removing $p due to -no-auto-remove (removed on server)\n"); + } else { + &ddebug("removing package $p\n"); +- my $pkg = $localtlmedia->tlpdb->get_package($p); ++ my $pkg = $localtlpdb->get_package($p); + if (! $pkg) { + # This happened when a collection was removed by the user, + # and then renamed on the server, e.g., collection-langarab -> +@@ -2476,7 +2471,7 @@ + clear_old_backups($p, $opts{"backupdir"}, $autobackup); + } + } +- $localtlmedia->remove_package($p); ++ $localtlpdb->remove_package($p); + logpackage("remove: $p"); + } + $currnr++; +@@ -2572,7 +2567,7 @@ + my $unwind_package; + my $remove_unwind_container = 0; + my $rev = $tlp->revision; +- my $mediatlp = $tlmediatlpdb->get_package($pkg); ++ my $mediatlp = $remotetlpdb->get_package($pkg); + if (!defined($mediatlp)) { + debug("$pkg cannot be found in $location\n"); + next; +@@ -2666,10 +2661,10 @@ + if ($pkg =~ m/$CriticalPackagesRegexp/) { + debug("Not removing critical package $pkg\n"); + } else { +- $localtlmedia->remove_package($pkg, ++ $localtlpdb->remove_package($pkg, + "remove-warn-files" => \%do_warn_on_move); + } +- if ($tlmediasrc->install_package($pkg, $localtlpdb)) { ++ if ($remotetlpdb->install_package($pkg, $localtlpdb)) { + # installation succeeded because we got a reference + logpackage("update: $pkg ($rev -> $mediarev)"); + unlink($unwind_package) if $remove_unwind_container; +@@ -2713,8 +2708,8 @@ + $remove_unwind_container = 1; + $unwind_package = $newname; + } +- my $instret = TeXLive::TLMedia->_install_package("$unwind_package", 0, +- [], $localtlpdb); ++ my $instret = TeXLive::TLPDB->_install_package("$unwind_package", 0, ++ [], $localtlpdb); + if ($instret) { + # now we have to include the tlpobj + my $tlpobj = TeXLive::TLPOBJ->new; +@@ -2740,7 +2735,7 @@ + unless $::machinereadable; + } else { + # install new packages +- my $mediatlp = $tlmediatlpdb->get_package($pkg); ++ my $mediatlp = $remotetlpdb->get_package($pkg); + if (!defined($mediatlp)) { + tlwarn("\nShould not happen: $pkg not found in $location"); + next; +@@ -2768,7 +2763,7 @@ + $currnr++; + $donesize += $sizes{$pkg}; + next if ($opts{"dry-run"} || $opts{"list"}); +- if ($tlmediasrc->install_package($pkg, $localtlpdb)) { ++ if ($remotetlpdb->install_package($pkg, $localtlpdb)) { + # installation succeeded because we got a reference + logpackage("auto-install new: $pkg ($mediarev)"); + $nrupdated++; +@@ -2797,11 +2792,11 @@ + my $newtlp; + if ($updated{$pkg}) { + $oldtlp = $localtlpdb->get_package($pkg); +- $newtlp = $tlmediatlpdb->get_package($pkg); ++ $newtlp = $remotetlpdb->get_package($pkg); + } else { + # update failed but we could introduce new files, that + # should be removed now as a part of restoring backup +- $oldtlp = $tlmediatlpdb->get_package($pkg); ++ $oldtlp = $remotetlpdb->get_package($pkg); + $newtlp = $localtlpdb->get_package($pkg); + } + die ("That shouldn't happen: $pkg not found in tlpdb") if !defined($newtlp); +@@ -2897,8 +2892,8 @@ + if ($opts{"dry-run"} && !$opts{"list"} && $restart_tlmgr) { + $opts{"self"} = 0; + $opts{"dry-run"} = -1; +- $localtlmedia = undef; +- $tlmediatlpdb = undef; ++ $localtlpdb = undef; ++ $remotetlpdb = undef; + info ("Restarting tlmgr to complete update ...\n"); + action_update(); + return; +@@ -2908,7 +2903,7 @@ + # warn if nothing is updated. + if (!(@new || @updated)) { + info("tlmgr: no updates available\n"); +- if ($tlmediasrc->media ne "NET" ++ if ($remotetlpdb->media ne "NET" + && !$opts{"dry-run"} + && !$opts{"repository"} + ) { +@@ -2948,18 +2943,18 @@ + # . it does not care for whether a package seems to be installed or + # not (that is the --reinstall) + # +-# TLMedia->install_package does ONLY INSTALL ONE PACKAGE, no deps whatsoever ++# TLPDB->install_package does ONLY INSTALL ONE PACKAGE, no deps whatsoever + # anymore! That has all to be done by hand. + # + sub action_install { + init_local_db(1); + return if !check_on_writable(); +- # initialize the TLMedia from $location ++ # initialize the TLPDB from $location + $opts{"no-depends"} = 1 if $opts{"no-depends-at-all"}; + init_tlmedia(); + + # check for updates to tlmgr itself, and die unless --force is given +- if (check_for_critical_updates( $localtlpdb, $tlmediatlpdb)) { ++ if (check_for_critical_updates( $localtlpdb, $remotetlpdb)) { + critical_updates_warning(); + if ($opts{"force"}) { + tlwarn("Continuing due to --force\n"); +@@ -2978,13 +2973,13 @@ + + my @packs = @ARGV; + # first expand the .ARCH dependencies unless $opts{"no-depends-at-all"} +- @packs = $tlmediatlpdb->expand_dependencies("-only-arch", $localtlpdb, @ARGV) unless $opts{"no-depends-at-all"}; ++ @packs = $remotetlpdb->expand_dependencies("-only-arch", $localtlpdb, @ARGV) unless $opts{"no-depends-at-all"}; + # now expand all others unless $opts{"no-depends"} + # if $opts{"reinstall"} do not collection->collection dependencies + if ($opts{"reinstall"}) { +- @packs = $tlmediatlpdb->expand_dependencies("-no-collections", $localtlpdb, @packs) unless $opts{"no-depends"}; ++ @packs = $remotetlpdb->expand_dependencies("-no-collections", $localtlpdb, @packs) unless $opts{"no-depends"}; + } else { +- @packs = $tlmediatlpdb->expand_dependencies($localtlpdb, @packs) unless $opts{"no-depends"}; ++ @packs = $remotetlpdb->expand_dependencies($localtlpdb, @packs) unless $opts{"no-depends"}; + } + # + # installation order of packages: +@@ -3013,7 +3008,7 @@ + my @todo; + for my $pkg (@inst_packs, @inst_colls, @inst_schemes) { + my $pkgrev = 0; +- my $mediatlp = $tlmediatlpdb->get_package($pkg); ++ my $mediatlp = $remotetlpdb->get_package($pkg); + if (!defined($mediatlp)) { + tlwarn("package $pkg not present in package repository.\n"); + next; +@@ -3036,7 +3031,7 @@ + return if (!@todo); + + my $currnr = 1; +- my %sizes = %{$tlmediatlpdb->sizes_of_packages( ++ my %sizes = %{$remotetlpdb->sizes_of_packages( + $localtlpdb->option("install_srcfiles"), + $localtlpdb->option("install_docfiles"), @todo)}; + defined($sizes{'__TOTAL__'}) || ($sizes{'__TOTAL__'} = 0); +@@ -3067,7 +3062,7 @@ + info("[$currnr/$totalnr, $estrem/$esttot] ${re}install: $pkg [${kb}k]\n"); + } + if (!$opts{"dry-run"}) { +- $tlmediasrc->install_package($pkg, $localtlpdb); ++ $remotetlpdb->install_package($pkg, $localtlpdb); + logpackage("${re}install: $pkg"); + } + $donesize += $sizes{$pkg}; +@@ -3098,18 +3093,18 @@ + } + my $tlm; + if ($opts{"only-installed"}) { +- $tlm = $localtlmedia; ++ $tlm = $localtlpdb; + } else { + init_tlmedia(); +- $tlm = $tlmediasrc; ++ $tlm = $remotetlpdb; + } + my @whattolist; + if ($what =~ m/^collection/i) { +- @whattolist = $tlm->tlpdb->collections; ++ @whattolist = $tlm->collections; + } elsif ($what =~ m/^scheme/i) { +- @whattolist = $tlm->tlpdb->schemes; ++ @whattolist = $tlm->schemes; + } else { +- @whattolist = $tlm->tlpdb->list_packages; ++ @whattolist = $tlm->list_packages; + } + foreach (@whattolist) { + next if ($_ =~ m/^00texlive/); +@@ -3118,7 +3113,7 @@ + } else { + print " "; + } +- my $foo = $tlm->tlpdb->get_package($_)->shortdesc; ++ my $foo = $tlm->get_package($_)->shortdesc; + print "$_: ", defined($foo) ? $foo : "(shortdesc missing)" , "\n"; + } + return; +@@ -3311,12 +3306,11 @@ + $what || ($what = "list"); + if ($what =~ m/^list$/i) { + # list the available platforms +- # initialize the TLMedia from $location ++ # initialize the TLPDB from $location + init_tlmedia(); +- my $mediatlpdb = $tlmediasrc->tlpdb; + my @already_installed_arch = $localtlpdb->available_architectures; + print "Available platforms:\n"; +- foreach my $a ($mediatlpdb->available_architectures) { ++ foreach my $a ($remotetlpdb->available_architectures) { + if (member($a,@already_installed_arch)) { + print "(i) $a\n"; + } else { +@@ -3329,9 +3323,8 @@ + } elsif ($what =~ m/^add$/i) { + return if !check_on_writable(); + init_tlmedia(); +- my $mediatlpdb = $tlmediasrc->tlpdb; + my @already_installed_arch = $localtlpdb->available_architectures; +- my @available_arch = $mediatlpdb->available_architectures; ++ my @available_arch = $remotetlpdb->available_architectures; + my @todoarchs; + foreach my $a (@ARGV) { + if (TeXLive::TLUtils::member($a, @already_installed_arch)) { +@@ -3351,9 +3344,9 @@ + if ($dep =~ m/^(.*)\.ARCH$/) { + # we have to install something + foreach my $a (@todoarchs) { +- if ($tlmediatlpdb->get_package("$pkg.$a")) { ++ if ($remotetlpdb->get_package("$pkg.$a")) { + info("install: $pkg.$a\n"); +- $tlmediasrc->install_package("$pkg.$a", $localtlpdb) ++ $remotetlpdb->install_package("$pkg.$a", $localtlpdb) + if (!$opts{"dry-run"}); + } + } +@@ -3364,7 +3357,7 @@ + # install the necessary w32 stuff + for my $p (@extra_w32_packs) { + info("install: $p\n"); +- $tlmediasrc->install_package($p, $localtlpdb) if (!$opts{"dry-run"}); ++ $remotetlpdb->install_package($p, $localtlpdb) if (!$opts{"dry-run"}); + } + } + # update the option("available_architectures") list of installed archs +@@ -3378,7 +3371,7 @@ + return if !check_on_writable(); + my @already_installed_arch = $localtlpdb->available_architectures; + my @todoarchs; +- my $currentarch = $localtlmedia->platform(); ++ my $currentarch = $localtlpdb->platform(); + foreach my $a (@ARGV) { + if (!TeXLive::TLUtils::member($a, @already_installed_arch)) { + print "Platform $a not installed, use 'tlmgr platform list'!\n"; +@@ -3404,7 +3397,7 @@ + foreach my $a (@todoarchs) { + if ($localtlpdb->get_package("$pkg.$a")) { + info("remove: $pkg.$a\n"); +- $localtlmedia->remove_package("$pkg.$a") if (!$opts{"dry-run"}); ++ $localtlpdb->remove_package("$pkg.$a") if (!$opts{"dry-run"}); + } + } + } +@@ -3413,7 +3406,7 @@ + if (TeXLive::TLUtils::member('win32', @todoarchs)) { + for my $p (@extra_w32_packs) { + info("remove: $p\n"); +- $localtlmedia->remove_package($p) if (!$opts{"dry-run"}); ++ $localtlpdb->remove_package($p) if (!$opts{"dry-run"}); + } + } + if (!$opts{"dry-run"}) { +@@ -3629,11 +3622,11 @@ + } + print ("Ok, removing the whole installation:\n"); + init_local_db(); +- TeXLive::TLUtils::remove_symlinks($localtlmedia->tlpdb->root, +- $localtlmedia->platform(), +- $localtlmedia->tlpdb->option("sys_bin"), +- $localtlmedia->tlpdb->option("sys_man"), +- $localtlmedia->tlpdb->option("sys_info")); ++ TeXLive::TLUtils::remove_symlinks($localtlpdb->root, ++ $localtlpdb->platform(), ++ $localtlpdb->option("sys_bin"), ++ $localtlpdb->option("sys_man"), ++ $localtlpdb->option("sys_info")); + # now do remove the rest + system("rm", "-rf", "$Master/texmf-dist"); + system("rm", "-rf", "$Master/texmf-doc"); +@@ -3845,7 +3838,7 @@ + + # if we are on W32, return (no find). We need -use-svn only for + # checking the live repository on tug, which is not w32. +- my $arch = $localtlmedia->platform(); ++ my $arch = $localtlpdb->platform(); + return $ret if $arch eq "win32"; + + # check that all files in the trees are covered. +@@ -4427,15 +4420,12 @@ + # if the localtlpdb is already defined do simply return here already + # to make sure that the settings in the local tlpdb do not overwrite + # stuff changed via the GUI +- return if defined $localtlmedia; + return if defined $localtlpdb; +- $localtlmedia = TeXLive::TLMedia->new ( $Master ); +- die("cannot setup TLMedia in $Master") unless (defined($localtlmedia)); +- $localtlpdb = $localtlmedia->tlpdb; +- die("cannot find tlpdb in $Master") unless (defined($localtlpdb)); ++ $localtlpdb = TeXLive::TLPDB->new ( root => $Master ); ++ die("cannot setup TLPDB in $Master") unless (defined($localtlpdb)); + # setup the programs, for w32 we need the shipped wget/xz etc, so we + # pass the location of these files to setup_programs. +- if (!setup_programs("$Master/tlpkg/installer", $localtlmedia->platform)) { ++ if (!setup_programs("$Master/tlpkg/installer", $localtlpdb->platform)) { + tlwarn("Couldn't set up the necessary programs.\nInstallation of packages is not supported.\nPlease report to texlive\@tug.org.\n"); + if (defined($should_i_die) && $should_i_die) { + finish(1); +@@ -4471,12 +4461,12 @@ + } + + +-# initialize the global $tlmediasrc object, or die. ++# initialize the global $remotetlpdb object, or die. + # uses the global $location. + # + sub init_tlmedia + { +- if (defined($tlmediatlpdb) && ($tlmediatlpdb->root eq $location)) { ++ if (defined($remotetlpdb) && ($remotetlpdb->root eq $location)) { + # nothing to be done + return; + } +@@ -4531,8 +4521,8 @@ + END_NO_INTERNET + # above text duplicated in install-tl + +- $tlmediasrc = TeXLive::TLMedia->new(-location => $location, +- -tlpdbfile => $loc_copy_of_remote_tlpdb); ++ $remotetlpdb = TeXLive::TLPDB->new(root => $location, ++ tlpdbfile => $loc_copy_of_remote_tlpdb); + $local_copy_tlpdb_used = 1; + } else { + ddebug("found remote digest: $rem_digest\n"); +@@ -4540,19 +4530,17 @@ + ddebug("rem_copy_digest = $rem_copy_digest\n"); + if ($rem_copy_digest eq $rem_digest) { + debug("md5 of local copy identical with remote hash\n"); +- $tlmediasrc = TeXLive::TLMedia->new(-location => $location, +- -tlpdbfile => $loc_copy_of_remote_tlpdb); ++ $remotetlpdb = TeXLive::TLPDB->new(root => $location, ++ tlpdbfile => $loc_copy_of_remote_tlpdb); + $local_copy_tlpdb_used = 1; + } + } + } + } + if (!$local_copy_tlpdb_used) { +- # $tlmediasrc is a global variable +- $tlmediasrc = TeXLive::TLMedia->new(-location => $location); ++ $remotetlpdb = TeXLive::TLPDB->new(root => $location); + } +- die($loadmediasrcerror . $location) unless defined($tlmediasrc); +- $tlmediatlpdb = $tlmediasrc->tlpdb; ++ die($loadmediasrcerror . $location) unless defined($remotetlpdb); + # we allow a range of years to be specified by the remote tlpdb + # for which it might work. + # the lower limit is TLPDB->config_minrelease +@@ -4563,10 +4551,10 @@ + # might use + # release/2009-foobar + # If it should work for 2009 and 2010, please use +- # release/2010-foobar + # minrelease/2009-foobar +- my $texlive_release = $tlmediatlpdb->config_release; +- my $texlive_minrelease = $tlmediatlpdb->config_minrelease; ++ # release/2010-foobar ++ my $texlive_release = $remotetlpdb->config_release; ++ my $texlive_minrelease = $remotetlpdb->config_minrelease; + if (!defined($texlive_release)) { + tldie "The installation repository does not specify a release year for which it was prepared, bailing out.\n"; + } +@@ -4595,7 +4583,7 @@ + END_BADRANGE + } + } else { +- # $texlive_release not defined, so only one year is valid ++ # $texlive_minrelease not defined, so only one year is valid + if ($texlive_release_year != $TeXLive::TLConfig::ReleaseYear) { + tldie <<END_BADYEAR + $0: The TeX Live versions of the local installation +@@ -4608,7 +4596,7 @@ + } + + # check for being frozen +- if ($tlmediatlpdb->option("frozen")) { ++ if ($remotetlpdb->option("frozen")) { + my $frozen_msg = <<FROZEN; + TeX Live $TeXLive::TLConfig::ReleaseYear is frozen forever and will no + longer be updated. This happens in preparation for a new release. +@@ -4636,7 +4624,7 @@ + &debug("Cannot save remote TeX Live database to $loc_copy_of_remote_tlpdb: $!\n"); + } else { + &debug("writing out tlpdb to $loc_copy_of_remote_tlpdb\n"); +- $tlmediatlpdb->writeout($tlfh); ++ $remotetlpdb->writeout($tlfh); + close($tlfh); + } + } +Index: texmf/scripts/texlive/tlmgrgui.pl +=================================================================== +--- texmf/scripts/texlive/tlmgrgui.pl (revision 22210) ++++ texmf/scripts/texlive/tlmgrgui.pl (working copy) +@@ -53,9 +53,7 @@ + # + # stuff defined in tlmgr.pl that needs to be our-ed + our $Master; +-our $tlmediatlpdb; +-our $tlmediasrc; +-our $localtlmedia; ++our $remotetlpdb; + our $localtlpdb; + our $location; + our %opts; +@@ -692,10 +690,10 @@ + $tf->Label(-text => $Packages{$p}{'secondary'}), + -sticky => "nw"); + } +- if ($tlmediatlpdb) { ++ if ($remotetlpdb) { + my @colls; + if ($tlp->category ne "Collection" && $tlp->category ne "Scheme") { +- @colls = $tlmediatlpdb->needed_by($tlp->name); ++ @colls = $remotetlpdb->needed_by($tlp->name); + } + @colls = grep {m;^collection-;} @colls; + if (@colls) { +@@ -958,12 +956,12 @@ + ############# ARCH HANDLING ##################### + + sub init_archs { +- if (!defined($tlmediatlpdb)) { ++ if (!defined($remotetlpdb)) { + @archsavail = $localtlpdb->available_architectures; + } else { +- @archsavail = $tlmediatlpdb->available_architectures; ++ @archsavail = $remotetlpdb->available_architectures; + } +- $currentarch = $localtlmedia->platform(); ++ $currentarch = $localtlpdb->platform(); + @archsinstalled = $localtlpdb->available_architectures; + foreach my $a (@archsavail) { + $archs{$a} = 0; +@@ -1562,26 +1560,24 @@ + + sub init_install_media { + my $newroot = $location; +- if (defined($tlmediatlpdb) && ($tlmediatlpdb->root eq $newroot)) { ++ if (defined($remotetlpdb) && ($remotetlpdb->root eq $newroot)) { + # nothing to be done + } else { + $mw->Busy(-recurse => 1); + info(__("Loading remote TeX Live Database\nThis may take some time, please wait!") . "\n"); +- $tlmediasrc = TeXLive::TLMedia->new($newroot); ++ $remotetlpdb = TeXLive::TLPDB->new(root => $newroot); + info(__("Completed") . ".\n"); + $mw->Unbusy; +- if (!defined($tlmediasrc)) { ++ if (!defined($remotetlpdb)) { + # something went badly wrong, maybe the newroot is wrong? + $mw->Dialog(-title => __("Warning"), + -text => __("Could not load the TeX Live Database from %s\nIf you want to install or update packages, please try with a different package repository!\n\nFor configuration and removal you don\'t have to do anything.", $newroot), + -buttons => [ __("Ok") ])->Show; +- $tlmediatlpdb = undef; +- $tlmediasrc = undef; ++ $remotetlpdb = undef; + update_list_remote(); + update_grid(); + update_loaded_location_string("none"); + } else { +- $tlmediatlpdb = $tlmediasrc->tlpdb; + update_list_remote(); + update_grid(); + update_loaded_location_string($location); +@@ -1871,15 +1867,15 @@ + delete $Packages{$p}{'remoterevision'}; + delete $Packages{$p}{'remotecatalogueversion'}; + } +- if (defined($tlmediatlpdb)) { +- for my $p ($tlmediatlpdb->list_packages()) { ++ if (defined($remotetlpdb)) { ++ for my $p ($remotetlpdb->list_packages()) { + # skip 00texlive packages + next if ($p =~ m!^00texlive!); + if ($p =~ m;\.;) { + push @do_later_media, $p; + next; + } +- my $tlp = $tlmediatlpdb->get_package($p); ++ my $tlp = $remotetlpdb->get_package($p); + populate_Packages("remote", $tlp); + } + } +@@ -1890,7 +1886,7 @@ + tlerror("very strange, above it matched and now not anymore?!?! $p\n"); + next; + } +- my $tlp = $tlmediatlpdb->get_package($p); ++ my $tlp = $remotetlpdb->get_package($p); + if (!defined($Packages{$mp})) { + populate_Packages("remote", $tlp); + } else { diff --git a/Master/tlpkg/dev/dev.multi-source-support-v2.README b/Master/tlpkg/dev/dev.multi-source-support-v2.README new file mode 100644 index 00000000000..513b8daf5c5 --- /dev/null +++ b/Master/tlpkg/dev/dev.multi-source-support-v2.README @@ -0,0 +1,169 @@ +Multi source support in TeX Live v2 +----------------------------------- +(Work in progress) + +[needs dev.merge-tlmedia-into-tlpdb-and-get-rid-of-it !!!! ] + +v2 of this patches has changed completely the idea of implementation. +Background of the new idea is to leave the code base of tlmgr.pl itself +as untouched as possible, and merge everything into TLPDB. TLPDBs can +now either be a normal one as before, or a virtual one, collection +different sources. + +(completely independent from generalized revisions) +[karl: good.] + +1) extension of the location part in 00texlive.installation +----------------------------------------------------------- + +The opt_location: line in 00texlive.installation normally gives the +repository to be used. It can now contain a list of repositories in the +form + repo1[#tag1] repo2[#tag2] ... + +Management of these items is thorugh + tlmgr repository +action. + tlmgr repository list + tlmgr repository add repo [tag] + tlmgr repository remove name +If no tag is given then internally (but not in the tlpdb) the tag +and the repo path is the same. + +Removing is done by entering the tag (not the repo), but if no tags were +given that is the same. + + +If there are more than one tag, then there has to be one tagged + main +which is the main repository. + +By default, if you start with only one entry (as before, the main), +and add a new one, the tag "main" is automatically added to the +previous tag to make all run smooth. + +THe repo at "main" is used for various settings, the main configuration +options, etc etc. Idea is still that everyone has the main repo CTAN +(or mirror or ...), and can add some sub-repos. + +Old discussion: + +[karl: how do these lines get added? tool, manual editing of tlpdb?] +[norbert: tlmgr location url1 url2=tag1 url3 url4=tag2 ... + # sets url1, url2 with tag tag1, url3, and url4 with tag2 + # as the list of available locations + # backward compatibility with former usage + tlmgr location add ... + # adds locations to the list of available locs + tlmgr location remove ... + # removes locations ... +] +[k2: well, there is no "location" action now, so compatibility isn't an issue. +having this new action seems like a good idea. tlmgr option location foo +will just become a synonm for tlmgr location add foo. yes?] + +2) invocation of tlmgr/installation +----------------------------------- + +Normally tlmgr will install the candidate with the highest revision number. + +This is controlled by + TLPDB::virtual_candidate +For now the policy is the highest rev number, but we can add later +different policies. + +[karl: ok, given pinning below. otherwise i don't like it.] +[norbert: Why, can you explain why you don't like that the highest revision + number wins?] +[k2: because it is random, except in the one case where you want to use + it. that is, i understand that you want to copy a tl package, make + some local fixes, and install it locally, keeping track of the rev + number. that's fine for you. but there's no way most people are + going to bother with that. if mojca sets up a context repo, say, + those revision numbers are (should be) completely independent of tl's + revision numbers. therefore, all the context packages should be + pinned to the context repo, so the context repo always wins. without + pinning, it would be an unmaintainable situation.] + +That will be achieved by + tlmgr install package + +[FOR NOW THE FOLLOWING IS NOT IMPLEMENTED!!] +If you want to install a package from a specific mirror you can do + tlmgr install package/TAG + (tlmgr install package/SOURCE) +where TAG is the tag given above, and SOURCE is the full source address. +So continuing the above example we could call + tlmgr install package/department +or + tlmgr install package/http://server.local.uni/texlive/packages +(maybe we don't allow the later form ...?) +[karl: well, if it's done, then I see no reason not to support it.] + +done + +[NOT IMPLEMENTED BY NOW] +3) pinning +---------- + +tlmgr will evaluate an additional config file + ROOT/tlpkg/pinning +or the one given via cmdline + tlmgr -pins /path/to/pinning/file +[karl: maybe it should be found in texmf-local/tlpkg? look there + before ROOT/tlpkg but allow both? maybe other places too. have to think + about it. Also, the filename should be something clearer, perhaps + tlpkgpins.txt.] +[norbert: agreed, that texmf-local might be a better place. should be + thought out] + +That file contains lines + package:tag:pin +where package is a package name or * (or regexp? or glob context* eg?) +[glob is better than regexp in this case I think] +and tag is [a-z0-9,]+ as for tags above, or *, +and pin is an integer between 0 and 1000. + +Now the evaluation *which* package will be installed will be done as follows: + +1) create the list of candidates, i.e., all tlpobj from different sources + where the name matches the one to be installed +[karl: if a package is pinned to a single source (99% case, seems to + me), the other sources (e.g., default ctan) won't even be considered, right?] + +[norbert: well, it depends. There will be a default pin value of say 500, + and you can give pin values lower than 500 to prefer packages from other + sources, or higher pin values to prefer these sources] + +[k2: I understand there is all this flexibility, but that's not my +point. I envision the single most common use of this (by far) to say +"get package foo from my special location bar", where foo is a local +font, or tlmgr from tlcritical. In these cases, the user will set a +single location. And then it would be a waste of time for tlmgr to even +consider looking at the default location (tlnet) for foo. It should not +even be a candidate.] + + +2) compute the pins of all the candidates + +3) if there are different pins cancel those candidates with a non-maximal pin + (i.e., let pin_max = max { pin(candidate) : candidate in candidates }, + and new candidates are those with pin(candidate) = pin_max) + +4) within all the remaining candidates choose the one with the highest + revision number + + +======================================== + +Consequences of the above: +- no source: part necessary in the revisions +- packages can be pinned to a specific source, and will not be updated + even if another source ships a higher version number +- no changes to the general server infrastructure are needed +- default installations continue as before +- normal installations with multiple sources but without pinning will + simply *do*the*right*thing*, namely install the highest revision number. +[karl: it's unclear to me that that is the right thing, in general, but + I can see how it is the right thing in some cases, e.g., yours, so fine.] +[norbert: see above ... I don't see the wrong point ;-) ] diff --git a/Master/tlpkg/dev/dev.multi-source-support-v2.patch b/Master/tlpkg/dev/dev.multi-source-support-v2.patch new file mode 100644 index 00000000000..4b4949995b3 --- /dev/null +++ b/Master/tlpkg/dev/dev.multi-source-support-v2.patch @@ -0,0 +1,757 @@ +--- /src/TeX/texlive-svn/Master/tlpkg/TeXLive/TLPDB.pm 2011-04-27 17:49:03.000000000 +0900 ++++ tlpkg/TeXLive/TLPDB.pm 2011-04-27 17:49:50.000000000 +0900 +@@ -6,7 +6,7 @@ + + package TeXLive::TLPDB; + +-my $svnrev = '$Revision: 22215 $'; ++my $svnrev = '$Revision: 22010 $'; + my $_modulerevision; + if ($svnrev =~ m/: ([0-9]+) /) { + $_modulerevision = $1; +@@ -73,10 +73,17 @@ + $tlpdb->install_package($pkg, $dest_tlpdb, $nopostinstall, $fallbacktlpdb); + $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->virtual_candidates($pkg); ++ $tlpdb->virtual_candidate($pkg); ++ + =head1 DESCRIPTION + + =cut +@@ -160,6 +167,10 @@ + + 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; + } + +@@ -208,6 +219,10 @@ + + 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,6 +243,10 @@ + + sub from_file { + my ($self, $path) = @_; ++ 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"; + } +@@ -352,6 +371,10 @@ + + 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"); +@@ -371,6 +394,10 @@ + + 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"; +@@ -392,6 +419,10 @@ + + sub media { + my $self = shift ; ++ if ($self->is_virtual) { ++ tlwarn("cannot determine the media of a virtual tlpdb\n"); ++ return; ++ } + return $self->{'media'}; + } + +@@ -407,6 +438,18 @@ + + sub available_architectures { + my $self = shift; ++ my @archs; ++ if ($self->is_virtual) { ++ for my $k (keys %{$self->{'tlpdbs'}}) { ++ push @archs, $self->{'tlpdbs'}{$k}->available_architectures; ++ } ++ } else { ++ return $self->_available_architectures; ++ } ++} ++ ++sub _available_architectures { ++ my $self = shift; + my @archs = $self->setting("available_architectures"); + if (! @archs) { + # fall back to the old method checking tex\.* +@@ -434,6 +477,10 @@ + + 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; +@@ -499,6 +546,16 @@ + + sub get_package { + my ($self,$pkg) = @_; ++ if ($self->is_virtual) { ++ my ($maxsrc, $maxrev, $maxtlp, $maxtlmedia) = $self->virtual_candidate($pkg); ++ return $maxtlp; ++ } else { ++ return $self->_get_package($pkg); ++ } ++} ++ ++sub _get_package { ++ my ($self,$pkg) = @_; + if (defined($self->{'tlps'}{$pkg})) { + my $ret = $self->{'tlps'}{$pkg}; + return $self->{'tlps'}{$pkg}; +@@ -509,6 +566,35 @@ + + =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<list_packages> function returns the list of all included packages. +@@ -517,6 +603,15 @@ + + sub list_packages { + my $self = shift; ++ if ($self->is_virtual) { ++ return (sort keys %{$self->{'packages'}}); ++ } else { ++ return $self->_list_packages; ++ } ++} ++ ++sub _list_packages { ++ my $self = shift; + return (sort keys %{$self->{'tlps'}}); + } + +@@ -625,6 +720,7 @@ + + =cut + ++# TODO adapt for searching in *all* tags ??? + sub find_file { + my ($self,$fn) = @_; + my @ret; +@@ -858,6 +954,10 @@ + + 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'}; + } +@@ -876,7 +976,11 @@ + =cut + + sub location { +- my $self = shift; ++ my $self = shift; ++ if ($self->is_virtual) { ++ tlwarn("cannot get location of a virtual tlpdb\n"); ++ return 0; ++ } + return "$self->{'root'}/$InfraLocation/$DatabaseName"; + } + +@@ -927,8 +1031,14 @@ + + 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"; + } +@@ -948,8 +1058,14 @@ + + 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) { + if ($d =~ m!^container_split_doc_files/(.*)$!) { + return "$1"; + } +@@ -968,8 +1084,14 @@ + + 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"; + } +@@ -988,8 +1110,14 @@ + + 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"; + } +@@ -1008,8 +1136,14 @@ + + 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"; + } +@@ -1029,8 +1163,14 @@ + + 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"; + } +@@ -1056,12 +1196,12 @@ + 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; +@@ -1085,7 +1225,7 @@ + $size += $tlpobj->srccontainersize if $opt_src; + $size += $tlpobj->doccontainersize if $opt_doc; + } else { +- # we have to add the respective sizes, that is checking for ++ # we have to add the respective sizes, that is checking for + # installation of src and doc file + $size = $tlpobj->runsize; + $size += $tlpobj->srcsize if $opt_src; +@@ -1108,6 +1248,16 @@ + + sub install_package { + my ($self, $pkg, $totlpdb, $nopostinstall, $fallbackmedia) = @_; ++ if ($self->is_virtual) { ++ my ($maxtag, $maxrev, $maxtlp, $maxtlpdb) = $self->virtual_candidate($pkg); ++ return $maxtlpdb->install_package($pkg, $totlpdb, $nopostinstall, $fallbackmedia); ++ } else { ++ return $self->not_virtual_install_package($pkg, $totlpdb, $nopostinstall, $fallbackmedia); ++ } ++} ++ ++sub not_virtual_install_package { ++ my ($self, $pkg, $totlpdb, $nopostinstall, $fallbackmedia) = @_; + my $fromtlpdb = $self; + my $ret; + die("TLPDB not initialized, cannot find tlpdb!") unless (defined($fromtlpdb)); +@@ -1346,6 +1496,7 @@ + # we are installing from local compressed files + # copy it to temp + TeXLive::TLUtils::copy($what, $tempdir); ++system("ls -al $tempdir"); + } + debug("un-xzing $xzfile to $tarfile\n"); + system("$xzdec < $xzfile_quote > $tarfile_quote"); +@@ -1548,7 +1699,12 @@ + 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; +@@ -1586,8 +1742,14 @@ + 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"; + } +@@ -1700,7 +1862,12 @@ + 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([^:]*):(.*)!) { +@@ -1849,6 +2016,122 @@ + + =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->{$pkgname}{$tag}{'revision'} = $rev ++# $self->{$pkgname}{$tag}{'tlp'} = $tlp ++# ++ ++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}{$tag}{'revision'} = $tlp->revision; ++ $self->{'packages'}{$p}{$tag}{'tlp'} = $tlp; ++ } ++ 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}{$tag}; ++ } ++ delete $self->{'tlpdbs'}{$tag}; ++ return 1; ++} ++ ++sub virtual_get_package { ++ my ($self, $pkg, $tag) = @_; ++ if (defined($self->{'packages'}{$pkg}{$tag})) { ++ return $self->{'packages'}{$pkg}{$tag}{'tlp'}; ++ } else { ++ tlwarn("pkg $pkg not found in tag $tag\n"); ++ return; ++ } ++} ++ ++# returns a list of tag/rev ++sub virtual_candidates { ++ my ($self, $pkg) = @_; ++ if (defined($self->{'packages'}{$pkg})) { ++ my @ret = (); ++ for my $t (keys %{$self->{'packages'}{$pkg}}) { ++ push @ret, "$t/" . $self->{'packages'}{$pkg}{$t}{'revision'}; ++ } ++ return @ret; ++ } else { ++ return; ++ } ++} ++ ++# ++# 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; ++ if (defined($self->{'packages'}{$pkg})) { ++ for my $t (keys %{$self->{'packages'}{$pkg}}) { ++ my $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}); ++ } ++ return(undef,undef,undef,undef); ++} ++ + =pod + + =head1 OPTIONS +--- /src/TeX/texlive-svn/Master/texmf/scripts/texlive/tlmgr.pl 2011-04-27 17:53:53.000000000 +0900 ++++ texmf/scripts/texlive/tlmgr.pl 2011-04-27 17:53:50.000000000 +0900 +@@ -480,6 +480,9 @@ + } elsif ($action =~ m/^option$/i) { + action_option(); + finish(0); ++ } elsif ($action =~ m/^repository$/i) { ++ action_repository(); ++ finish(0); + } elsif ($action =~ m/^list$/i) { + action_list(); + finish(0); +@@ -3119,6 +3122,115 @@ + 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; ++ } ++} ++ + + # OPTION + # +@@ -4466,6 +4578,45 @@ + # + 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 @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; ++ ++ for my $t (@tags) { ++ my $tlmdb = setup_one_remotetlpdb($repos{$t}); ++ $remotetlpdb->virtual_add_tlpdb($tlmdb, $t); ++ } ++ # 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 _init_tlmedia ++{ + if (defined($remotetlpdb) && ($remotetlpdb->root eq $location)) { + # nothing to be done + return; +@@ -4479,10 +4630,28 @@ + $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 +@@ -4628,6 +4797,8 @@ + close($tlfh); + } + } ++ ++ return($remotetlpdb); + } + + |