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
+ $_ =~ [EMAIL PROTECTED]/@@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([EMAIL PROTECTED]);
+ &MergeDirectories([EMAIL PROTECTED]);
+ print $pkg_header . "\n @RunFiles @DocFiles";
+ };
+ if ( /^tetex-src$/ ) {
+ &MergeDirectories([EMAIL PROTECTED]);
+ print $pkg_header . "\n @SourceFiles \n";
+ };
+ };
}
+sub CheckFileExistence {
+ my $file = $_[0];
+ $file =~ [EMAIL PROTECTED]@${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
+ [EMAIL PROTECTED]/[EMAIL PROTECTED]/*@;
+ };
+ };
+# 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")) &&
_______________________________________________
Pkg-tetex-commits mailing list
[email protected]
http://lists.alioth.debian.org/mailman/listinfo/pkg-tetex-commits
