diff options
author | Karl Berry <karl@freefriends.org> | 2006-02-13 00:49:57 +0000 |
---|---|---|
committer | Karl Berry <karl@freefriends.org> | 2006-02-13 00:49:57 +0000 |
commit | 3f2df95b2fcba1a3e1987f6abf12599773a5bc52 (patch) | |
tree | 00e6e3e0a55fce3d2f6ac86e2de89183f574b84c /Master/Tools/tpm-factory.pl | |
parent | 045f872c421bb96d9e680ccd7f79c823cef10521 (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-x | Master/Tools/tpm-factory.pl | 643 |
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) - } -} |