summaryrefslogtreecommitdiff
path: root/Master/Tools/tpm-factory.pl
diff options
context:
space:
mode:
authorKarl Berry <karl@freefriends.org>2006-02-13 00:49:57 +0000
committerKarl Berry <karl@freefriends.org>2006-02-13 00:49:57 +0000
commit3f2df95b2fcba1a3e1987f6abf12599773a5bc52 (patch)
tree00e6e3e0a55fce3d2f6ac86e2de89183f574b84c /Master/Tools/tpm-factory.pl
parent045f872c421bb96d9e680ccd7f79c823cef10521 (diff)
move Master/Tools to Build/tools (delete)
git-svn-id: svn://tug.org/texlive/trunk@1515 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/Tools/tpm-factory.pl')
-rwxr-xr-xMaster/Tools/tpm-factory.pl643
1 files changed, 0 insertions, 643 deletions
diff --git a/Master/Tools/tpm-factory.pl b/Master/Tools/tpm-factory.pl
deleted file mode 100755
index 3e01e99689e..00000000000
--- a/Master/Tools/tpm-factory.pl
+++ /dev/null
@@ -1,643 +0,0 @@
-#!/usr/bin/env perl
-# $Id$
-# Public domain.
-#
-# TPM Build tool for TeXLive
-# Author: F. Popineau
-#
-# This file aims at automating tpm files maintenance
-# It's kind of a swiss-army knife so you can use it in several ways:
-#
-# Clean up a tpm file:
-# perl tpm-factory.pl --clean --name=Package/a0poster --patterns=auto
-# Clean up all Package (texmf-dist) tpm files
-# perl tpm-factory.pl --clean --type=Package --patterns=auto
-# perl tpm-factory.pl --clean --type=TLCore --patterns=from
-# The 'patterns' options tells to generate the files lists either
-# automatically (auto), from the patterns (from)
-# or to build patterns lists from files lists (to).
-# You can restrict the range of architectures with the --arch option.
-# By default --arch=all, but you can say --arch=win32,i386-linux too.
-#
-# Build a new tpm file from scratch:
-# perl tpm-factory.pl --new --name=Package/foo
-# This will build a new foo package, then you want to clean it up.
-#
-# Checking coverage:
-# perl tpm-factory.pl --check=cov --arch=all --type=Package
-# will check coverage inside the texmf-dist tree.
-#
-# Checking dependencies:
-# perl tpm-factory.pl --check=dep --arch=all --type=Package
-# will check dependencies inside the texmf-dist tree.
-#
-# Checking duplicates:
-# perl tpm-factory.pl --check=dup --arch=all --type=Package
-# will check duplicate file names inside the texmf-dist tree.
-#
-#
-
-BEGIN { # get our other local perl modules.
- ($mydir = $0) =~ s,/[^/]*$,,;
- unshift (@INC, $mydir);
-
- $mydir = "c:/source/TeXLive/Master/Tools"; # fabrice
- unshift (@INC, $mydir) if -d $mydir;
-}
-
-require "newgetopt.pl";
-use File::Basename;
-use Cwd;
-
-use FileUtils qw(canon_dir cleandir make_link newpath member
- normalize substitute_var_val dirname diff_list remove_list
- rec_rmdir sync_dir walk_dir start_redirection stop_redirection);
-use Tpm;
-
-File::Basename::fileparse_set_fstype('unix');
-
-use Strict;
-
-my $FtpDir = "c:/Inetpub/ftp/fptex";
-my $fpTeXVersion = "0.7";
-
-local $opt_check = 0;
-local $opt_ftp_dir = "${FtpDir}/${fpTeXVersion}";
-local $opt_arch;
-local $opt_log = 0;
-local $opt_verbose = 0;
-local $opt_tpm2zip = 0;
-local $opt_fixreq = 0;
-$opt_debug = 0; # global so Tpm.pm can access it.
-$opt_warnings = 0;
-
-# print "XML::Parser::VERSION = $XML::Parser::VERSION, XML::DOM::VERSION = $XML::DOM::VERSION\n";
-&main;
-
-1;
-
-sub help {
- print <<END_HELP;
-Usage: $ARGV[0] [OPTION]...
-
-Handle TPM (TeX package metadata) operations.
-
-Main operation (these targets are exclusive!):
- --tpm2zip build zip files out of a set of tpm files;
- --check=<(dep|cov)> check dependencies or coverage for the tpm files.
- --tpm_index rebuild the tpm.zip index file.
- --new create a new tpm file from scratch
- --clean clean up the tpm file
- --remove [--dry] remove the tpm file and all files it may reference
- [testing only]
- --patterns=(from|to|auto) fix one or more tpm files
- by automatically creating files lists,
- by expanding patterns to files lists,
- or regenerating patterns from files lists.
-
-Directories:
- --master_dir=<path> root directory of the TeX distribution
- [$opt_master_dir].
- --dest_dir=<path> destination directory for the zip files
- [$opt_ftp_dir].
- --ftp_dir=<path> directory for ftp results
- [$opt_ftp_dir].
-
-Packages:
- --name=<pattern> process only the files matching the pattern;
- --all process all package files;
- --standalone process only standalone package files;
- --arch=<(all|name)> process some or all architectures.
-
-Support commands:
- --log=<file name> log activity to file
- --debug turn on debug trace
- --verbose some more messages
- --warnings report empty fields Author, Version, ...
- --help displays this help text and exits
-END_HELP
-}
-
-sub build_zip {
- local ($tree,$tpmname) = @_;
- print "building zip of $tree/tpm/$tpmname\n" if ($opt_verbose);
- $tree =~ s@^$opt_master_dir/@@;
- my $tpm = Tpm->new("$tree/tpm/$tpmname");
-
- if ($opt_tpm2zip eq 'full') {
- $tpm->Tpm2Zip($opt_ftp_dir, 'full', $opt_standalone);
- }
- else {
- $tpm->Tpm2Zip($opt_ftp_dir, $opt_standalone);
- }
-}
-
-sub read_dependencies {
- local ($tree, $tpmname) = @_;
- $tree =~ s@^$opt_master_dir/@@;
- my $tpm = Tpm->new("$tree/tpm/$tpmname");
- my %requires = $tpm->getHash("Requires");
- my @reqlist = ();
- foreach my $k (keys %requires) {
- foreach my $e (@{$requires{$k}}) {
- my $f = ${Tpm::TexmfTreeOfType}{$k} . "/tpm/$e.tpm";
- if (-f "$opt_master_dir/$f") {
- push @reqlist, $f ;
- }
- else {
- push @{$wrong{"$tree/tpm/$tpmname"}}, "$f";
- }
- }
- }
- @{$req{"$tree/tpm/$tpmname"}} = @reqlist;
-# print "$tree$tpmname requires @reqlist\n";
-}
-
-sub collect_tpmfiles {
- local ($tree, $tpmname) = @_;
- $tree =~ s@^$opt_master_dir/@@;
- if ("texmf/tpm/$tpmname" !~ m@^${Tpm::IgnoredFiles}$@) {
- push @tpm_files, "$tree/tpm/$tpmname";
- }
-}
-
-sub do_tree {
- local ($tree, $fn) = @_;
- print " Directory $tree\n" if ($opt_verbose);
- while (<$tree/tpm/*.tpm>) {
- my $tpmname = $_;
- next if ($tpmname =~ m/~$/); # for emacs backups!
-# next if ($tree =~ /texmf$/ && $tpmname =~ m/xemtex/);
-# next if ($tpmname =~ m/-static/ && ! $opt_standalone);
- $tpmname =~ s@^${tree}/tpm/@@;
- print "Doing $tree/tpm/$tpmname\n" if ($opt_verbose);
- &{$fn}($tree, $tpmname);
- }
-}
-
-#
-# Check that every tpm package is required by another one at least
-#
-sub check_dependencies {
- local (%req, @tpm_files, %wrong);
- local ($s, $k, @l);
-
- foreach my $tree (@{Tpm::TexmfTrees}) {
- if (! -d "$opt_master_dir/$tree/tpm") {
- printf STDERR "$0: $tree/tpm is not a tpm subdirectory, skipping!\n";
- next;
- }
- $tree = "$opt_master_dir/$tree";
- &do_tree($tree, \&read_dependencies);
- &do_tree($tree, \&collect_tpmfiles);
- }
- # FIXME!!!
- if (-f "$opt_master_dir/texmf/tpm/scheme-full.tpm") {
- @l = ("texmf/tpm/scheme-full.tpm");
- }
- elsif (-f "$opt_master_dir/texmf/tpm/scheme-xemtex.tpm") {
- @l = ("texmf/tpm/scheme-xemtex.tpm");
- }
- else {
- die "No entry point, quitting...\n";
- }
- while ($#l >= 0) {
- my $p = pop @l;
-# if (! -f "$opt_master_dir/$p") {
-# push @wrong, $p;
-# }
-# else {
- &remove_list(\@tpm_files, "^" . $p . "\$");
- push @l, @{$req{$p}};
-# print "p = $p, l = @l\n";
-# }
- }
- print "***********************************\n";
- print "Wrong requirements: \n";
- print "***********************************\n";
- map { print "$_ (";
- map { print "$_ "; } @{$wrong{$_}};
- print ")\n"; } &FileUtils::sort_uniq(keys %wrong);
- print "\n";
- print "***********************************\n";
- print "Packages not required by anything: \n";
- print "***********************************\n";
- map { print "$_\n"; } @tpm_files;
- print "\n";
- print "***********************************\n";
-}
-
-sub collect_files {
- local ($d, @lf) = @_;
- my ($f);
- foreach $f (@lf) {
- my $path = "$d/$f";
- if (-f "$path") {
- $path =~ s@^${opt_master_dir}/@@;
- $path =~ s@\\@/@g;
- unless ($path =~ m/^${Tpm::IgnoredFiles}$/) {
- push @texmf_files, $path;
- #warn "accepted $path\n";
- } else {
- ; #warn "ignored $path\n";
- }
- }
- }
-}
-
-sub collect_coverage {
- local ($tree, $tpmname) = @_;
- if ("texmf/tpm/$tpmname" !~ m@^${Tpm::IgnoredFiles}$@) {
- my $tpm = Tpm->new("$tree/tpm/$tpmname");
- my @l = $tpm->getAllFileList();
- print "Pushing $#l files from $tree/tpm/$tpmname\n" if $opt_debug;
- push @tpm_files, @l;
- }
-}
-
-sub find_multiple {
- local (*files) = @_;
- my (@l) = sort(@files);
- my(@res, $e1, $e2);
- @files = ( );
- $e1 = pop(@l);
- while ($e1) {
- push @files, $e1;
- while (($e2 = pop(@l)) eq $e1) {
- push @res, $e2;
- }
- $e1 = $e2;
- }
- return @res;
-}
-
-#
-# Check that all files in tpm files exist
-# and that all files in the texmf tree
-# are requested by one tpm file.
-#
-sub check_coverage {
- local (@texmf_files, @tpm_files);
- my($s, @tree_list);
-
- if ($opt_type eq 'TLCore' || $opt_type eq 'all') {
- &walk_dir("$opt_master_dir/texmf", \&collect_files);
- &walk_dir("$opt_master_dir/bin", \&collect_files);
- &walk_dir("$opt_master_dir/xemtex", \&collect_files);
- &walk_dir("$opt_master_dir/source", \&collect_files);
- push @tree_list, "texmf";
- }
- if ($opt_type eq 'Package' || $opt_type eq 'all') {
- &walk_dir("$opt_master_dir/texmf-dist", \&collect_files);
- push @tree_list, "texmf-dist";
- }
- if ($opt_type eq 'Documentation' || $opt_type eq 'all') {
- &walk_dir("$opt_master_dir/texmf-doc", \&collect_files);
- push @tree_list, "texmf-doc";
- }
-
- foreach my $tree (@tree_list) {
- if (! -d "$opt_master_dir/$tree/tpm") {
- printf STDERR "$0: $tree/tpm is not a tpm subdirectory, skipping!\n";
- next;
- }
- $tree = "$opt_master_dir/$tree";
- &do_tree($tree, \&collect_coverage);
- }
-
- print "Found $#tpm_files files in tpm files.\n";
- local (@doublons) = find_multiple(\@tpm_files);
- print "*****************************************\n";
- print "Files found multiple times in tpm files :\n";
- map { print "$_\n"; } @doublons;
- print "*****************************************\n";
- local (@l1, @l2);
- &diff_list(\@texmf_files, \@tpm_files, \@l1, \@l2);
- print "*****************************************\n";
- print "Files in texmf tree not in tpm files :\n";
- map { print "$_\n"; } @l1;
- print "*****************************************\n";
- print "Files in tpm files not in texmf tree :\n";
- print "*****************************************\n";
- map { print "$_\n"; } @l2;
- print "*****************************************\n";
- print "With Regexp:\n";
- print "*****************************************\n";
-
- @l1 = &FileUtils::regexpify(1, $Tpm::MasterDir, @l1);
- @l2 = &FileUtils::regexpify(1, $Tpm::MasterDir, @l2);
- print "*****************************************\n";
- print "Files in texmf tree not in tpm files :\n";
- map { print "$_\n"; } (sort @l1);
- print "*****************************************\n";
- print "Files in tpm files not in texmf tree :\n";
- print "*****************************************\n";
- map { print "$_\n"; } (sort @l2);
- print "*****************************************\n";
-
-}
-
-sub compare_extensions {
- my ($ext1, $ext2);
-# print "a = $a, b = $b\n";
- $ext1 = $2 if ($a =~ m/^(.*)\.([^\.]*)$/);
- $ext2 = $2 if ($b =~ m/^(.*)\.([^\.]*)$/);
-# print "ext1 = $ext1, ext2 = $ext2 " . ($ext1 cmp $ext2) . "\n";
- if ($ext1 && $ext2) {
- return ($ext1 cmp $ext2);
- }
- elsif ($ext1) {
- return -1;
- }
- elsif ($ext2) {
- return 1;
- }
- else {
- return $a cmp $b;
- }
-}
-
-sub check_duplicates {
- local (@texmf_files);
- my %doublons;
-
- if ($opt_type eq 'TLCore' || $opt_type eq 'all') {
- &walk_dir("$opt_master_dir/texmf", \&collect_files);
- }
- if ($opt_type eq 'Package' || $opt_type eq 'all') {
- &walk_dir("$opt_master_dir/texmf-dist", \&collect_files);
- }
- if ($opt_type eq 'Documentation' || $opt_type eq 'all') {
- &walk_dir("$opt_master_dir/texmf-doc", \&collect_files);
- }
- map {
- push @{$doublons{&FileUtils::basename($_)}}, $_;
- } @texmf_files;
- for my $k (keys %doublons) {
- if ($#{$doublons{$k}} < 1) {
- delete $doublons{$k};
- }
- }
- for my $k (sort compare_extensions (keys %doublons)) {
- print "$k:\n";
- map {
- my $date, $size;
- my @t = stat("$opt_master_dir/" . $_);
- $size = $t[7]; $date = &Tpm::printdate($t[9]);
- print "\t$date\t$size\t$_\n"; } @{$doublons{$k}};
- }
-}
-
-sub clean_tpm {
- my @texmf_trees = () ;
- if ($opt_type eq 'all') {
- @texmf_trees = @{Tpm::TexmfTrees};
- }
- else {
- @texmf_trees = ( ${Tpm::TexmfTreeOfType}{$opt_type} );
- }
- map { print "tree = $_\n"; } @texmf_trees;
- foreach my $tree (@texmf_trees) {
- if (! -d "$opt_master_dir/$tree/tpm") {
- printf STDERR "$0: $tree/tpm is not a tpm subdirectory, skipping!\n";
- next;
- }
- $tree = "$opt_master_dir/$tree";
- &do_tree($tree, \&process_clean);
- }
-}
-
-sub process_clean {
- my ($tree, $tpmname) = @_;
- $tpmname .= ".tpm" if ($tpmname !~ m/\.tpm$/);
- my $tpm = Tpm->new("$tree/tpm/$tpmname");
- $tpm->Clean($opt_patterns, $opt_fixreq);
-}
-
-sub process_remove {
- my ($tree, $tpmname) = @_;
- $tpmname .= ".tpm" if ($tpmname !~ m/\.tpm$/);
- my $tpm = Tpm->new("$tree/tpm/$tpmname");
- $tpm->Remove($opt_patterns, $opt_dry);
-}
-
-sub main {
- # don't delay messages.
- $| = 1;
- select ((select (STDERR), $| = 1)[0]);
-
- unless (&NGetOpt ("tpm2zip:s",
- "clean",
- "patterns=s",
-# "edit=s",
- "tpm_dir=s",
- "ftp_dir=s",
- "master_dir=s",
- "dest_dir=s",
- "name=s",
- "arch=s",
- "check=s",
- "tpm_index",
- "type=s",
- "fixreq",
- "new",
- "remove",
- "dry",
- "standalone", "log=s",
- "verbose",
- "debug", "help"))
- {
- print STDERR "Try `$0 --help'.\n";
- exit 1;
- }
-
- if ($opt_help) {
- &help;
- exit 0;
- }
-
- if (($opt_name && $opt_type)
- || ($opt_type && $opt_standalone)
- || ($opt_type && $opt_standalone)) {
- print STDERR "$0: `--type', `standalone' and `--name' are mutually exclusive.\n";
- exit 1;
- }
-
- $opt_verbose = 1 if $opt_debug;
-
- $opt_arch = "all" if (! $opt_arch);
- if ($opt_arch =~ m/,/) {
- my @l = split ",", $opt_arch;
- map {
- if (!&member($_, @Tpm::ArchList)) {
- print STDERR "$0: $_ is not a valid architecture, aborting.\n";
- exit 1;
- }
- } @l;
- @Tpm::ArchList = @l;
- $opt_arch = 'all';
- }
-
- if ($opt_arch
- && !(($opt_arch eq "all")
- || &member($opt_arch, @Tpm::ArchList))) {
- print STDERR "$0: $opt_arch is neither `all' nor a valid architecture, aborting.\n";
- exit 1;
- }
-
- $Tpm::CurrentArch = $opt_arch;
-
-# if ($opt_standalone && ($opt_ftp_dir =~ m@/$fpTeXVersion$@)) {
-# $opt_ftp_dir =~ s@/$fpTeXVersion$@/standalone@;
-# }
-
- if ($opt_master_dir) {
- die "$0: !!!Error: Master dir $opt_master_dir is not a directory!\n" if (! -d $opt_master_dir);
- ${Tpm::MasterDir} = $opt_master_dir;
- }
- else {
- $opt_master_dir = ${Tpm::MasterDir};
- }
-
- if ($opt_ftp_dir) {
- die "$0: !!!Error: FTP dir $opt_ftp_dir is not a directory!\n" if (! -d $opt_ftp_dir);
- }
-
- if ($opt_log) {
- # $logfile = "$topdir\\win32\\$opt_log";
- if (! $opt_log =~ /\.log$/) {
- $opt_log .= ".log";
- }
- # start redirection if asked
- &start_redirection($opt_log);
- }
-
- if ($opt_tpm2zip eq '' || $opt_tpm2zip eq 'full') {
-
- if ($opt_type) {
- my @texmf_trees = () ;
- if ($opt_type eq 'all') {
- @texmf_trees = @{Tpm::TexmfTrees};
- }
- else {
- @texmf_trees = ( ${Tpm::TexmfTreeOfType}{$opt_type} );
- }
- foreach my $tree (@texmf_trees) {
- if (! -d "$opt_master_dir/$tree/tpm") {
- printf STDERR "$0: $tree/tpm is not a tpm subdirectory, skipping!\n";
- next;
- }
- $tree = "$opt_master_dir/$tree";
- &do_tree($tree, \&build_zip);
- }
- # Copy TeXSetup in due place
- my $src = "$opt_master_dir/bin/win32/TeXSetup.exe";
- my $dst = "$opt_ftp_dir/TeXSetup.exe";
- if (&FileUtils::newer($src, $dst) > 0) {
- &FileUtils::copy($src, $dst);
- }
-
- #
- # Rebuild tpm.zip file
- #
- unlink("${opt_ftp_dir}/tpm.zip");
- $cwd = &getcwd();
- chdir($opt_master_dir);
- open ZIP, "| zip -9\@or ${opt_ftp_dir}/tpm.zip > nul";
- foreach my $e (@{Tpm::TexmfTrees}) {
- while (<$e/tpm/*.tpm>) {
- print ZIP "$_\n" if (/\.tpm$/io);
- print "$_\n" if (/\.tpm$/io and $opt_verbose);
- }
- }
- close ZIP;
- chdir($cwd);
- print "File `${opt_ftp_dir}/tpm.zip' rebuilt.\n";
- }
- elsif ($opt_standalone) {
- print "Doing standalone ...\n";
- foreach $tpmname (@{Tpm::StandAlonePackages}) {
- $tpmname =~ m@^(.*)/(.*)$@;
- &build_zip(${Tpm::TexmfTreeOfType}{$1}, $2);
- }
- }
- elsif ($opt_name) {
- my ($tpmname, $tree);
- $opt_name =~ m@^([^/]*)/([^/]*)$@x;
- $tpmname = $2; $tree = ${Tpm::TexmfTreeOfType}{$1};
- $tpmname .= ".tpm" if ($tpmname !~ m/\.tpm$/);
- print "Doing $opt_master_dir/$tree/tpm/$tpmname\n";
- if (! -f "$opt_master_dir/$tree/tpm/$tpmname") {
- printf STDERR "$0: $opt_name non existent tpm file, aborting!\n";
- exit 1;
- }
- &build_zip($tree, $tpmname);
- }
- }
- elsif ($opt_tpm_index) {
- #
- # Rebuild tpm.zip file
- #
- unlink("${opt_ftp_dir}/tpm.zip");
- $cwd = &getcwd();
- chdir($opt_master_dir);
- open ZIP, "| zip -9\@or ${opt_ftp_dir}/tpm.zip > nul";
- foreach my $e (@{Tpm::TexmfTrees}) {
- while (<$e/tpm/*.tpm>) {
- print ZIP "$_\n" if (/\.tpm$/io);
- print "$_\n" if (/\.tpm$/io and $opt_verbose);
- }
- }
- close ZIP;
- chdir($cwd);
- print "File `${opt_ftp_dir}/tpm.zip' rebuilt.\n";
- }
- elsif ($opt_clean) {
- if ($opt_name) {
- $opt_name =~ m@^(.*)[/\\]([^/]*)$@x;
- my $tree = ${Tpm::TexmfTreeOfType}{$1};
- &process_clean($tree, $2);
- }
- elsif ($opt_type) {
- &clean_tpm;
- }
- }
-
- # Check coverage for packages: do the tpm files cover
- # the list of files in the texmf tree?
- elsif ($opt_check && $opt_check =~ m/^cov/) {
- print "Checking coverage:\n";
- $opt_arch = "all";
- &check_coverage;
- }
- # Check dependencies: are all the tpm packages required
- # by some other package?
- elsif ($opt_check && $opt_check =~ m/^dep/) {
- print "Checking dependencies:\n";
- &check_dependencies;
- }
- elsif ($opt_check && $opt_check =~ m/^dup/) {
- print "Checking duplicates:\n";
- &check_duplicates;
- }
- elsif ($opt_new) {
- if ($opt_name) {
- my $tpm = Tpm->fresh($opt_name);
- $tpm->Clean($opt_patterns, $opt_fixreq);
- }
- }
- elsif ($opt_remove) {
- if ($opt_name) {
- $opt_name =~ m@^(.*)[/\\]([^/]*)$@x;
- my $tree = ${Tpm::TexmfTreeOfType}{$1};
- my $name = $2;
- &process_remove($tree, $name);
- } else {
- warn "$0: need --name=Type/pkgname with --remove.\n";
- }
- }
-
- if ($opt_log) {
- &stop_redirection($opt_log)
- }
-}