#!/usr/bin/env perl # $Id: tl-update-containers 5188 2007-10-14 20:32:44Z karl $ # Copyright 2008 Norbert Preining # This file is licensed under the GNU General Public License version 2 # or any later version. # # Generate archive file(s) for the packages specified on the cmdline # (doesn't really work, not documented), or all if none specified. BEGIN { $^W = 1; ($mydir = $0) =~ s,/[^/]*$,,; unshift (@INC, "$mydir/.."); } use strict; use TeXLive::TLConfig; use TeXLive::TLPOBJ; use TeXLive::TLPDB; use TeXLive::TLUtils; use Getopt::Long; use Pod::Usage; use File::Path; our $mydir; my $opt_location = "."; my $opt_relative = 0; my $opt_recreate = 0; my $help = 0; TeXLive::TLUtils::process_logging_options(); GetOptions( "location=s" => \$opt_location, "recreate" => \$opt_recreate, "help|?" => \$help) or pod2usage(1); pod2usage(-exitstatus => 0, -verbose => 2) if $help; exit (&main ()); sub main { # get the db. chomp(my $Master = `cd $mydir/../.. && pwd`); # xx TLPDB should default my $tlpdb = TeXLive::TLPDB->new("root" => $Master); die "cannot find tlpdb in $Master" unless defined($tlpdb); my @packs = @ARGV ? @ARGV : $tlpdb->list_packages; # get configuration of package splitting my $srcsplit = $tlpdb->config_src_container; my $docsplit = $tlpdb->config_doc_container; my $format = $tlpdb->config_container_format; my $type = "lzma"; if (($format eq "lzma") || ($format eq "zip")) { $type = $format; } else { warn "$0: unknown container format specified in 00texlive.config: $format" . "; ignoring and continuing with $type"; } debug("format=$type srcsplit=$srcsplit docsplit=$docsplit\n"); my @todopacks = (); my @removepacks = (); my $opt_containerdir = "$opt_location/$TeXLive::TLConfig::NetArchive"; my %count; if ($opt_recreate) { @todopacks = $tlpdb->list_packages(); } else { my $nettlpdb = TeXLive::TLPDB->new(root => $opt_location); if (!defined($nettlpdb)) { die "Cannot init tlpdb from $opt_location ..."; } my %archiverevs; foreach my $pkg ($nettlpdb->list_packages()) { $archiverevs{$pkg} = $nettlpdb->get_package($pkg)->revision(); if (!defined($tlpdb->get_package($pkg))) { # $pkg has disappeared, removing it push @removepacks, $pkg; } } # collect packages to be updated. $count{"new"} = $count{"removed"} = $count{"updated"} = $count{"unchanged"} = 0; for my $pkg (@packs) { next if ($pkg eq "00texlive.config"); next if ($pkg eq "00texlive.installer"); my $oldrev = 0; if (-r "$opt_containerdir/$pkg.tar.$type" && defined($archiverevs{$pkg})) { $oldrev = $archiverevs{$pkg}; } else { info("$pkg is new, found no containers\n"); $count{"new"}++; } my $tlp = $tlpdb->get_package($pkg); my $newrev = 0; if (defined($tlp)) { $newrev = $tlp->revision; } else { # that cannot happen!!! we are looping over the packages of # $tlpdb so the above ->get_package will succeed (or something # stranged happened! die ("Huu, that should not happen ..."); } if ($oldrev == $newrev) { debug("$pkg up to date\n"); $count{"unchanged"}++; } elsif ($oldrev < $newrev) { push @todopacks, $pkg; $count{"updated"}++ if $oldrev; } else { die "This shouldn't happen! The revision of $pkg in texlive.tlpdb" . "($newrev) is OLDER than the one in" . "$opt_location/tlpkg/texlive.tlpdb ($oldrev), goodbye"; } } } # set up the programs ... &TeXLive::TLUtils::setup_programs("$Master/tlpkg/installer"); # get list of packages. for my $pkg (sort @todopacks) { next if ($pkg eq "00texlive.config"); next if ($pkg eq "00texlive.installer"); my $obj = $tlpdb->get_package ($pkg); die "$0: no TL package named $pkg in $Master" if ! $obj; debug("updating $pkg containers ...\n"); # we have to make a copy otherwise the src/doc files in the original # tlpobj are removed, and thus also in the tlpdb to be saved!!! my $objcopy = $obj->copy; if ($srcsplit) { my $objsrc = $obj->srcfiles_package; $objcopy->clear_srcfiles; if ($objsrc) { $objsrc->make_container($type, $Master, $opt_containerdir, "$pkg.source", $opt_relative); } } if ($docsplit) { my $objdoc = $obj->docfiles_package; $objcopy->clear_docfiles; if ($objdoc) { $objdoc->make_container($type, $Master, $opt_containerdir, "$pkg.doc", $opt_relative); } } $objcopy->make_container($type, $Master, $opt_containerdir, $pkg, $opt_relative); } # next we remove those containers which have been gone! foreach my $op (@removepacks) { info("$op has disappeared, removing its containers\n"); `rm $opt_containerdir/$op.*`; $count{"removed"}++; } if (@todopacks) { # we updated something print "$0: $count{new} new, $count{removed} removed, " . "$count{updated} updated, $count{unchanged} unchanged.\n"; # Finally we copy the source tlpdb over to the destination tlpdb } else { print "$0: nothing to be done.\n"; } # STRANGE: It seems that calling -recreate did somehow not safe the # docfiles into the texlive.tlpdb, no idea why. So update should now # do that $tlpdb->root($opt_location); $tlpdb->save; system("lzma --force -k -z $opt_location/tlpkg/texlive.tlpdb"); # # do a last check that all the containers are actually present foreach my $p ($tlpdb->list_packages) { next if ($p eq "00texlive.config"); next if ($p eq "00texlive.installer"); if (! -r "$opt_containerdir/$p.tar.lzma") { info("container for $p is missing, strange!\n"); } } } __END__ =head1 NAME tl-update-containers - create, update, or remove TL containers =head1 SYNOPSIS tl-update-containers [OPTION]... =head1 OPTIONS =over 8 =item B<-containerdir> I The location to find the previously generated containers; default is C<./tlpkg>. If this is changed so that the containers appear in a different directory on the net, then you need to also specify C<<--netarchive>> to C or they will not be found. =back The standard options C<-help> and C<-debug> are also accepted. See the tlpfiles documentation for details. The format of the containers and the splitting off of source and documentation files are controlled by the TLPDB options in the pseudo-package C<00texlive.config>. See the documentation for TLPDB. =head1 DESCRIPTION The B program compares the revision of each package found in C with the revision of the same package in C, found relative to this script. Where the latter is newer (i.e., a higher number), the container(s) for the package are updated. Where the container(s) do not exist, they are created. When the package no longer exists in tlpdb, the container(s) are removed. =head1 AUTHORS AND COPYRIGHT This script and its documentation were written for the TeX Live distribution (L) and both are licensed under the GNU General Public License Version 2 or later. =cut ### Local Variables: ### perl-indent-level: 2 ### tab-width: 2 ### indent-tabs-mode: nil ### End: # vim:set tabstop=2 expandtab: #