#!/usr/bin/env perl # 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 { $vc_id = '$Id$'; $^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; # packages matching these re's will not be updated without --all. my @critical_pkg_list = qw/bin-texlive texlive\.infra texlive-en/; our ($mydir, $vc_id); my $opt_location = "."; my $opt_relative = 0; my $opt_recreate = 0; my $opt_help = 0; my $opt_version = 0; my $opt_all = 0; TeXLive::TLUtils::process_logging_options(); GetOptions( "location=s" => \$opt_location, "recreate" => \$opt_recreate, "all|a" => \$opt_all, "version" => \$opt_version, "help|?" => \$opt_help) or pod2usage(1); pod2usage(-exitstatus => 0, -verbose => 2) if $opt_help; if ($opt_version) { print "$vc_id\n"; exit 0; } exit (&main()); # the real work 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\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 ("failed to get package $pkg, that should not happen!"); } if ($oldrev == $newrev) { debug("$pkg up to date\n"); # check for the existence of all containers, might got missing if (($tlp->runfiles && ! -r "$opt_containerdir/$pkg.tar.$type") || ($srcsplit && $tlp->srcfiles && ! -r "$opt_containerdir/$pkg.source.tar.$type") || ($docsplit && $tlp->docfiles && ! -r "$opt_containerdir/$pkg.doc.tar.$type")) { info("container(s) for $pkg have disappeared, recreating them.\n"); push @todopacks, $pkg; $count{"updated"}++; } else { $count{"unchanged"}++; } } elsif ($oldrev < $newrev) { push @todopacks, $pkg; $count{"updated"}++ if $oldrev; } else { # This can happen when packages get renamed or files get # shuffled from one package to another. warn "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. PACKS: for my $pkg (sort @todopacks) { next if ($pkg eq "00texlive.config"); next if ($pkg eq "00texlive.installer"); foreach my $manualpkgre (@critical_pkg_list) { # we match the initial string of the package name, so that all the # .arch packages are skipped, too if ($pkg =~ m/^$manualpkgre/) { if ($opt_all || $opt_recreate) { tlwarn ("$0: updating critical $pkg due to -all\n"); last; # of the manualpkgre checks } else { tlwarn ("$0: skipping critical $pkg\n"); # we assume that the packages in @critical_pkg_list always # exist, so if they are there then the number of updated packages # should be reduced. $count{'updated'}--; # the following line skips all other regexp checks on critical # packages and skips everything below this big for list (the # part which actually builds the containers) and continues with # the next package (the PACKS: for my $pkg (sort @todopacks) line next PACKS; } } } 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! for 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 [I