--- /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 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); }