diff options
author | Karl Berry <karl@freefriends.org> | 2019-12-06 18:28:03 +0000 |
---|---|---|
committer | Karl Berry <karl@freefriends.org> | 2019-12-06 18:28:03 +0000 |
commit | 2511e35cb7450757daaa32bd8929a38b115ec2cc (patch) | |
tree | a96662cf7787fc5c59b3bcbeb0baed497437df20 /Master/tlpkg/bin/archive | |
parent | 7204e2f11d2cb1b6f256e3dc1e1f3ef80ae144d3 (diff) |
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
Diffstat (limited to 'Master/tlpkg/bin/archive')
-rwxr-xr-x | Master/tlpkg/bin/archive/tl-fix-container-infos | 208 | ||||
-rwxr-xr-x | Master/tlpkg/bin/archive/tl-update-keywords | 309 |
2 files changed, 517 insertions, 0 deletions
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: # |