#!/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_debug = 0; my $opt_location = "."; my $opt_relative = 0; my $help = 0; GetOptions( "location=s" => \$opt_location, "debug!" => \$opt_debug, "help|?" => \$help) or pod2usage(1); pod2usage(-exitstatus => 0, -verbose => 2) if $help; if ($opt_debug) { $::LOGLEVELFILE = $::LOG_DDDEBUG; $::LOGLEVELTERMINAL = $::LOG_DDDEBUG; } 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"; } tllog($::LOG_DEBUG, "format=$type srcsplit=$srcsplit docsplit=$docsplit\n"); 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(); } # collect packages to be updated. my %count; $count{"new"} = $count{"removed"} = $count{"updated"} = $count{"unchanged"} = 0; my $opt_containerdir = "$opt_location/$TeXLive::TLConfig::NetArchive"; my @todopacks = (); 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 { tllog($::LOG_NORMAL, "$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 { tllog($::LOG_NORMAL, "$pkg has disappeared, removing its containers\n"); `rm $opt_containerdir/$pkg.*`; $count{"removed"}++; } if ($oldrev == $newrev) { tllog($::LOG_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"; } } # 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; tllog($::LOG_DEBUG, "updating $pkg containers ...\n"); if ($srcsplit) { my $objsrc = $obj->split_src_package; if ($objsrc) { $objsrc->make_container($type, $Master, $opt_containerdir, "$pkg.source", $opt_relative); } } if ($docsplit) { my $objdoc = $obj->split_doc_package; if ($objdoc) { $objdoc->make_container($type, $Master, $opt_containerdir, "$pkg.doc", $opt_relative); } } $obj->make_container($type, $Master, $opt_containerdir, $pkg, $opt_relative); } 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 $tlpdb->root($opt_location); $tlpdb->save; } else { print "$0: nothing to be done.\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: #