From 2511e35cb7450757daaa32bd8929a38b115ec2cc Mon Sep 17 00:00:00 2001
From: Karl Berry <karl@freefriends.org>
Date: Fri, 6 Dec 2019 18:28:03 +0000
Subject: tl-fix-container-links: script to version all remaining containers,
 to be run at pretest time; move other old util scripts to archive/ subdir

git-svn-id: svn://tug.org/texlive/trunk@53040 c570f23f-e606-0410-a88d-b1316a301751
---
 Master/tlpkg/bin/archive/tl-fix-container-infos | 208 ++++++++++++++++
 Master/tlpkg/bin/archive/tl-update-keywords     | 309 ++++++++++++++++++++++++
 2 files changed, 517 insertions(+)
 create mode 100755 Master/tlpkg/bin/archive/tl-fix-container-infos
 create mode 100755 Master/tlpkg/bin/archive/tl-update-keywords

(limited to 'Master/tlpkg/bin/archive')

diff --git a/Master/tlpkg/bin/archive/tl-fix-container-infos b/Master/tlpkg/bin/archive/tl-fix-container-infos
new file mode 100755
index 00000000000..f46ab5e7a57
--- /dev/null
+++ b/Master/tlpkg/bin/archive/tl-fix-container-infos
@@ -0,0 +1,208 @@
+#!/usr/bin/env perl
+# $Id$
+# Copyright 2008-2018 Norbert Preining
+# This file is licensed under the GNU General Public License version 2
+# or any later version.
+# 
+# Updates/fixes the sizes and md5sums of all containers in a tlpdb.
+
+BEGIN {
+  $vc_id = '$Id$';
+  $^W = 1;
+  ($mydir = $0) =~ s,/[^/]*$,,;
+  unshift (@INC, "$mydir/..");
+}
+
+use strict;
+use TeXLive::TLConfig;
+use TeXLive::TLCrypto;
+use TeXLive::TLPOBJ;
+use TeXLive::TLPDB;
+use TeXLive::TLUtils;
+use Getopt::Long;
+use Pod::Usage;
+use File::Path;
+
+our ($mydir, $vc_id);
+my $opt_dry_run = 0;
+my $opt_location = ".";
+my $opt_nosetup = 0;
+my $opt_version = 0;
+my $opt_help = 0;
+
+TeXLive::TLUtils::process_logging_options();
+GetOptions(
+  "dry-run|n"   => \$opt_dry_run, 
+  "location=s"  => \$opt_location, 
+  "no-setup"    => \$opt_nosetup,
+  "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());
+
+
+sub main {
+  chomp(my $Master = `cd $mydir/../.. && pwd`);
+
+  # check that we have a target db.
+  if (! -r "$opt_location/tlpkg/texlive.tlpdb") {
+    die "no file $opt_location/tlpkg/texlive.tlpdb";
+  }
+
+  # get source db, same hierarchy from which we are being run.
+  my $tlpdb = TeXLive::TLPDB->new("root" => $opt_location);
+  die "cannot load tlpdb from root=$opt_location" unless defined($tlpdb);
+
+  if (! TeXLive::TLCrypto::setup_checksum_method()) {
+    die "TLCrypto::setup_checksum_method() failed";
+  }
+
+  # get configuration of package splitting
+  my $srcsplit = $tlpdb->config_src_container;
+  my $docsplit = $tlpdb->config_doc_container;
+  my $format = $tlpdb->config_container_format;
+
+  my $opt_containerdir = "$opt_location/$TeXLive::TLConfig::Archive";
+
+  # set up the programs.
+  if ($opt_nosetup) {
+    # do a minimal setup
+    $::progs{'xz'} = "xz";
+    $::progs{'tar'} = "tar";
+  } else {
+    # do a full setup
+    my $ret = &TeXLive::TLUtils::setup_programs("$Master/tlpkg/installer");
+    if (!$ret) {
+      tlwarn("$0: binaries could not be set up, aborting.\n");
+      exit 1;
+    }
+  }
+
+  # get list of packages.
+  for my $pkg (sort $tlpdb->list_packages) {
+    next if $pkg =~ /00texlive/;
+    my $obj = $tlpdb->get_package ($pkg);
+    die "no package $pkg in master $Master, goodbye"
+      if ! $obj;
+
+    debug("doing $pkg containers ...\n");
+    my $newobj = do_containers($obj, $srcsplit, $docsplit);
+    # replace with the new one with checksum and size changed, if needed
+    $tlpdb->add_tlpobj($newobj || $obj);
+  }
+  if (! $opt_dry_run) {
+    $tlpdb->save;
+    xsystem("xz --force -k -z $opt_location/tlpkg/texlive.tlpdb");
+  }
+  
+  return 0;
+}
+
+
+sub do_containers {
+  my ($obj, $dosrc, $dodoc) = @_;
+  my $name = $obj->name;
+  my $csize = $obj->containersize;
+  my $csum = $obj->containerchecksum;
+  return undef if $csize && $csum;
+  info ("updating $name ($csize, no checksum)\n");
+  
+  my $fbase = "$opt_location/archive/" . $obj->name;
+  my ($a, $b) = do_size_checksum ("${fbase}.tar.xz");
+  $obj->containersize($a);
+  $obj->containerchecksum($b);
+  #
+  # if no main checksum, almost certainly need to update src/doc too.
+  if ($dosrc && $obj->srcfiles) {
+    ($a, $b) = do_size_checksum ("${fbase}.source.tar.xz");
+    $obj->srccontainersize($a);
+    $obj->srccontainerchecksum($b);
+  }
+  #
+  if ($dodoc && $obj->docfiles) {
+    ($a, $b) = do_size_checksum ("${fbase}.doc.tar.xz");
+    $obj->doccontainersize($a);
+    $obj->doccontainerchecksum($b);
+  }
+  return $obj;
+}
+
+# computation of size/checksum values.
+# 
+sub do_size_checksum{
+  my $f = shift;
+  my $size = (stat $f)[7];
+  my $md = TeXLive::TLCrypto::tlchecksum($f);
+  return($size, $md);
+}
+
+__END__
+
+=head1 NAME
+
+tl-fix-container-infos - updates or adds size and checksum for containers
+
+=head1 SYNOPSIS
+
+tl-fix-container-infos [I<option>]...
+
+=head1 OPTIONS
+
+=over 4
+
+=item B<-dry-run|-n>
+
+Don't write anything.
+
+=item B<-location> I</container/dir>
+
+The directory of containers to be updated, requiring
+I</container/dir>C</tlpkg/texlive.tlpdb>, usually with a previous set of
+containers to be compared against; default is C<.>.
+
+=item B<-no-setup>
+
+Does not try to setup the various programs, but uses I<xz> and I<tar>
+from the current path.
+
+=item B<--help>
+
+Display this documentation and exit.
+
+=item B<--version>
+
+Display version information and exit.
+
+=back
+
+The standard options B<-q>, B<-v>, and B<-logfile>=I<file> are also
+accepted; see the C<process_logging_options> function in
+L<TeXLive::TLUtils> for details.
+
+The format of the containers and the splitting of source and
+documentation files are controlled by the TLPDB options in the
+pseudo-package C<00texlive.config>.  See L<TeXLive::TLPDB>.
+
+=head1 DESCRIPTION
+
+This program adds or updates {,src,doc}container{size,checksum}
+directive entries for packages found in the TL location.  Only packages
+without a previous C<containerchecksum> entry are updated.
+
+=head1 AUTHORS AND COPYRIGHT
+
+This script and its documentation were written for the TeX Live
+distribution (L<http://tug.org/texlive>) 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: #
diff --git a/Master/tlpkg/bin/archive/tl-update-keywords b/Master/tlpkg/bin/archive/tl-update-keywords
new file mode 100755
index 00000000000..72f57be5163
--- /dev/null
+++ b/Master/tlpkg/bin/archive/tl-update-keywords
@@ -0,0 +1,309 @@
+#!/usr/bin/env perl
+# $Id$
+# parse a TeXCatalogue v2 .xml dump containing keywords and
+# characterizations 
+# 
+# Copyright 2010-2014 Norbert Preining
+# This file is licensed under the GNU General Public License version 2
+# or any later version.
+
+BEGIN {
+  $^W = 1;
+  chomp ($mydir = `dirname $0`);
+  unshift (@INC, "$mydir/..");
+}
+
+use strict;
+
+use XML::Parser;
+use XML::XPath;
+use XML::XPath::XMLParser;
+use Text::Unidecode;
+use Data::Dumper;
+use Getopt::Long;
+use Pod::Usage;
+use TeXLive::TLUtils;
+
+my %taxonomy;
+
+my $tcfile;
+my $output;
+my $help = 0;
+
+TeXLive::TLUtils::process_logging_options();
+GetOptions(
+  "input|catalogue=s" => \$tcfile,
+  "output=s"          => \$output,
+  "help|?"            => \$help) or pod2usage(1);
+pod2usage(-exitstatus => 0, -verbose => 2) if $help;
+
+my $prg = TeXLive::TLUtils::basename($0);
+
+exit (&main());
+
+
+sub main
+{
+  my $io;
+  if (!defined($tcfile)) {
+    $io = \*STDIN;
+  } else {
+    -f $tcfile || die "$prg: argument to --input is not a file: $!\n";
+    open($io, "<", $tcfile) || die "Cannot open input file $tcfile: $!";
+  }
+
+  parse_texcatalogue($io);
+  $Data::Dumper::Indent = 1;
+
+  my $out;
+  if (!defined($output)) {
+    $out = \*STDOUT;
+  } else {
+    open($out, ">$output") || die "Cannot open output file $output: $!";
+  }
+  chomp (my $date = `LC_ALL=C date`);
+  chomp (my $prg = `basename $0`);
+  print $out "# Generated $date by $prg.\n";
+  print $out Data::Dumper->Dump([\%taxonomy], ["taxonomy"]), $/;
+}
+
+
+
+# how to read in!!!
+#my $taxonomy;
+#my $foo = `cat tc-dump`;
+# the no strict "vars" is *ABSOLUT* necessary otherwise the file is not
+# evaluated, no idea why!
+#no strict "vars";
+#eval "$foo";
+#use strict "vars";
+#
+#print_keywords($taxonomy->{'by-taxonomy'}{'keywords'});
+#print "\n===================\nprimary characterizations\n";
+#walk_cz_tree($taxonomy->{'by-taxonomy'}{'primary'}, "PRIM");
+#print "\n===================\nsecondary characterizations\n";
+#walk_cz_tree($taxonomy->{'by-taxonomy'}{'secondary'}, "SEC");
+#print "\n===================\nfunctionality characterizations\n";
+#walk_cz_tree($cz_pkg->{'by-taxonomy'}{'functionality'}, "BFUNC");
+
+##### only subs from here ##########
+
+sub parse_texcatalogue {
+  my $io = shift;
+  my $_parser = XML::Parser->new(
+    ErrorContext => 2,
+    ParseParamEnt => 1,
+    NoLWP => 0
+  );
+  my $parser = new XML::XPath->new(ioref => $io, parser => $_parser) ||
+    die "Failed to parse input file $tcfile: $!";
+
+  # format of the data
+  # $taxonomy{'by-package'}{'keyword'}{$package} = [ $kwi, $kwii,...];
+  # $taxonomy{'by-package'}{'primary'}{$package} = $primchar;
+  # $taxonomy{'by-package'}{'secondary'}{$package'} = $secchar;
+  # $taxonomy{'by-package'}{'functionality'}{$package} = [ $bfi, $bfii, ...];
+  #
+  # post processing gives
+  # $taxonomy{'by-taxonomy'}{'keyword'}{$keyword} = [ $pkg1, $pkg2, ...];
+  # $taxonomy{'by-taxonomy'}{'primary'}{$level1}{$level2}...{'_packages_'} = [ $pkg1, $pkg2, ...];
+  # $taxonomy{'by-taxonomy'}{'secondary'}{$level1}{$level2}...{'_packages_'} = [ $pkg1, $pkg2, ...];
+  # $taxonomy{'by-taxonomy'}{'functionality'}{$level1}{$level2}...{'_packages_'} = [ $pkg1, $pkg2, ...];
+
+
+  foreach my $e ($parser->find('/fullcat/catalogue/entry')->get_nodelist) {
+    my $pkg = $parser->findvalue('./name',$e)->value();
+    #print "FOUND: $pkg\n";
+    my $n = $parser->find('./keyword',$e);
+    for my $kw ($n->get_nodelist) {
+      my $kwval = $parser->find('./@keyword',$kw)->string_value();
+      push @{$taxonomy{'by-package'}{'keyword'}{$pkg}}, $kwval;
+      #print "keyword = $kwval\n";
+    }
+    $n = $parser->find('./characterization',$e);
+    for my $cz ($n->get_nodelist) {
+      my $czdimnl = $parser->find('./@dimension',$cz);
+      my $czdim = $czdimnl->string_value();
+      my $czvalnl = $parser->findvalue('.',$cz);
+      my $czval = $czvalnl->value();
+      if (($czdim eq "primary") || ($czdim eq "secondary")) {
+        # assume only one primary and one secondary function
+        $taxonomy{'by-package'}{$czdim}{$pkg} = $czval;
+      } else {
+        # assume that it is always "functionality"
+        push @{$taxonomy{'by-package'}{'functionality'}{$pkg}}, $czval;
+      }
+      #print "char dim = $czdim val=$czval\n";
+    }
+  }
+
+
+  #
+  # do the keyword reshuffling
+  for my $pkg (keys %{$taxonomy{'by-package'}{'keyword'}}) {
+    for my $kw (@{$taxonomy{'by-package'}{'keyword'}{$pkg}}) {
+      push @{$taxonomy{'by-taxonomy'}{'keyword'}{$kw}}, $pkg;
+    }
+  }
+
+  parse_characterizations('primary');
+  parse_characterizations('secondary');
+  parse_characterizations('functionality');
+}
+
+sub parse_characterizations {
+  my $what = shift;
+  $taxonomy{'by-taxonomy'}{$what} = {};
+  for my $pkg (keys %{$taxonomy{'by-package'}{$what}}) {
+    my $value = $taxonomy{'by-package'}{$what}{$pkg};
+    my @charlist;
+    if (!ref($value)) {
+      @charlist = ($value);
+    } else {
+      @charlist = @$value;
+    }
+    for my $prim (@charlist) {
+      # split the primary into levels sep by >
+      my @levels = split(' > ', $prim);
+      my $currentpointer;
+      $currentpointer = $taxonomy{'by-taxonomy'}{$what};
+      for my $l (@levels) {
+        if (!defined($currentpointer->{$l})) {
+          $currentpointer->{$l} = {};
+        }
+        $currentpointer = $currentpointer->{$l}
+      }
+      push @{$currentpointer->{'_packages_'}}, $pkg;
+    }
+  }
+}
+
+
+sub print_keywords {
+  my $kw_pkg = shift;
+  for my $k (keys %$kw_pkg) {
+    my @pkgl = @{$kw_pkg->{$k}};
+    if (@pkgl) {
+      print "keyword = $k\n  package = @pkgl\n";
+    } else {
+      print "keyword = $k\n  package = NO PACKAGE FOUND!\n";
+    }
+  }
+}
+
+
+sub walk_cz_tree {
+  my $cp = shift;
+  my $prestring = shift;
+  if (defined($cp->{'_packages_'})) {
+    my @pkgs = sort @{$cp->{'_packages_'}};
+    print "$prestring\n";
+    print "--> @pkgs\n";
+  }
+  for my $cz (keys %$cp) {
+    if ($cz ne '_packages_') {
+      my $nextstring = "$prestring > $cz";
+      my $np = $cp->{$cz};
+      &walk_cz_tree($np,$nextstring);
+    }
+  }
+}
+
+__END__
+
+=head1 NAME
+
+tl-update-keywords - parse the experimental TeX Catalogue
+
+=head1 SYNOPSIS
+
+tl-update-keywords [--input ....] [--output ...] [--help|-h|-?]
+
+=head1 DESCRIPTION
+
+This program parses the XML data dump of the experimental new
+TeX Catalogue which includes various characterizations of packages,
+into keywords, functionalities, and classifications.
+
+It dumps this data in a textual representation of a perl hash, which
+can very easily be read back into a perl program.
+
+=head1 OPTIONS
+
+=over 4
+
+=item B<-input>
+
+from where to read the XML dump of the TeX Catalogue, defaults to STDIN.
+
+=item B<-output>
+
+where to write the data dump to, defaults to STDOUT.
+
+=item B<-help>, B<-h>, B<-?>
+
+prints out this help text.
+
+=back
+
+=head1 FORMAT OF THE DATA DUMP
+
+The following Perl expression explain in which way the data is saved into
+the dumped hash:
+
+  $taxonomy{'by-package'}{'keyword'}{$package} = [ $kwi, $kwii,...];
+
+List of keywords
+
+  $taxonomy{'by-package'}{'primary'}{$package} = $primchar;
+
+Scalar containing the primary characterization.
+
+  $taxonomy{'by-package'}{'secondary'}{$package'} = $secchar;
+
+Scalar containing the secondary characterization.
+
+  $taxonomy{'by-package'}{'functionality'}{$package} = [ $bfi, $bfii, ...];
+
+List of functionalities.
+
+Both the characterizations and functionalites are themselves subdivided into
+levels by the string separator " > " (without the quotes). To make
+these information more accessible the data is presented in a reverse
+way, too:
+
+  $taxonomy{'by-taxonomy'}{'keyword'}{$keyword} = [ $pkg1, $pkg2, ...];
+
+List of packages with that keyword
+
+  $taxonomy{'by-taxonomy'}{'primary'}{$level1}{$level2}...{'_packages_'} = [ $pkg1, $pkg2, ...];
+  $taxonomy{'by-taxonomy'}{'secondary'}{$level1}{$level2}...{'_packages_'} = [ $pkg1, $pkg2, ...];
+  taxonomy{'by-taxonomy'}{'functionality'}{$level1}{$level2}...{'_packages_'} = [ $pkg1, $pkg2, ...];
+
+The B<_packages_> is literal and contains the list of packages for all the
+previous levels.
+
+The following code allows to read back the array into the hash referenced
+by C<$taxonomy> (attention, in this code this is a B<reference> to a hash!
+  my $taxonomy;
+  my $taxtext = `cat $path_to_data_dump`;
+  no strict "vars";
+  eval "$taxtext";
+  use strict "vars";
+  return $taxonomy;
+
+
+=head1 AUTHORS AND COPYRIGHT
+
+This script and its documentation were written for the TeX Live
+distribution (L<http://tug.org/texlive>) 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: #
-- 
cgit v1.2.3