#!/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::Archive"; my %count; my $nettlpdb; if ($opt_recreate) { # remake everything. @todopacks = $tlpdb->list_packages(); $nettlpdb = $tlpdb->copy; $nettlpdb->root($opt_location); } else { $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) { # by definition, any 00texlive... package does not need containers. next if $pkg =~ /00texlive.*\./; 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 { warn "This shouldn't happen! The revision of $pkg in texlive.tlpdb" . "($newrev) is OLDER than the one in" . "$opt_location/tlpkg/texlive.tlpdb ($oldrev)"; push @todopacks, $pkg; } } } # 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) { my ($s,$m) = $objsrc->make_container($type, $Master, $opt_containerdir, "$pkg.source", $opt_relative); if ($s > 0) { # something was created # important, we have to add it to the original $obj $obj->srccontainersize($s); } if ($m ne "") { $obj->srccontainermd5($m); } } } if ($docsplit) { my $objdoc = $obj->docfiles_package; $objcopy->clear_docfiles; if ($objdoc) { my ($s,$m) = $objdoc->make_container($type, $Master, $opt_containerdir, "$pkg.doc", $opt_relative); if ($s > 0) { # something was created $obj->doccontainersize($s); } if ($m ne "") { $obj->doccontainermd5($m); } } } my ($s,$m) = $objcopy->make_container($type, $Master, $opt_containerdir, $pkg, $opt_relative); if ($s > 0) { $obj->containersize($s); } if ($m ne "") { $obj->containermd5($m); } # add the updated (or new) TLPOBJ to NET TLPDB # that way the other container sizes are not destroyed $nettlpdb->add_tlpobj($obj); } # 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.*`; $nettlpdb->remove_package($op); $count{"removed"}++; } if (@todopacks && ! $opt_recreate) { # we updated something print "$0: $count{new} new, $count{removed} removed, " . "$count{updated} updated, $count{unchanged} unchanged.\n"; } else { print "$0: nothing to be done.\n"; } # STRANGE: It seems that calling -recreate did not save the # docfiles into the texlive.tlpdb, no idea why. So update should now # do that. $nettlpdb->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 =~ /00texlive.*\./; 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<-location> I The location to find the previously generated containers; default is C<./archive>. =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: #