[tex-live] XML/DOM directory in Build/tools

Frank Küster frank at kuesterei.ch
Tue Apr 11 07:49:33 CEST 2006


Frank Küster <frank at kuesterei.ch> wrote:

> Attached is a complete diff. 

I always manage to forget this...

Regards, Frank
-- 
Frank Küster
Single Molecule Spectroscopy, Protein Folding @ Inst. f. Biochemie, Univ. Zürich
Debian Developer (teTeX)

-------------- next part --------------
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 at 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 at so;
+      s@\n\s*@\n at gm;
+    };
+    foreach (@RunFiles) { 
+      s/\s//;
+      s@^[\s\n]*(.*)[\s\n]*$@$1 at so;
+      s@\n\s*@\n at gm;
+    };
+    foreach (@DocFiles) { 
+      s/\s//;
+      s@^[\s\n]*(.*)[\s\n]*$@$1 at so;
+      s@\n\s*@\n at gm;
+    };
+    @DocFiles = grep(!/^$/, at DocFiles);
+    @RunFiles = grep(!/^$/, at RunFiles);
+    @SourceFiles = grep(!/^$/, at 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, at 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, at 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;
+  }
+
 }
 


More information about the tex-live mailing list