summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--new-infra/README22
-rwxr-xr-xnew-infra/create-tlsrc-from-tpm.pl270
-rwxr-xr-xnew-infra/read-tpm-dump-tpl.pl307
-rw-r--r--new-infra/specification.txt58
-rw-r--r--new-infra/tlsrc/baz.tlsrc9
-rw-r--r--new-infra/tlsrc2tlp.pl361
6 files changed, 924 insertions, 103 deletions
diff --git a/new-infra/README b/new-infra/README
index a9bf24e9029..be08e705e5c 100644
--- a/new-infra/README
+++ b/new-infra/README
@@ -1,19 +1,33 @@
A short example implementation
+status 2007-05-13
current status:
- tlsrc -> tlp conversion
Implemented:
. auto generation of packages in texmf-dist according to their
- leaf directory name
+ directory name
. package version based on the maximum of all package file
last changed revision number of subversion
Missing:
- . currently at auto generation time all the files are put into
- the runfiles section instead of doc in docfiles etc ...
. update/inclusion of information from the catalogue
. missing source keys?
- . efficient procedures
. ???
+
+ I have generated tlsrc files for all texmf-dist/tpm/*.tpm files containing
+ only the name, executes, and depends, and from these I generated tlp files
+ The automatic procedure works quiet well:
+ tlsrc files with manual patterns: 16
+ buggy packages: 22
+ Buggy packages are packages where the files currently in the tpm and
+ those in the generated tlp differ. (one package is probably a false error:
+ arabxetex)
+
+ The list of tlsrc files which had to be adjusted is (not surpising):
+ bibtex, context, dvips, fontinst, groff, lambda, latex, makeindex,
+ metafont, metapost, mex, mft, omega, plain, tex4ht, xetex
+
+ Generation time on my small laptop for all texmf-dist tlp is around 40sec
+
- tlp -> tldb conversion
Implemented:
. just do it, trivial, cat $i, echo "" ...
diff --git a/new-infra/create-tlsrc-from-tpm.pl b/new-infra/create-tlsrc-from-tpm.pl
new file mode 100755
index 00000000000..ca842a5892f
--- /dev/null
+++ b/new-infra/create-tlsrc-from-tpm.pl
@@ -0,0 +1,270 @@
+#!/usr/bin/perl
+#
+# tpm2deb-source.pl
+# machinery to create debian packages from TeX Live depot
+# (c) 2005, 2006 Norbert Preining
+#
+# $Id: tpm2deb-source.pl 2691 2007-04-16 09:42:22Z frank $
+#
+# configuration is done via the file tpm2deb.cfg
+#
+
+use strict;
+no strict 'refs';
+# use warnings;
+# no warnings 'uninitialized';
+
+my $opt_master;
+our $opt_debug;
+our $opt_nosrcpkg;
+our $opt_noremove;
+my $globalreclevel;
+my $oldsrcdir;
+my $datadump ;
+
+BEGIN {
+ my $upstream_modules = "/usr/share/tex-common/";
+ unshift (@INC, "./all/debian");
+ unshift (@INC, $upstream_modules);
+}
+
+my ($mydir,$mmydir);
+($mydir = $0) =~ s,/[^/]*$,,;
+if ($mydir eq $0) { $mydir = `pwd` ; chomp($mydir); }
+if (!($mydir =~ m,/.*,,)) { $mmydir = `pwd`; chomp($mmydir); $mydir = "$mmydir/$mydir" ; }
+
+
+# $opt_master = "./LocalTPM";
+$opt_debug = 0;
+$opt_nosrcpkg = 0;
+$opt_noremove = 0;
+$globalreclevel = 1;
+$oldsrcdir = "./src";
+$datadump = "tpm.data";
+
+use Getopt::Long;
+# use Data::Dumper;
+
+#use Strict;
+use File::Basename;
+use File::Copy;
+use File::Path;
+use File::Temp qw/ tempfile tempdir /;
+use Storable;
+## not needed, atm we are calling eperl binary use Parse::ePerl;
+#use XML::DOM;
+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;
+#
+# Configuration for destination of files
+# DONT USER DOUBLE QUOTES; THESE VARIABLES HAVE TO GET REEVALUATED
+# AFTER $tmpdir IS SET!!
+#
+my $changelog = "";
+my $changelogversion = "";
+my $changelogextraversion = "";
+my $changelogrevision = "";
+my $changelogdistribution = "";
+my $allowed_dists = "(unstable|UNRELEASED|sarge-backports|etch-backports|stable-security|experimental)";
+
+
+our $Master;
+our %TpmData;
+
+$Master = `pwd`;
+chomp($Master);
+my $TpmGlobalPath = $Master;
+my $DataGlobalPath = $Master;
+
+unshift (@INC, "$Master/../Build/tools");
+File::Basename::fileparse_set_fstype('unix');
+
+
+use Getopt::Long;
+use File::Basename;
+use File::Copy;
+use File::Path;
+use File::Temp qw/ tempfile tempdir /;
+use Storable;
+use Cwd;
+use Tpm;
+
+our (%TeXLive);
+our (%Config,%TpmData);
+our %TexmfTreeOfType = ( "TLCore" => "texmf",
+ "Documentation" => "texmf-doc",
+ "Package" => "texmf-dist");
+our @TpmCategories = keys %TexmfTreeOfType;
+our %TypeOfTexmfTree = reverse %TexmfTreeOfType;
+
+# pre set $opt_master to ./LocalTPM which contains also the Tools dir
+# this is set in the main script, and changed with commandline option.
+# should it maybe be deleted here?
+
+my $opt_debug;
+my $opt_onlyscripts;
+
+sub populate_TpmData_from_dump {
+ my $datafile = $_[0];
+ my $tpmdataref = retrieve($datafile);
+ %TpmData = %{$tpmdataref};
+}
+
+sub load_collection_tpm_data {
+ # local functions
+ sub trim {
+ my ($str) = @_;
+ $str =~ s/^[\n\s]+//;
+ $str =~ s/[\n\s]+$//;
+ return $str;
+ }
+ sub get_requires {
+ my ($tpm,$type) = @_;
+ my %requires = $tpm->getHash("Requires");
+ my @keylist = keys %requires;
+ my @tlcorereqlist = ();
+ my @packagereqlist = ();
+ if ($type eq '') {
+ $type = "all";
+ }
+ foreach my $k (keys %requires) {
+ foreach my $e (@{$requires{$k}}) {
+ # manually exclude Windows-only packages
+ if ($e eq "bin-bzip2") {}
+ elsif ($e eq "bin-xpdf") {}
+ elsif ($e eq "bin-chktex") {}
+ elsif ($e eq "bin-ghostscript") {}
+ elsif ($e eq "bin-gzip") {}
+ elsif ($e eq "bin-jpeg2ps") {}
+ elsif ($e eq "bin-perl") {}
+ elsif ($e eq "bin-windvi") {}
+ elsif ($e eq "lib-freetype2") {}
+ elsif ($e eq "lib-gd") {}
+ elsif ($e eq "lib-geturl") {}
+ elsif ($e eq "lib-gnu") {}
+ elsif ($e eq "lib-gs") {}
+ elsif ($e eq "lib-jpeg") {}
+ elsif ($e eq "lib-md5") {}
+ elsif ($e eq "lib-png") {}
+ elsif ($e eq "lib-regex") {}
+ elsif ($e eq "lib-texmfmp") {}
+ elsif ($e eq "lib-tiff") {}
+ elsif ($e eq "lib-ttf") {}
+ elsif ($e eq "lib-xpdf") {}
+ elsif ($e eq "lib-xpm") {}
+ elsif ($e eq "lib-zlib") {}
+ elsif ($e =~ /^bin-(.*)$/) {
+ push @packagereqlist, "$k/$e";
+ }
+ elsif ($e =~ /^hyphen-(.*)$/){
+ push @packagereqlist, "$k/$e";
+ }
+ elsif ($k eq "TLCore") {
+ push @tlcorereqlist, "$k/$e";
+ } else {
+ push @packagereqlist, "$k/$e";
+ }
+ }
+ }
+ if ($type eq '' || $type eq 'all') {
+ my %foo;
+ $foo{'TLCore'} = \@tlcorereqlist;
+ $foo{'Package'} = \@packagereqlist;
+ #my @foo=(@tlcorereqlist,@packagereqlist);
+ #return(@foo);
+ return(\%foo);
+ } elsif ($type eq 'TLCore') {
+ return(@tlcorereqlist);
+ } elsif ($type eq 'Package') {
+ return(@packagereqlist);
+ } else {
+ die("Don't know this type: $type!\n");
+ }
+ }
+ # start of real function
+ print "Start loading tpm data ... \n";
+ foreach my $t ('TLCore', 'Documentation', 'Package') {
+ my $subtree = ${TexmfTreeOfType}{$t};
+ foreach my $f (<$Master/$subtree/tpm/*.tpm>) {
+ print "Working on $f\n";
+ my $shortn = basename($f);
+ $shortn =~ s,\.tpm$,,;
+ if (($t eq 'TLCore') && ($shortn =~ m/^scheme-/)) { next ; }
+ my $tpm = Tpm->new("$subtree/tpm/$shortn.tpm");
+ $TpmData{$t}{$shortn}{'BinFiles'} = [ $tpm->getFileList("BinFiles") ];
+ $TpmData{$t}{$shortn}{'DocFiles'} = [ $tpm->getFileList("DocFiles") ];
+ $TpmData{$t}{$shortn}{'RunFiles'} = [ $tpm->getFileList("RunFiles") ];
+ $TpmData{$t}{$shortn}{'SourceFiles'} = [ $tpm->getFileList("SourceFiles") ];
+ $TpmData{$t}{$shortn}{'RemoteFiles'} = [ $tpm->getFileList("RemoteFiles") ];
+ $TpmData{$t}{$shortn}{'Title'} = trim($tpm->getAttribute("Title"));
+ # print "got title $TpmData{$t}{$shortn}{'Title'}\n";
+ $TpmData{$t}{$shortn}{'Description'} = trim($tpm->getAttribute("Description"));
+ $TpmData{$t}{$shortn}{'License'} = trim($tpm->getAttribute("License"));
+ my @foo = $tpm->getList("Installation");
+ $TpmData{$t}{$shortn}{'Installation'} = \@foo ;
+ my $alldeps = get_requires($tpm,'all');
+ my @incs = @{$alldeps->{'Package'}};
+ my @deps = @{$alldeps->{'TLCore'}};
+ $TpmData{$t}{$shortn}{'Package'} = \@incs;
+ $TpmData{$t}{$shortn}{'TLCore'} = \@deps;
+ }
+ }
+ print " ... done\n";
+}
+
+sub create_tlsrc_files {
+ print "Creating tlsrc files TpmData\n\n";
+ #foreach my $t ('TLCore', 'Documentation', 'Package') {
+ foreach my $t ('Package') {
+ print "Creating tlsrc for $t:\n";
+ my %foo = %{$TpmData{$t}};
+ foreach my $p (keys %foo) {
+ open (FOO,">tlsrc/$p.tlsrc") || die("Cannot open tlsrc/$p.tlsrc!");
+ print FOO "name $p\n";
+ foreach my $foo (@{$TpmData{$t}{$p}{'Package'}}) {
+ print FOO "depend $foo\n";
+ }
+ foreach my $foo (@{$TpmData{$t}{$p}{'TLCore'}}) {
+ print FOO "depend $foo\n";
+ }
+ foreach my $ex (@{$TpmData{$t}{$p}{'Installation'}}) {
+ my %foo = %{$ex};
+ print FOO "execute $foo{'function'} $foo{'mode'} $foo{'parameter'}\n";
+ }
+ close(FOO);
+ }
+ }
+}
+
+
+&main(@ARGV);
+
+1;
+
+# variables needed outside of main
+my $version;
+my $revision;
+my $extraversion;
+my $date;
+my $arch;
+my $shortl;
+
+sub main {
+ ${Tpm::MasterDir} = $TeXLive{'all'}{'tpm_global_path'};
+ $arch = "all";
+ ${Tpm::CurrentArch} = "i386-linux";
+ ${Tpm::MasterDir} = $Master;
+ load_collection_tpm_data();
+ create_tlsrc_files();
+}
+
+
+### Local Variables:
+### perl-indent-level: 4
+### tab-width: 4
+### indent-tabs-mode: t
+### End:
+# vim:set tabstop=4: #
diff --git a/new-infra/read-tpm-dump-tpl.pl b/new-infra/read-tpm-dump-tpl.pl
new file mode 100755
index 00000000000..892b40a4529
--- /dev/null
+++ b/new-infra/read-tpm-dump-tpl.pl
@@ -0,0 +1,307 @@
+#!/usr/bin/perl
+#
+# tpm2deb-source.pl
+# machinery to create debian packages from TeX Live depot
+# (c) 2005, 2006 Norbert Preining
+#
+# $Id: tpm2deb-source.pl 2691 2007-04-16 09:42:22Z frank $
+#
+# configuration is done via the file tpm2deb.cfg
+#
+
+use strict;
+no strict 'refs';
+# use warnings;
+# no warnings 'uninitialized';
+
+my $opt_master;
+our $opt_debug;
+our $opt_nosrcpkg;
+our $opt_noremove;
+my $globalreclevel;
+my $oldsrcdir;
+my $datadump ;
+
+BEGIN {
+ my $upstream_modules = "/usr/share/tex-common/";
+ unshift (@INC, "./all/debian");
+ unshift (@INC, $upstream_modules);
+}
+
+my ($mydir,$mmydir);
+($mydir = $0) =~ s,/[^/]*$,,;
+if ($mydir eq $0) { $mydir = `pwd` ; chomp($mydir); }
+if (!($mydir =~ m,/.*,,)) { $mmydir = `pwd`; chomp($mmydir); $mydir = "$mmydir/$mydir" ; }
+
+
+# $opt_master = "./LocalTPM";
+$opt_debug = 0;
+$opt_nosrcpkg = 0;
+$opt_noremove = 0;
+$globalreclevel = 1;
+$oldsrcdir = "./src";
+$datadump = "tpm.data";
+
+use Getopt::Long;
+# use Data::Dumper;
+
+#use Strict;
+use File::Basename;
+use File::Copy;
+use File::Path;
+use File::Temp qw/ tempfile tempdir /;
+use Storable;
+## not needed, atm we are calling eperl binary use Parse::ePerl;
+#use XML::DOM;
+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;
+#
+# Configuration for destination of files
+# DONT USER DOUBLE QUOTES; THESE VARIABLES HAVE TO GET REEVALUATED
+# AFTER $tmpdir IS SET!!
+#
+my $changelog = "";
+my $changelogversion = "";
+my $changelogextraversion = "";
+my $changelogrevision = "";
+my $changelogdistribution = "";
+my $allowed_dists = "(unstable|UNRELEASED|sarge-backports|etch-backports|stable-security|experimental)";
+
+
+our $Master;
+our %TpmData;
+
+$Master = `pwd`;
+chomp($Master);
+my $TpmGlobalPath = $Master;
+my $DataGlobalPath = $Master;
+
+unshift (@INC, "$Master/../Build/tools");
+File::Basename::fileparse_set_fstype('unix');
+
+
+use Getopt::Long;
+use File::Basename;
+use File::Copy;
+use File::Path;
+use File::Temp qw/ tempfile tempdir /;
+use Storable;
+use Cwd;
+use Tpm;
+
+our (%TeXLive);
+our (%Config,%TpmData);
+our %TexmfTreeOfType = ( "TLCore" => "texmf",
+ "Documentation" => "texmf-doc",
+ "Package" => "texmf-dist");
+our @TpmCategories = keys %TexmfTreeOfType;
+our %TypeOfTexmfTree = reverse %TexmfTreeOfType;
+
+# pre set $opt_master to ./LocalTPM which contains also the Tools dir
+# this is set in the main script, and changed with commandline option.
+# should it maybe be deleted here?
+
+my $opt_debug;
+my $opt_onlyscripts;
+
+sub populate_TpmData_from_dump {
+ my $datafile = $_[0];
+ my $tpmdataref = retrieve($datafile);
+ %TpmData = %{$tpmdataref};
+}
+
+sub load_collection_tpm_data {
+ # local functions
+ sub trim {
+ my ($str) = @_;
+ $str =~ s/^[\n\s]+//;
+ $str =~ s/[\n\s]+$//;
+ return $str;
+ }
+ sub get_requires {
+ my ($tpm,$type) = @_;
+ my %requires = $tpm->getHash("Requires");
+ my @keylist = keys %requires;
+ my @tlcorereqlist = ();
+ my @packagereqlist = ();
+ if ($type eq '') {
+ $type = "all";
+ }
+ foreach my $k (keys %requires) {
+ foreach my $e (@{$requires{$k}}) {
+ # manually exclude Windows-only packages
+ if ($e eq "bin-bzip2") {}
+ elsif ($e eq "bin-xpdf") {}
+ elsif ($e eq "bin-chktex") {}
+ elsif ($e eq "bin-ghostscript") {}
+ elsif ($e eq "bin-gzip") {}
+ elsif ($e eq "bin-jpeg2ps") {}
+ elsif ($e eq "bin-perl") {}
+ elsif ($e eq "bin-windvi") {}
+ elsif ($e eq "lib-freetype2") {}
+ elsif ($e eq "lib-gd") {}
+ elsif ($e eq "lib-geturl") {}
+ elsif ($e eq "lib-gnu") {}
+ elsif ($e eq "lib-gs") {}
+ elsif ($e eq "lib-jpeg") {}
+ elsif ($e eq "lib-md5") {}
+ elsif ($e eq "lib-png") {}
+ elsif ($e eq "lib-regex") {}
+ elsif ($e eq "lib-texmfmp") {}
+ elsif ($e eq "lib-tiff") {}
+ elsif ($e eq "lib-ttf") {}
+ elsif ($e eq "lib-xpdf") {}
+ elsif ($e eq "lib-xpm") {}
+ elsif ($e eq "lib-zlib") {}
+ elsif ($e =~ /^bin-(.*)$/) {
+ push @packagereqlist, "$k/$e";
+ }
+ elsif ($e =~ /^hyphen-(.*)$/){
+ push @packagereqlist, "$k/$e";
+ }
+ elsif ($k eq "TLCore") {
+ push @tlcorereqlist, "$k/$e";
+ } else {
+ push @packagereqlist, "$k/$e";
+ }
+ }
+ }
+ if ($type eq '' || $type eq 'all') {
+ my %foo;
+ $foo{'TLCore'} = \@tlcorereqlist;
+ $foo{'Package'} = \@packagereqlist;
+ #my @foo=(@tlcorereqlist,@packagereqlist);
+ #return(@foo);
+ return(\%foo);
+ } elsif ($type eq 'TLCore') {
+ return(@tlcorereqlist);
+ } elsif ($type eq 'Package') {
+ return(@packagereqlist);
+ } else {
+ die("Don't know this type: $type!\n");
+ }
+ }
+ # start of real function
+ print "Start loading tpm data ... \n";
+ foreach my $t ('TLCore', 'Documentation', 'Package') {
+ my $subtree = ${TexmfTreeOfType}{$t};
+ foreach my $f (<$Master/$subtree/tpm/*.tpm>) {
+ print "Working on $f\n";
+ my $shortn = basename($f);
+ $shortn =~ s,\.tpm$,,;
+ if (($t eq 'TLCore') && ($shortn =~ m/^scheme-/)) { next ; }
+ my $tpm = Tpm->new("$subtree/tpm/$shortn.tpm");
+ $TpmData{$t}{$shortn}{'BinFiles'} = [ $tpm->getFileList("BinFiles") ];
+ $TpmData{$t}{$shortn}{'DocFiles'} = [ $tpm->getFileList("DocFiles") ];
+ $TpmData{$t}{$shortn}{'RunFiles'} = [ $tpm->getFileList("RunFiles") ];
+ $TpmData{$t}{$shortn}{'SourceFiles'} = [ $tpm->getFileList("SourceFiles") ];
+ $TpmData{$t}{$shortn}{'RemoteFiles'} = [ $tpm->getFileList("RemoteFiles") ];
+ $TpmData{$t}{$shortn}{'Title'} = trim($tpm->getAttribute("Title"));
+ # print "got title $TpmData{$t}{$shortn}{'Title'}\n";
+ $TpmData{$t}{$shortn}{'Description'} = trim($tpm->getAttribute("Description"));
+ $TpmData{$t}{$shortn}{'License'} = trim($tpm->getAttribute("License"));
+ my @foo = $tpm->getList("Installation");
+ $TpmData{$t}{$shortn}{'Installation'} = \@foo ;
+ my $alldeps = get_requires($tpm,'all');
+ my @incs = @{$alldeps->{'Package'}};
+ my @deps = @{$alldeps->{'TLCore'}};
+ $TpmData{$t}{$shortn}{'Package'} = \@incs;
+ $TpmData{$t}{$shortn}{'TLCore'} = \@deps;
+ }
+ }
+ print " ... done\n";
+}
+
+sub dump_tpm_data {
+ print "Dumping TpmData\n\n";
+ #foreach my $t ('TLCore', 'Documentation', 'Package') {
+ foreach my $t ('Package') {
+ print "Dumping $t:\n";
+ my %foo = %{$TpmData{$t}};
+ foreach my $p (keys %foo) {
+ open (FOO,">tlptpm/$p.tlp") || die("Cannot open tlptpm/$p.tpmtlp!");
+ print FOO "name $p\n";
+ foreach my $foo (@{$TpmData{$t}{$p}{'Package'}}) {
+ print FOO "depend $foo\n";
+ }
+ foreach my $ex (@{$TpmData{$t}{$p}{'Installation'}}) {
+ my %foo = %{$ex};
+ print FOO "execute $foo{'function'} $foo{'mode'} $foo{'parameter'}\n";
+ }
+ foreach my $foo (@{$TpmData{$t}{$p}{'TLCore'}}) {
+ print FOO "depend $foo\n";
+ }
+ my @foo;
+ @foo = @{$TpmData{$t}{$p}{'DocFiles'}};
+ if ($#foo >= 0) {
+ print FOO "docfiles\n";
+ foreach my $foo (sort @foo) {
+ print FOO " $foo\n";
+ }
+ }
+ @foo = @{$TpmData{$t}{$p}{'SourceFiles'}};
+ if ($#foo >= 0) {
+ print FOO "srcfiles\n";
+ foreach my $foo (sort @foo) {
+ print FOO " $foo\n";
+ }
+ }
+ @foo = @{$TpmData{$t}{$p}{'BinFiles'}};
+ if ($#foo >= 0) {
+ print FOO "binfiles\n";
+ foreach my $foo (sort @foo) {
+ print FOO " $foo\n";
+ }
+ }
+ @foo = @{$TpmData{$t}{$p}{'RunFiles'}};
+ if ($#foo >= 1) {
+ print FOO "runfiles\n";
+ foreach my $foo (sort @foo) {
+ if ($foo =~ /.*\.tpm$/) { next; }
+ print FOO " $foo\n";
+ }
+ }
+ @foo = @{$TpmData{$t}{$p}{'RemoteFiles'}};
+ if ($#foo >= 0) {
+ print FOO "remotefiles\n";
+ foreach my $foo (sort @foo) {
+ print FOO " $foo\n";
+ }
+ }
+ close(FOO);
+ }
+ }
+}
+
+
+&main(@ARGV);
+
+1;
+
+# variables needed outside of main
+my $version;
+my $revision;
+my $extraversion;
+my $date;
+my $arch;
+my $shortl;
+
+sub main {
+ ${Tpm::MasterDir} = $TeXLive{'all'}{'tpm_global_path'};
+ $arch = "all";
+ ${Tpm::CurrentArch} = "i386-linux";
+ ${Tpm::MasterDir} = $Master;
+ load_collection_tpm_data();
+ dump_tpm_data();
+}
+
+
+### Local Variables:
+### perl-indent-level: 4
+### tab-width: 4
+### indent-tabs-mode: t
+### End:
+# vim:set tabstop=4: #
diff --git a/new-infra/specification.txt b/new-infra/specification.txt
index e1e393ada26..57c66d2cb09 100644
--- a/new-infra/specification.txt
+++ b/new-infra/specification.txt
@@ -28,19 +28,59 @@ catalogue
name of the respective Catalogue entry, if missing, same as name
(run|src|doc|bin)pattern
+ (cheap/expensive means working time)
+
+ current status:
+ TYPE PAT
+ TYPE = d f t
+ t word1 ... wordN wordL
+ include all files below all dirs of the form
+ word1/.../wordN/.../wordL/...
+ (cheap)
+ d regexp
+ include all files in directory mathing regexp
+ (expensive)
+ f regexp
+ include all files matching regexp
+ (expensive)
+
+ new idea???
list of pattern of the form
TYPE PAT
where
- TYPE = d f
+ TYPE = d f t r
and PAT is a free text
- if there is a line
- pattern d texmf-dist/.*/foobar
- then all files in leaf directories named foobar under texmf-dist
- are included
- a line
- pattern f bin/${ARCH}/.*${EXT}
- includes all files which are in bin/$ARCH/ and have extension ${EXT}
- where ARCH and EXT are expanded by the tlsrc interpreter
+
+ t word1 ... wordN wordL
+ include all files below all dirs of the form
+ word1/.../wordN/.../wordL/...
+ (cheap)
+
+ d string
+ include all files below the directory d (now expansion at all)
+ (should we add glob expansion?)
+ (cheap, with glob I don't know)
+
+ f string
+ include file string
+ (should we add glob expansion?)
+ (cheap, with glob I don't know)
+
+ r regexp
+ includes all files which are matched by regexp
+ (expensive)
+
+ Note that if one of the patterns section is empty an entry
+ is automatically generated:
+ for runpatterns:
+ t texmf-dist topdir $tlp
+ (with topdir = bibtex, context, ... see tlsrc2tlp.pl)
+ for docpatterns:
+ t texmf-dist doc $tlp
+ for srcpatterns:
+ t texmf-dist source $tlp
+ for binpatterns:
+ NONE!!
execute free form
is taken one to one into the tlp file
diff --git a/new-infra/tlsrc/baz.tlsrc b/new-infra/tlsrc/baz.tlsrc
new file mode 100644
index 00000000000..eb838c4cc27
--- /dev/null
+++ b/new-infra/tlsrc/baz.tlsrc
@@ -0,0 +1,9 @@
+name baz
+shortdesc the baz package
+longdesc the baz
+depend othercoll
+depend another collection
+depend foo
+runpattern t texmf-dist baz
+docpattern t texmf-doc baz
+srcpattern t texmf baz
diff --git a/new-infra/tlsrc2tlp.pl b/new-infra/tlsrc2tlp.pl
index 101d20d2146..f05210226eb 100644
--- a/new-infra/tlsrc2tlp.pl
+++ b/new-infra/tlsrc2tlp.pl
@@ -13,14 +13,36 @@ my %tls;
my %tldb;
my $opt_debug = 0;
my %AllFiles;
+my %DirNames;
+my %FilesOfDir;
+my %SubdirsOfDir;
+my $statusfile = "";
my $tlpline;
+my $DirTree = { };
+
+use Getopt::Long;
+GetOptions("debug!" => \$opt_debug, "statusfile=s" => \$statusfile);
+
&main(@ARGV);
1;
+sub dirname {
+ my ($f) = @_;
+ if ($f =~ m@(^.*)[\\/][^\\/]*$@) {
+ return $1;
+ } else {
+ return ".";
+ }
+}
+sub basename {
+ my ($f) = @_;
+ $f =~ m@([^\\/]*)$@;
+ return $1;
+}
sub main {
@@ -31,18 +53,34 @@ sub main {
initialize_all_files();
my $ts = $#tlsrc + 1;
my $fs = 0;
+ $| = 1;
foreach my $f (keys %tls) {
+ print ".";
$fs++;
- if ($fs/10 == int($fs/10)) { print "$fs from $ts\n"; }
+ if ($fs/100 == int($fs/100)) { print "$fs from $ts\n"; }
generate_tlp_data($f);
write_tlp_file($f);
}
#foreach my $f (keys %tldb) {
# write_tlp_file($f);
#}
+ my @notused = ();
+ my @multiused = ();
+ my @tmp;
foreach my $f (keys %AllFiles) {
- if ($AllFiles{$f}{'used'} != 1) {
- print STDERR "Not covered file: $f\n";
+ @tmp = @{$AllFiles{$f}{'used'}};
+ if ($#tmp < 0) { push @notused, $f; }
+ if ($#tmp >= 1) { push @multiused, $f; }
+ }
+ if ($#notused >= 0) { print "NOT COVERED FILES:\n"; }
+ foreach my $f (sort @notused) {
+ print STDERR "$f\n";
+ }
+ if ($#multiused >= 0) { print "MULTIPLE INCLUDED FILES:\n"; }
+ foreach my $f (sort @multiused) {
+ print STDERR "$f\n";
+ foreach (@{$AllFiles{$f}{'used'}}) {
+ print " $_\n";
}
}
}
@@ -174,45 +212,101 @@ sub read_tlsrc_file {
}
sub initialize_all_files {
- foreach my $l (`svn status -v`) {
+ my @lines;
+ if (-r "$statusfile") {
+ logit("Reading svn status from $statusfile\n");
+ open(FOO,"$statusfile") || die("Cannot open statusfile $statusfile");
+ @lines = <FOO>;
+ close(FOO);
+ } else {
+ logit("Reading svn status from svn status -v\n");
+ @lines = `svn status -v`;
+ }
+ foreach my $l (@lines) {
chomp($l);
next if ($l =~ /^\?/); # ignore files not under version control
if ($l =~ /^(.)(.)(.)(.)(.)(.)..\s*(\d+)\s+(\d+)\s+\w+\s+(.+)$/) {
my $lastchanged = $8;
my $entry = "$9";
- next if -d $entry;
- $AllFiles{$entry}{'used'} = 0;
+ next if -d $entry; # TODO: what to do with links???
+ @{$AllFiles{$entry}{'used'}} = ();
$AllFiles{$entry}{'lastchangedrev'} = $lastchanged;
+ my $fn = basename($entry);
+ my $dn = dirname($entry);
+ add_path_to_tree($DirTree, split("[/\\\\]", $dn));
+ push @{$FilesOfDir{$dn}}, $fn;
} else {
die("Cannot read svn status output line: $l");
}
}
+ # now do some magic
+ # - create list of top level dirs with a list of full path names of
+ # the respective dir attached
+ # MISSING
+ #print_tree($DirTree);
+ walk_tree($DirTree, \&find_alldirs);
+}
+
+sub print_tree {
+ my ($node) = @_;
+ &walk_tree($node, \&print_node);
+}
+
+sub find_alldirs {
+ my ($node, @stackdir) = @_;
+ my $tl = $stackdir[-1];
+ push @{$DirNames{$tl}}, join("/", @stackdir);
+ if (keys(%{$node})) {
+ my $pa = join("/", @stackdir);
+ push @{$SubdirsOfDir{$pa}}, keys(%{$node});
+ }
+}
+
+sub print_node {
+ my ($node, @stackdir) = @_;
+ my $dp = join("/", @stackdir);
+ if ($FilesOfDir{$dp}) {
+ foreach my $f (@{$FilesOfDir{$dp}}) {
+ print "dp=$dp file=$f\n";
+ }
+ }
+ if (! keys(%{$node})) {
+ print join("/", @stackdir) . "\n";
+ }
+}
+
+sub walk_tree {
+ my (@stack_dir);
+ walk_tree1(@_, @stack_dir);
+}
+
+sub walk_tree1 {
+ my ($node, $pre_proc, $post_proc, @stack_dir) = @_;
+ my $v;
+ for my $k (keys(%{$node})) {
+ push @stack_dir, $k;
+ $v = $node->{$k};
+ if ($pre_proc) { &{$pre_proc}($v, @stack_dir) }
+ walk_tree1 (\%{$v}, $pre_proc, $post_proc, @stack_dir);
+ $v = $node->{$k};
+ if ($post_proc) { &{$post_proc}($v, @stack_dir) }
+ pop @stack_dir;
+ }
}
-#
-# possible optimizations:
-# - compile perl regexps once at the beginning before entering the big loop
-# in the loop mega action
-#
sub generate_tlp_data {
my ($tlp) = @_;
- # predefined runpattern if all are missing
- # WARNING
- # Note that this will NOT NOT NOT find files in leaf directories named
- # after the package but OUTSIDE texmf-dist, so files in
- # texmf-doc/..../packagename/
- # will NOT be found.
- if (!(defined($tls{$tlp}{'runpatterns'}))) {
- my $l = "d texmf-dist/(bibtex|context|dvips|fonts|makeindex|metafont|metapost|mft|omega|scripts|tex|tex4ht|vtex)/.*/$tlp";
- @{$tls{$tlp}{'runpatterns'}} = ("$l");
- }
- if (!(defined($tls{$tlp}{'docpatterns'}))) {
- my $l = "d texmf-dist/doc/.*/$tlp";
- @{$tls{$tlp}{'docpatterns'}} = ("$l");
- }
- if (!(defined($tls{$tlp}{'srcpatterns'}))) {
- my $l = "d texmf-dist/source/.*/$tlp";
- @{$tls{$tlp}{'srcpatterns'}} = ("$l");
+ # predefined patterns if all are missing
+ if (! ( (defined($tls{$tlp}{'runpatterns'})) ||
+ (defined($tls{$tlp}{'srcpatterns'})) ||
+ (defined($tls{$tlp}{'docpatterns'})) ||
+ (defined($tls{$tlp}{'binpatterns'})) )) {
+ foreach my $md (qw/bibtex context dvips fonts makeindex metafont
+ metapost mft omega scripts tex vtex/) {
+ push @{$tls{$tlp}{'runpatterns'}}, "t texmf-dist $md $tlp";
+ }
+ push @{$tls{$tlp}{'docpatterns'}}, "t texmf-dist doc $tlp";
+ push @{$tls{$tlp}{'srcpatterns'}}, "t texmf-dist source $tlp";
}
$tldb{$tlp}{'name'} = $tls{$tlp};
if (defined($tls{$tlp}{'shortdesc'})) {
@@ -236,52 +330,126 @@ sub generate_tlp_data {
$tldb{$tlp}{'srcfiles'} = [ ];
$tldb{$tlp}{'packageversion'} = 0;
my $filemax;
- FILELABEL: foreach my $f (keys %AllFiles) {
- $filemax = $AllFiles{$f}{'lastchangedrev'};
- foreach my $p (@{$tls{$tlp}{'runpatterns'}}) {
- if (pattern_hit($f,$p,"run")) {
- $AllFiles{$f}{'used'} = 1;
- logit("Hit\n");
- $tldb{$tlp}{'packageversion'} = $filemax > $tldb{$tlp}{'packageversion'} ? $filemax : $tldb{$tlp}{'packageversion'};
- $tldb{$tlp}{'runfiles'} = [ @{$tldb{$tlp}{'runfiles'}}, $f ];
- next FILELABEL;
- }
+ foreach my $p (@{$tls{$tlp}{'runpatterns'}}) {
+ my ($pattype,@patwords) = split ' ',$p;
+ if ($pattype eq "t") {
+ do_leaf_pattern($tlp,'runfiles',@patwords);
+ } else {
+ do_regexp_pattern($tlp,'runfiles',$p);
}
- foreach my $p (@{$tls{$tlp}{'docpatterns'}}) {
- if (pattern_hit($f,$p,"doc")) {
- $AllFiles{$f}{'used'} = 1;
- logit("Hit\n");
- $tldb{$tlp}{'packageversion'} = $filemax > $tldb{$tlp}{'packageversion'} ? $filemax : $tldb{$tlp}{'packageversion'};
- $tldb{$tlp}{'docfiles'} = [ @{$tldb{$tlp}{'docfiles'}}, $f ];
- next FILELABEL;
- }
+ }
+ foreach my $p (@{$tls{$tlp}{'srcpatterns'}}) {
+ my ($pattype,@patwords) = split ' ',$p;
+ if ($pattype eq "t") {
+ do_leaf_pattern($tlp,'srcfiles',@patwords);
+ } else {
+ do_regexp_pattern($tlp,'srcfiles',$p);
}
- foreach my $p (@{$tls{$tlp}{'binpatterns'}}) {
- if (pattern_hit($f,$p,"bin")) {
- $AllFiles{$f}{'used'} = 1;
- logit("Hit\n");
- $tldb{$tlp}{'packageversion'} = $filemax > $tldb{$tlp}{'packageversion'} ? $filemax : $tldb{$tlp}{'packageversion'};
- $tldb{$tlp}{'binfiles'} = [ @{$tldb{$tlp}{'binfiles'}}, $f ];
- next FILELABEL;
- }
+ }
+ foreach my $p (@{$tls{$tlp}{'docpatterns'}}) {
+ my ($pattype,@patwords) = split ' ',$p;
+ if ($pattype eq "t") {
+ do_leaf_pattern($tlp,'docfiles',@patwords);
+ } else {
+ do_regexp_pattern($tlp,'docfiles',$p);
}
- foreach my $p (@{$tls{$tlp}{'srcpatterns'}}) {
- if (pattern_hit($f,$p,"src")) {
- $AllFiles{$f}{'used'} = 1;
- logit("Hit\n");
- $tldb{$tlp}{'packageversion'} = $filemax > $tldb{$tlp}{'packageversion'} ? $filemax : $tldb{$tlp}{'packageversion'};
- $tldb{$tlp}{'srcfiles'} = [ @{$tldb{$tlp}{'srcfiles'}}, $f ];
- next FILELABEL;
+ }
+ foreach my $p (@{$tls{$tlp}{'binpatterns'}}) {
+ my ($pattype,@patwords) = split ' ',$p;
+ if ($pattype eq "t") {
+ do_leaf_pattern($tlp,'binfiles',@patwords);
+ } else {
+ do_regexp_pattern($tlp,'binfiles',$p);
+ }
+ }
+}
+
+sub do_leaf_pattern {
+ my ($tlp,$type,@patwords) = @_;
+ # the pattern type looks like: dir1 dir2 ... dirn dirtl
+ # where a file matches if it looks like
+ # dir1/dir2/.../dirn/.*/dirtl/file
+ # all but the first define the first dirs, the last the leaf dir
+ my $tl = pop @patwords;
+ my $filemax;
+ if (defined($DirNames{$tl})) {
+ foreach my $tld (@{$DirNames{$tl}}) {
+ if (index($tld,join("/",@patwords)."/") == 0) {
+ my @files = files_under_path($tld);
+ foreach my $f (@files) {
+ $filemax = $AllFiles{$f}{'lastchangedrev'};
+ push_uniq( \@{$AllFiles{$f}{'used'}}, $tlp );
+ $tldb{$tlp}{'packageversion'} = $filemax > $tldb{$tlp}{'packageversion'} ? $filemax : $tldb{$tlp}{'packageversion'};
+ }
+ push_uniq (\@{$tldb{$tlp}{$type}}, @files);
+ #$tldb{$tlp}{$type} = [ @{$tldb{$tlp}{$type}}, @files ];
}
}
}
}
+sub files_under_path {
+ my ($p) = @_;
+ my @files = ();
+ foreach my $aa (@{$FilesOfDir{$p}}) {
+ push_uniq( \@files, $p . "/" . $aa);
+ }
+ if (defined($SubdirsOfDir{$p})) {
+ foreach my $sd (@{$SubdirsOfDir{$p}}) {
+ my @sdf = files_under_path($p . "/" . $sd);
+ push_uniq (\@files, @sdf);
+ }
+ }
+ return @files;
+}
+
+sub do_regexp_pattern {
+ my ($tlp,$filetype,$p) = @_;
+ my $filemax;
+ FILELABEL: foreach my $f (keys %AllFiles) {
+ $filemax = $AllFiles{$f}{'lastchangedrev'};
+ if (pattern_hit($f,$p)) {
+ push_uniq( \@{$AllFiles{$f}{'used'}}, $tlp );
+ logit("Hit\n");
+ $tldb{$tlp}{'packageversion'} = $filemax > $tldb{$tlp}{'packageversion'} ? $filemax : $tldb{$tlp}{'packageversion'};
+ $tldb{$tlp}{$filetype} = [ @{$tldb{$tlp}{$filetype}}, $f ];
+ next FILELABEL;
+ }
+ }
+}
+
+sub pattern_hit {
+ my ($file, $pattern) = @_;
+ my (@dirs) = split /\//, $file;
+ $pattern =~ /^(d|f|t)\s+(.*)$/;
+ my $pattype = $1;
+ my $patdata = $2;
+ logit("pattype=...$pattype...patdata=...$patdata...\n");
+ if ($pattype eq "d") {
+ pop @dirs ;
+ my $foo = join "/",@dirs;
+ logit("matching [d] >>>$patdata<<< against >>>$foo<<<\n");
+ if ($foo =~ /^$patdata$/) {
+ return 1;
+ }
+ } elsif ($pattype eq "f") {
+ logit("matching [f] >>>$patdata<<< against >>>$file<<<\n");
+ if ($file =~ /^$patdata$/) {
+ return 1;
+ }
+ } else {
+ die("Unknown pattern specification: $pattern!");
+ }
+ return 0;
+}
+
+
sub write_tlp_file {
my ($tlp) = @_;
open(TLP,">tlp/$tlp.tlp") || die("Cannot open tlp/$tlp.tlp for writing: $!");
print TLP "name $tlp\n";
- print TLP "packageversion $tldb{$tlp}{'packageversion'}\n";
+ #### these two things are disabled for comparison reasons
+ #####print TLP "packageversion $tldb{$tlp}{'packageversion'}\n";
if (defined($tldb{$tlp}{'shortdesc'})) {
$tlpline = "shortdesc $tldb{$tlp}{'shortdesc'}";
write TLP;
@@ -291,44 +459,44 @@ sub write_tlp_file {
write TLP;
}
if (defined($tldb{$tlp}{'catalogue'})) {
- print TLP "catalogue $tldb{$tlp}{'catalogue'}\n";
- }
- if (defined($tldb{$tlp}{'executes'})) {
- foreach (@{$tldb{$tlp}{'executes'}}) {
- print TLP "execute $_\n";
- }
+ #######print TLP "catalogue $tldb{$tlp}{'catalogue'}\n";
}
if (defined($tldb{$tlp}{'depends'})) {
foreach (@{$tldb{$tlp}{'depends'}}) {
print TLP "depend $_\n";
}
}
+ if (defined($tldb{$tlp}{'executes'})) {
+ foreach (@{$tldb{$tlp}{'executes'}}) {
+ print TLP "execute $_\n";
+ }
+ }
my @tmp;
@tmp = @{$tldb{$tlp}{'docfiles'}};
if ($#tmp >= 0) {
print TLP "docfiles\n";
- foreach (@tmp) {
+ foreach (sort @tmp) {
print TLP " $_\n";
}
}
@tmp = @{$tldb{$tlp}{'srcfiles'}};
if ($#tmp >= 0) {
print TLP "srcfiles\n";
- foreach (@tmp) {
+ foreach (sort @tmp) {
print TLP " $_\n";
}
}
@tmp = @{$tldb{$tlp}{'binfiles'}};
if ($#tmp >= 0) {
print TLP "binfiles\n";
- foreach (@tmp) {
+ foreach (sort @tmp) {
print TLP " $_\n";
}
}
@tmp = @{$tldb{$tlp}{'runfiles'}};
if ($#tmp >= 0) {
print TLP "runfiles\n";
- foreach (@tmp) {
+ foreach (sort @tmp) {
print TLP " $_\n";
}
}
@@ -339,30 +507,43 @@ sub logit {
$opt_debug && print STDERR @_;
}
-sub pattern_hit {
- my ($file, $pattern, $patterntype) = @_;
- $pattern =~ /^(d|f) (.*)$/;
- my $pattype = $1;
- my $patdata = $2;
- if ($pattype eq "d") {
- #my $dirn = `dirname $file`; # bad, should be rewritten
- #chomp($dirn);
- my $dirn = $file;
- $dirn =~ s@/[^/]*$@@;
- logit("matching >>>$patdata<<< against >>>$dirn<<<\n");
- if ($dirn =~ /^$patdata$/) {
- return 1;
+
+sub add_path_to_tree {
+ my ($node, @path) = @_;
+ my ($current);
+
+ while (@path) {
+ $current = shift @path;
+ if ($$node{$current}) {
+ $node = $$node{$current};
+ } else {
+ $$node{$current} = { };
+ $node = $$node{$current};
}
- } elsif ($pattype eq "f") {
- logit("matching >>>$patdata<<< against >>>$file<<<\n");
- if ($file =~ /^$patdata$/) {
+ }
+ return $node;
+}
+
+sub member {
+ my ($e, @l) = @_;
+ my ($f);
+ foreach $f (@l) {
+ if ($e eq $f) {
return 1;
}
- } else {
- die("Unknown pattern specification: $pattern!");
}
+ return 0;
}
+sub push_uniq {
+ my ($l,@le) = @_;
+ my ($e);
+ foreach $e (@le) {
+ if (! &member($e, @$l)) {
+ push @$l, $e;
+ }
+ }
+}
###### Formats
format TLP =
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-11 17:41:06 +0000