[Date Prev][Date Next] [Thread Prev][Thread Next] [Date Index] [Thread Index]

Re: License Zeug



Norbert Preining <preining@logic.at> wrote:

> - wie werden die license Listen für tetex erstelt?
> - Kann ich das auch für texlive Pakete machen?

How are the license lists for tetex generated?  Can I do this also for
texlive? 

There's hardly a difference betweeen tetex and texlive, and I have
already tried to work on both.  It goes like this - a package is defined
by "one tpm file", or "one catalogue entry":

0. Install tpm2licenses and Tpm.pm from tex-common/scripts into
   /usr/local/tex-common (or install tex-common_0.20.1, untested).

1. Add a new package:

1.a) for tetex, copy the tpm file from texlive to
  tetex-base/trunk/debian/tpm
1.b) for texlive, add the tpm file to
  texlive/trunk/texlive-<subpack>.tpm4licenses.cfg

2. Go to the root of an unpacked source package 

2.a) for tetex, tetex-base/trunk/ or tetex-src/trunk
2.b) for texlive, I chose texlive/trunk/pool/texlive-<subpack>-2005

   tetex has the configuration files for tpm2licenses in the debian
   directory:
   http://svn.debian.org/wsvn/debian-tex/tetex-base/trunk/debian/.tpm2license.cfg?op=file&rev=0&sc=0 

   for texlive, I currently keep them in pool/texlive-<subpack>-2005/,
   but that is not optimal because that directory is not under version
   control.  The contents are, e.g. for texlive-base:

frank@riesling:~$ cat src/Packages/texlive/texlive/pool/texlive-base-2005/.tpm2license.cfg
Catalogue = /home/frank/src/Upstream-source/texcatalogue
Master = ../../LocalTPM
package = texlive-base
tpmdir = ../../LocalTPM/texmf-dist/tpm
frank@riesling:~$ 

3. run /usr/{local/}share/tex-common/tpm2licenses, either without
   arguments (this will give you the complete license+files list), or
   with a tpm file (with full relative path) for only one package

3.a  Now check that no files are warned to be missing (this is frequently
     the case fore tetex, because most documentation is still in dvi
     format while texlive lists it as pdf)

4.  Now comes the real license check.  Some comments on this are also in
    http://svn.debian.org/wsvn/debian-tex/tetex-base/trunk/debian/copyright.header?op=file&rev=0&sc=0 

   - where is the license specified?  Are all files in the tpm actually
     covered by it?  Are there more files in the tarball that are also
     covered by this license (this is frequently true for tetex, too -
     copies of the documentation in tetex-src, for example)

4.a) if everything is clear edit your local copy of the TeX catalogue
  and enter the license details
4.b) if there are files with unclear or non-free status, note it down,
  ideally in a bug report, and contact upstream.  For some people I
  decided to wait and collect all problematic files, but e.g. the list
  of problematic files by D. Arseneau in coyright.header should be
  complete, now.

For the people who don't have a local copy of the TeX catalogue, you
should call tpm2license with the --nocatalogue option, or put a
configuration file in your home directory that specifies this option;
You won't get a valid copyright file then, but you can of course check
the license and submit the information.

> - welche Anpassungen hast du an tpm2licenses gemacht, die könnte man 
>   nämlich auch bei tpm2deb.pl machen, was helfen würde.

Which changes did you make on tpm2licenses:

Lots of.  

svn diff svn+ssh://frank@svn.debian.org/svn/debian-tex/texlive/trunk/LocalTPM/tpm2licenses-new.pl svn+ssh://frank@svn.debian.org/svn/debian-tex/tex-common/trunk/scripts/tpm2licenses

I attach the diff, here are some comments.  Unfortunately, the script is
nearly completely reindented - this was done in a separate commit to
tetex-base, but that doesn't help here.  I don't comment on some code
cleanup I did - I inserted "use strict; use warnings;" and changed the
code until it was quiet.

First comes some option handling, then, in the same hunk,

+if ($debian_package) {
+  die "Unknown Debian package: $debian_package." unless
+      ( $debian_package =~ /^tetex-base$/    || 
+	$debian_package =~ /^tetex-src$/     ||
+	$debian_package =~ /^texlive-base$/  ||
+	$debian_package =~ /^texlive-extra$/ ||
+	$debian_package =~ /^texlive-lang$/  ||
+	$debian_package =~ /^texlive-doc$/   ||
+	$debian_package =~ /^texlive-bin$/     );
+};

Add additional packages here.

+# texlive
+# my $TpmDirGlob = $Master . "./texmf-dist/tpm/*.tpm";
+# teTeX
+my $TpmDirGlob = "$tpmdir/*.tpm";

texlive finds its tpm files in a different way now, with the
<package>.tpm4licenses.cfg files, because it already contains many
unchecked tpm's, we cannot simply take all as in tetex.

 # put Master/Tools/ into the include path to find TeX live perl modules
 #
-unshift (@INC, "$Master/Tools");
+# unshift (@INC, "$Master/Tools");

This is no longer needed if Tpm.pm is in the same directory as the
script, and libxml-dom-perl is installed

 
 my $parser = new XML::DOM::Parser;
 my $startdir=getcwd();
 chdir($startdir);
 File::Basename::fileparse_set_fstype('unix');
 
-&list_licenses();
+my @TpmList;
 
+if (@ARGV) {
+  # we have a (list of) packages on the command line
+  @TpmList = @ARGV;
+}
+else {
+  create_tpmlist();
+};
+
+list_licenses();
+
 1;

So I call the new subroutine create_tpmlist first, then list_licenses.
 
+sub create_tpmlist {
+
+  if 	( $debian_package =~ /^tetex-/ ) {
+    foreach (<$TpmDirGlob >) {push(@TpmList,$_)};
+  };
+
+  if 	( $debian_package =~ /^texlive-/ ) {
+    my $cfgfile = "../../" . $debian_package . ".tpm4licenses.cfg";
+    my @cfgLines;
+    open CFGFILE, $cfgfile or die "could not open $cfgfile";

...and so on; for tetex the list is populated by the dirglob above.

+  }; #end texlive
+};
+
 sub list_licenses {
[...]
+    if ( $pkgcat =~ m/^individual.*/ ) {
+      $ltype = $pkgcat;
+      $ltype =~ s/individual_(.*)/$1/;
+      $licline = "$pkgcat $ltype (verification data:::::header)";
+      $printfiles = '1';

This is a special case for some files in tetex that don't belong to a
package (mostly hyphenation patterns), I didn't find out (or even try
to) in which texlive package they are.

+    };
+    $what eq "license" && print "$licline\n";
+    # we know the license, it makes sense to output the files
+    $what eq "files" && ($printfiles || $nocatalogue) && printFiles($LocalTPM,$licline);
+  }

$what eq "license" is just the old case, "files" is the new (and now
default), calling the new subroutine printfiles.

+  sub printFiles {
+    my ($LocalTPM,$licline)= @_;
+    my $pkg_header = "% " . $licline;
+    my $dom_parser = new XML::DOM::Parser;
+    my $doc = $dom_parser->parsefile($LocalTPM);
+    my %SourceFiles = Tpm::getListField($doc, "SourceFiles");
+    my %RunFiles = Tpm::getListField($doc, "RunFiles");
+    my %DocFiles = Tpm::getListField($doc, "DocFiles");

get filelists from tpm

+    my @SourceFiles = split(/\n/m,$SourceFiles{"text"});
+    my @RunFiles = split(/\n/m,$RunFiles{"text"});
+    my @DocFiles = split(/\n/m,$DocFiles{"text"});
+    foreach (@SourceFiles) { 
+      s/^\s//;
+      s@^[\s\n]*(.*)[\s\n]*$@$1@so;
+      s@\n\s*@\n@gm;
+    };
+    foreach (@RunFiles) { 
+      s/\s//;
+      s@^[\s\n]*(.*)[\s\n]*$@$1@so;
+      s@\n\s*@\n@gm;
+    };
+    foreach (@DocFiles) { 
+      s/\s//;
+      s@^[\s\n]*(.*)[\s\n]*$@$1@so;
+      s@\n\s*@\n@gm;
+    };
+    @DocFiles = grep(!/^$/,@DocFiles);
+    @RunFiles = grep(!/^$/,@RunFiles);
+    @SourceFiles = grep(!/^$/,@SourceFiles);

The stuff after splitting is needed if you don't have texlive's version
of XML::DOM

+    for ($debian_package) {
+      my @texmfPath;
+      if ( /^texlive/ ) { 
+	@texmfPath = ("texmf","texmf-dist","texmf-doc");
+	foreach (@RunFiles) {CheckFileExistence($_,\@texmfPath)};
+	foreach (@DocFiles) {CheckFileExistence($_,\@texmfPath)};
+	foreach (@SourceFiles) {CheckFileExistence($_,\@texmfPath)};
+	MergeDirectories(\@RunFiles,\@texmfPath);
+	MergeDirectories(\@DocFiles,\@texmfPath) if (@DocFiles);
+	MergeDirectories(\@SourceFiles,\@texmfPath) if (@SourceFiles);
+	print "\n" . $pkg_header . "\n";
+	print @RunFiles;
+	print @DocFiles;
+	print @SourceFiles;
+      };
+      if ( /^tetex-base$/ ) {
[...]

texlive acts on all three types, whereas for tetex @SourceFiles are only
for tetex-src.

+  sub MergeDirectories {

The purpose of this is described in copyright.headers, it gives output
like this: 

doc/latex/ccfonts/*

if all ordinary files in that directory belong to that package (but
*not* subdirectories and files therein!).

That should be enough for a starter...

Regards, Frank

Index: tpm2licenses-new.pl
===================================================================
--- tpm2licenses-new.pl	(.../texlive/trunk/LocalTPM/tpm2licenses-new.pl)	(revision 1182)
+++ tpm2licenses-new.pl	(.../tex-common/trunk/scripts/tpm2licenses)	(revision 1182)
@@ -6,10 +6,14 @@
 # Lists for every filename.tpm the license as specified in the catalogue
 #
 # usage:
-# perl tpm2licenses.pl <options>
+# perl tpm2licenses.pl <options> [tpm file]
 # where <options> =
-# 	--debug		Put out a lot of debug
+# 	--catalogue
+#       --nocheckcatalogue
+#       --tpmdir
+#       --package
 # 	--master=Path	path to the Master
+# optional tpm file: check only that one
 #
 
 BEGIN {   # get our other local perl modules.
@@ -20,12 +24,14 @@
 #  unshift (@INC, "$mydir/..");
 }
 
-#use Strict;
-use Getopt::Long;
+use strict;
+use Data::Dumper;
+#use Getopt::Long;
 use File::Basename;
 use File::Copy;
 use File::Path;
 use File::Temp qw/ tempfile tempdir /;
+use AppConfig;
 #use XML::DOM;
 use Cwd;
 #use FileUtils qw(canon_dir cleandir make_link newpath member
@@ -34,140 +40,381 @@
 #use Tpm;
 
 
-$opt_debug=0;
-$opt_master=".";
-$opt_catalogue="/src/TeX/texcatalogue/";
+# initialize AppConfig
+my $config = AppConfig->new("master=s", "catalogue=s", "nocheckcatalogue", "tpmdir=s", "package=s", "what=s");
 
-GetOptions ("debug!", 	# debug mode
-	"master=s" => \$opt_master,	# location of Master
-	"catalogue=s" => \$opt_catalogue	# location of the catalogue
-	);
- 
-if (!($opt_master =~ m,/.*$,,)) {
-    $Master = `pwd`;
-    chomp($Master);
-    $Master .= "/$opt_master";
-} else {
-    $Master = $opt_master;
-}
-my $TpmGlobalPath = $Master;
-my $DataGlobalPath = $Master;
+# parse configurationfile, if present
+my @cfgDirs = (".","./debian","..","~");
+my $cfgName = ".tpm2license.cfg";
 
+for my $cfgDir (@cfgDirs) {
+    if ( -r "$cfgDir/$cfgName" ) {
+	print STDERR "Using configuration file $cfgDir/$cfgName\n";
+	$config->file("$cfgDir/$cfgName");
+      };
+  };
+# now parse commandline
+$config->getopt();
+
+# assign conffile, commandline or default values:
+my $Master = $config->master() ? $config->master() : "." ;
+my $Catalogue = $config->catalogue() ? $config->catalogue() : "/src/TeX/texcatalogue/" ;
+my $what = $config->what() ? $config->what() : "files";
+my $debian_package = $config->package() ? $config->package() : "tetex-base";
+my $tpmdir = $config->tpmdir() ? $config->tpmdir() : "./debian/tpm";
+my $nocatalogue = $config->nocheckcatalogue() ? $config->nocheckcatalogue() : '';
+
+# if (!($opt_master =~ m,/.*$,,)) {
+#     $Master = `pwd`;
+#     chomp($Master);
+#     $Master .= "/$opt_master";
+# } else {
+#     $Master = $opt_master;
+# }
+# $what = $opt_what;
+
+if ($debian_package) {
+  die "Unknown Debian package: $debian_package." unless
+      ( $debian_package =~ /^tetex-base$/    || 
+	$debian_package =~ /^tetex-src$/     ||
+	$debian_package =~ /^texlive-base$/  ||
+	$debian_package =~ /^texlive-extra$/ ||
+	$debian_package =~ /^texlive-lang$/  ||
+	$debian_package =~ /^texlive-doc$/   ||
+	$debian_package =~ /^texlive-bin$/     );
+};
+
+# my $TpmGlobalPath = $Master;
+# my $DataGlobalPath = $Master;
+
+# texlive
+# my $TpmDirGlob = $Master . "./texmf-dist/tpm/*.tpm";
+# teTeX
+my $TpmDirGlob = "$tpmdir/*.tpm";
+
+# only needed if we're in the sourcedir, so no need to bother
+my $sourceDir;
+chomp( $sourceDir = `pwd`); 
+$sourceDir .= "/";
+
 #
 # put Master/Tools/ into the include path to find TeX live perl modules
 #
-unshift (@INC, "$Master/Tools");
+# unshift (@INC, "$Master/Tools");
 #
 # these we can only load now that we have correctly set the path to Master
 #
-require Strict;
+# require Strict;
 require XML::DOM;
 require FileUtils;
 import 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);
+		    normalize substitute_var_val diff_list remove_list
+		    rec_rmdir sync_dir walk_dir start_redirection stop_redirection);
 require Tpm;
 #
 # what the hell, how do I import this array from Tpm.pm ???
 #
 my %Tpm2Catalogue = (
-        "ctib" => "ctib4tex",
-        "CJK" => "cjk",
-        "bayer" => "universa",
-        "bigfoot" => "suffix",
-        "cb" => "cbgreek",
-        "cd-cover" => "cdcover",
-        "cmex" => "cmextra",
-        "cs" => "csfonts",
-        "cyrplain" => "t2",
-        "devanagr" => "devanagari",
-        "eCards" => "ecards",
-        "ESIEEcv" => "esieecv",
-        "euclide" => "pst-eucl",
-        "GuIT" => "guit",
-        "HA-prosper" => "prosper",
-        "ibycus" => "ibycus4",
-        "ibygrk" => "ibycus4",
-        "IEEEconf" => "ieeeconf",
-        "IEEEtran" => "ieeetran",
-        "iso" => "isostds",
-        "iso10303" => "isostds",
-        "jknapltx" => "jknappen",
-        "kastrup" => "binhex",
-        "le" => "frenchle",
-        "mathtime" => "mathtime-ltx",
-        "omega-devanagari" => "devanagari-omega",
-        "pdftexdef" => "pdftex-def",
-        "procIAGssymp" => "prociagssymp",
-        "resume" => "res",
-        "SIstyle" => "sistyle",
-        "SIunits" => "siunits",
-        "syntax" => "syntax2",
-        "Tabbing" => "tabbing" );
+		     "ctib" => "ctib4tex",
+		     "CJK" => "cjk",
+		     "bayer" => "universa",
+		     "bigfoot" => "suffix",
+		     "cb" => "cbgreek",
+		     "cd-cover" => "cdcover",
+		     "cmex" => "cmextra",
+		     "cs" => "csfonts",
+		     "cyrplain" => "t2",
+		     "devanagr" => "devanagari",
+		     "eCards" => "ecards",
+		     "ESIEEcv" => "esieecv",
+		     "euclide" => "pst-eucl",
+		     "GuIT" => "guit",
+		     "HA-prosper" => "prosper",
+		     "ibycus" => "ibycus4",
+		     "ibygrk" => "ibycus4",
+		     "IEEEconf" => "ieeeconf",
+		     "IEEEtran" => "ieeetran",
+		     "iso" => "isostds",
+		     "iso10303" => "isostds",
+		     "jknapltx" => "jknappen",
+		     "kastrup" => "binhex",
+		     "le" => "frenchle",
+		     "mathtime" => "mathtime-ltx",
+		     "omega-devanagari" => "devanagari-omega",
+		     "pdftexdef" => "pdftex-def",
+		     "procIAGssymp" => "prociagssymp",
+		     "resume" => "res",
+		     "SIstyle" => "sistyle",
+		     "SIunits" => "siunits",
+		     "syntax" => "syntax2",
+		     "Tabbing" => "tabbing" );
 
 my $parser = new XML::DOM::Parser;
 my $startdir=getcwd();
 chdir($startdir);
 File::Basename::fileparse_set_fstype('unix');
 
-&list_licenses();
+my @TpmList;
 
+if (@ARGV) {
+  # we have a (list of) packages on the command line
+  @TpmList = @ARGV;
+}
+else {
+  create_tpmlist();
+};
+
+list_licenses();
+
 1;
 
+my $LocalTPM;
+my $licline;
+my $bn;
+my $pkgcat;
+my $node;
+my $printfiles = '';
+
+sub create_tpmlist {
+
+  if 	( $debian_package =~ /^tetex-/ ) {
+    foreach (<$TpmDirGlob >) {push(@TpmList,$_)};
+  };
+
+  if 	( $debian_package =~ /^texlive-/ ) {
+    my $cfgfile = "../../" . $debian_package . ".tpm4licenses.cfg";
+    my @cfgLines;
+    open CFGFILE, $cfgfile or die "could not open $cfgfile";
+    while (<CFGFILE>) {
+      # this could go into one line (next if...) if only Emacs would grok it...
+      if (m/^#/) { 
+	  next ; 
+	}
+      chomp;
+      push(@cfgLines,$_);
+    };
+    for (@cfgLines) {
+      my $tpmFullname;
+      if ( -f "texmf/tpm/" . $_ ) {
+	$tpmFullname = "texmf/tpm/" . $_
+	  }
+      elsif ( -f "texmf-dist/tpm/" . $_ ) {
+	$tpmFullname = "texmf-dist/tpm/" . $_
+	  }
+      elsif ( -f "texmf-doc/tpm/" . $_ ) {
+	$tpmFullname = "texmf-doc/tpm/" . $_
+	  }
+      else {
+	print STDERR "Could not find $_\n";
+	exit 1;
+      };
+      push(@TpmList,$tpmFullname);
+    };
+  }; #end texlive
+};
+
 sub list_licenses {
-   foreach $f (<./texmf-dist/tpm/*.tpm>) {
-      $licline = "";
-      $bn = &basename($f,".tpm");
-      if (defined($Tpm2Catalogue{$bn})) {
-        $pkgcat = $Tpm2Catalogue{$bn};
-      } else {
-        $pkgcat = $bn;
-      }
-      $licline .= "$bn: ";
-      my $fletter = substr($pkgcat, 0, 1);
-      my $catname = "${opt_catalogue}/entries/$fletter/${pkgcat}.xml";
+  foreach $LocalTPM (@TpmList) {
+    $licline = "";
+    $bn = &basename($LocalTPM,".tpm");
+    if (defined($Tpm2Catalogue{$bn})) {
+      $pkgcat = $Tpm2Catalogue{$bn};
+    } else {
+      $pkgcat = $bn;
+    }
+    $licline .= "$bn: ";
+    my $fletter = substr($pkgcat, 0, 1);
+    my $catname = "${Catalogue}/entries/$fletter/${pkgcat}.xml";
+    if (! -r $catname) {
+      $catname = "$tpmdir/${pkgcat}.xml";
       if (! -r $catname) {
-        $licline .= "not-in-catalogue";
-	print "$licline\n";
-	next;
-      } else {
-        my $cat = $parser->parsefile($catname);
-	my ($version, $ltype, $lversion, $lchecked, $luser);
-	$node = $cat->getElementsByTagName("version")->item(0);
-	if ($node) {
-	  $version = $node->getAttribute("number");
-	}
-	$node = $cat->getElementsByTagName("license")->item(0);
-	if ($node) {
-	  # ok we have a license entry in the
-	  $ltype = $node->getAttribute("type");
-	  $lversion = $node->getAttribute("version");
-	  $lchecked = $node->getAttribute("checked");
-	  $luser = $node->getAttribute("username");
-	}
-	if ("$lversion$lchecked$luser" eq "") {
-	  if ("$ltype" eq "") {
-	    $licline .= "unknown";
-	  } else {
-	    $licline .= "$ltype (unverified)";
-	  }
+	$licline .= "not-in-catalogue";
+	unless ($nocatalogue || $pkgcat =~ m/^individual.*/) {
 	  print "$licline\n";
 	  next;
+	};
+# 	  } else {
+# 	      print STDERR "found ${pkgcat}.xml in $tpmdir\n";
+      };
+    }
+    my $ltype;
+    unless ($nocatalogue  || $pkgcat =~ m/^individual.*/) { 
+      #don't try to parse the xml file if we don't have a catalogue
+      my $cat = $parser->parsefile($catname);
+      my ($version, $lversion, $lchecked, $luser, $lfile);
+      $node = $cat->getElementsByTagName("version")->item(0);
+      if ($node) {
+	$version = $node->getAttribute("number");
+      }
+      $node = $cat->getElementsByTagName("license")->item(0);
+      if ($node) {
+	# ok we have a license entry in there
+	$ltype = $node->getAttribute("type");
+	$lversion = $node->getAttribute("version");
+	$lchecked = $node->getAttribute("checked");
+	$luser = $node->getAttribute("username");
+	$lfile = $node->getAttribute("file");
+      }
+      if ("$lversion$lchecked$luser" eq "") {
+	if ("$ltype" eq "") {
+	  $licline .= "unknown";
+	} else {
+	  $licline .= "$ltype (unverified)";
+	  # we know the license, it makes sense to output the files
+	  $printfiles = '1';
 	}
-	$licline .= "$ltype (verification data:$version:$lversion:$lchecked:$luser)";
-	print "$licline\n";
+      } else {
+	$version ||= ''; # make sure we have no uninitialized string values
+	$lversion ||= '';
+	$licline .= "$ltype (verification data:$version:$lversion:$lchecked:$luser:$lfile)";
+	$printfiles = '1';
       }
-   }
+    }
+    if ( $pkgcat =~ m/^individual.*/ ) {
+      $ltype = $pkgcat;
+      $ltype =~ s/individual_(.*)/$1/;
+      $licline = "$pkgcat $ltype (verification data:::::header)";
+      $printfiles = '1';
+    };
+    $what eq "license" && print "$licline\n";
+    # we know the license, it makes sense to output the files
+    $what eq "files" && ($printfiles || $nocatalogue) && printFiles($LocalTPM,$licline);
+  }
 
-#   foreach $f (<./texmf-doc/tpm/*.tpm>) {
-#      my $dat = $parser->parsefile($f);
-#      if (defined($dat->getElementsByTagName("TPM:License")) &&
-#          defined($dat->getElementsByTagName("TPM:License")->item(0)) &&
-#	  defined($dat->getElementsByTagName("TPM:License")->item(0)->getFirstChild)) {
-#	  print &basename($f,".tpm"), "\t", $dat->getElementsByTagName("TPM:License")->item(0)->getFirstChild->toString, "\n";
-#      } else {
-#          print &basename($f,".tpm"), "\tnon-in-catalogue\n";
-#      }
-#   }
+
+  sub printFiles {
+    my ($LocalTPM,$licline)= @_;
+    my $pkg_header = "% " . $licline;
+    my $dom_parser = new XML::DOM::Parser;
+    my $doc = $dom_parser->parsefile($LocalTPM);
+    my %SourceFiles = Tpm::getListField($doc, "SourceFiles");
+    my %RunFiles = Tpm::getListField($doc, "RunFiles");
+    my %DocFiles = Tpm::getListField($doc, "DocFiles");
+
+    foreach ($RunFiles{"text"}, $DocFiles{"text"}, $SourceFiles{"text"}) { 
+      # this is already done in Tpm.pm, why isn't that sufficient?
+      $_ =~ s/^\n*// ;
+      # remove the texmf-dist/ we don't need
+      $_ =~ s@texmf-dist/@@g;
+      # make sure there's exactly one newline at the end
+      chomp;
+      $_ =~ s/$/\n/ ;
+    };
+
+    # we don't want the tpm file which isn't installed
+    $RunFiles{"text"} =~ s/\n.*\.tpm$//m;
+
+    my @SourceFiles = split(/\n/m,$SourceFiles{"text"});
+    my @RunFiles = split(/\n/m,$RunFiles{"text"});
+    my @DocFiles = split(/\n/m,$DocFiles{"text"});
+    foreach (@SourceFiles) { 
+      s/^\s//;
+      s@^[\s\n]*(.*)[\s\n]*$@$1@so;
+      s@\n\s*@\n@gm;
+    };
+    foreach (@RunFiles) { 
+      s/\s//;
+      s@^[\s\n]*(.*)[\s\n]*$@$1@so;
+      s@\n\s*@\n@gm;
+    };
+    foreach (@DocFiles) { 
+      s/\s//;
+      s@^[\s\n]*(.*)[\s\n]*$@$1@so;
+      s@\n\s*@\n@gm;
+    };
+    @DocFiles = grep(!/^$/,@DocFiles);
+    @RunFiles = grep(!/^$/,@RunFiles);
+    @SourceFiles = grep(!/^$/,@SourceFiles);
+
+    for ($debian_package) {
+      my @texmfPath;
+      if ( /^texlive/ ) { 
+	@texmfPath = ("texmf","texmf-dist","texmf-doc");
+	foreach (@RunFiles) {CheckFileExistence($_,\@texmfPath)};
+	foreach (@DocFiles) {CheckFileExistence($_,\@texmfPath)};
+	foreach (@SourceFiles) {CheckFileExistence($_,\@texmfPath)};
+	MergeDirectories(\@RunFiles,\@texmfPath);
+	MergeDirectories(\@DocFiles,\@texmfPath) if (@DocFiles);
+	MergeDirectories(\@SourceFiles,\@texmfPath) if (@SourceFiles);
+	print "\n" . $pkg_header . "\n";
+	print @RunFiles;
+	print @DocFiles;
+	print @SourceFiles;
+      };
+      if ( /^tetex-base$/ ) {
+	@texmfPath = (".");
+	foreach (@RunFiles) {CheckFileExistence($_,\@texmfPath)};
+	foreach (@DocFiles) {CheckFileExistence($_,\@texmfPath)};
+
+	MergeDirectories(\@RunFiles,\@texmfPath);
+	MergeDirectories(\@DocFiles,\@texmfPath) if (@DocFiles);
+	print "\n" . $pkg_header . "\n";
+	print @RunFiles;
+	print @DocFiles;
+      };
+      if ( /^tetex-src$/ ) {
+	foreach (@SourceFiles) {CheckFileExistence($_,\@texmfPath)};
+	MergeDirectories(\@SourceFiles,\@texmfPath);
+	unless (! @SourceFiles) {
+	  print "\n" . $pkg_header . "\n";
+	  print @SourceFiles;
+	}
+      };
+    };
+  }
+
+  sub CheckFileExistence {
+    my ($file,@texmfPath) = ($_[0],@{$_[1]});
+    my $found = 0;
+    foreach my $texmfDir (@texmfPath) {
+      -f $texmfDir . "/" . $file && ($found =1);
+    };
+    print STDERR "$file: Does not exist!\n" if ! $found;
+  }
+
+  sub MergeDirectories {
+    my ($filelist,@texmfPath) = ($_[0],@{$_[1]}); # $filelist is actually a pointer
+    # create a list of dirnames, and remove duplicates
+    my @dirnames = map {dirname($_) } @{$filelist};
+    my %UniqueHash = map { $_ , 1 } @dirnames;
+    @dirnames = keys %UniqueHash;
+
+    # For searching, we create a hash that contains the filenames as keys:
+    my %SearchHash;
+    %SearchHash = map { $_, 1 } @{$filelist} ;
+
+    my %DirComplete = map { $_, 1 } @dirnames;
+    for (@dirnames) {
+      my $dirname = $_;
+      my $fullDir;
+      my $rootDir;
+      for (@texmfPath) {
+	if ( -d ( $_ . "/" . $dirname )) { 
+	  $rootDir = $_;
+	  $fullDir =  ( $_ . "/" . $dirname );
+	};
+      };
+      $fullDir or die "This should not happen: no directory $dirname, nowhere.";
+      my  @InstalledFiles = `find $fullDir -maxdepth 1 -type f 2>/dev/null | grep -v tetex` 
+	  or die "Calling find for $dirname, expanded to $fullDir, failed.";
+      for (@InstalledFiles) {
+	chomp;
+	s@^$rootDir/@@;
+	$DirComplete{$dirname} = 0 unless $SearchHash{$_};
+      };
+      if ( $DirComplete{$dirname} ) {
+	for (@{$filelist} ) {
+	  # replace the file by its directory name
+	  s@$dirname/.*@$dirname/*@;
+	};
+      };
+# 	print STDERR "Directory $_ is $DirComplete{$dirname}\n";
+    };
+
+    # now the complete directories occur multiple times, remove duplicates again
+    %UniqueHash = map { ("$_\n" , 1) } @{$filelist} ;
+    @{$filelist} = keys %UniqueHash;
+  }
+
 }
 
-- 
Frank Küster
Single Molecule Spectroscopy, Protein Folding @ Inst. f. Biochemie, Univ. Zürich
Debian Developer (teTeX)

Reply to: