[subversion-commit] SVN tetex-base commit + diffs: r1016 - tetex-base/trunk/debian

Frank Küster frank at costa.debian.org
Tue Mar 7 17:50:10 UTC 2006


Author: frank
Date: 2006-03-07 17:50:10 +0000 (Tue, 07 Mar 2006)
New Revision: 1016

Modified:
   tetex-base/trunk/debian/tpm2licenses-new.pl
Log:
now outputs every directory only once if all files in it are under the same license terms.  Needs a copy in tetex-src to run, and probably should have command line options for the location of tpm files

Modified: tetex-base/trunk/debian/tpm2licenses-new.pl
===================================================================
--- tetex-base/trunk/debian/tpm2licenses-new.pl	2006-03-07 17:49:02 UTC (rev 1015)
+++ tetex-base/trunk/debian/tpm2licenses-new.pl	2006-03-07 17:50:10 UTC (rev 1016)
@@ -21,6 +21,7 @@
 }
 
 use strict;
+use Data::Dumper;
 use Getopt::Long;
 use File::Basename;
 use File::Copy;
@@ -40,14 +41,15 @@
 my $opt_what="license";
 my $Master;
 my $what;
+my $debian_package = "";
 
 GetOptions ("debug!", 	# debug mode
 	"master=s" => \$opt_master,	# location of Master
 	"catalogue=s" => \$opt_catalogue,	# location of the catalogue
-	"what=s" => \$opt_what      # print licenses or files in a tpm?
+	"what=s" => \$opt_what,      # print licenses or files in a tpm?
+	"debian=s" => \$debian_package
 	);
  
-
 if (!($opt_master =~ m,/.*$,,)) {
     $Master = `pwd`;
     chomp($Master);
@@ -57,6 +59,13 @@
 }
 $what = $opt_what;
 
+if ($debian_package) {
+    die "Unknown Debian package: $debian_package." unless
+	( $debian_package =~ /^tetex-base$/ || 
+	  $debian_package =~ /^tetex-src$/  ||
+	  $debian_package =~ /^texlive$/ );
+};
+
 my $TpmGlobalPath = $Master;
 my $DataGlobalPath = $Master;
 
@@ -64,8 +73,8 @@
 # my $TpmDirGlob = $Master . "./texmf-dist/tpm/*.tpm";
 # teTeX
 my $TpmDirGlob = "./debian/tpm/*.tpm";
+my $sourceDir = "/home/frank/src/Packages/tetex-src/tetex-src-3.0/";
 
-
 #
 # put Master/Tools/ into the include path to find TeX live perl modules
 #
@@ -77,7 +86,7 @@
 require XML::DOM;
 require FileUtils;
 import FileUtils qw(canon_dir cleandir make_link newpath member
-	normalize substitute_var_val dirname diff_list remove_list
+	normalize substitute_var_val diff_list remove_list
 	rec_rmdir sync_dir walk_dir start_redirection stop_redirection);
 require Tpm;
 #
@@ -192,15 +201,85 @@
     my %RunFiles = &Tpm::getListField($doc, "RunFiles");
     my %DocFiles = &Tpm::getListField($doc, "DocFiles");
 
-    # this is already done in Tpm.pm, why isn't that sufficient?
-    foreach ($RunFiles{"text"}, $DocFiles{"text"}, $SourceFiles{"text"}) { $_ =~ s/^\n*// };
+    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;
 
-    print $pkg_header . "\n" . $RunFiles{"text"} . $DocFiles{"text"} . $SourceFiles{"text"} . "\n";
+    foreach (\$RunFiles{"text"}, \$DocFiles{"text"}, \$SourceFiles{"text"}) {
+	my @filelist = split(/\n/m,${$_});
+	foreach (@filelist) {&CheckFileExistence($_)};
+	};
+
+    my @SourceFiles = split(/\n/m,$SourceFiles{"text"});
+    my @RunFiles = split(/\n/m,$RunFiles{"text"});
+    my @DocFiles = split(/\n/m,$DocFiles{"text"});
+
+    for ($debian_package) {
+	if ( /^texlive$/ ) { 1 };
+	if ( /^tetex-base$/ ) {
+	    &MergeDirectories(\@RunFiles);
+	    &MergeDirectories(\@DocFiles);
+	    print $pkg_header . "\n @RunFiles @DocFiles";
+	};
+	if ( /^tetex-src$/ ) {
+	    &MergeDirectories(\@SourceFiles);
+	    print $pkg_header . "\n @SourceFiles \n";
+	};
+    };
 }
 
+sub CheckFileExistence {
+    my $file = $_[0];
+    $file =~ s at source@${sourceDir}source@;
+    print STDERR "$file: Does not exist!\n" if ! -f $file;
+}
+
+sub MergeDirectories {
+    my $filelist = $_[0]; # $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 @InstalledFiles = `find $dirname -maxdepth 1 -type f | grep -v tetex` 
+	    or die "calling find to find installed files failed.";
+	for (@InstalledFiles) {
+	    chomp;
+	    $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;
+
+}
+
 #   foreach $LocalTPM (<./texmf-doc/tpm/*.tpm>) {
 #      my $dat = $parser->parsefile($LocalTPM);
 #      if (defined($dat->getElementsByTagName("TPM:License")) &&




More information about the Pkg-tetex-commits mailing list