fixes for new-infra

git-svn-id: svn://tug.org/texlive/trunk@4414 c570f23f-e606-0410-a88d-b1316a301751

6 files changed, 125 insertions, 32 deletions

diff --git a/new-infra/Perl-API.txt b/new-infra/Perl-API.txt
index e5d2d50d8df..c51625ed098 100644
--- a/new-infra/Perl-API.txt
+++ b/new-infra/Perl-API.txt
@@ -17,6 +17,7 @@ Input/Output
 Read/Write functions (with argument set, without arg read)
 
 	$tlsrc->name
+	$tlsrc->category
 	$tlsrc->shortdesc
 	$tlsrc->longdesc
 	$tlsrc->catalogue
@@ -78,6 +79,7 @@ Utilities:
 Read/Write functions (with argument set, without arg read)
 
 	$tlp->name
+	$tlp->category
 	$tlp->revision
 	$tlp->shortdesc
 	$tlp->longdesc
diff --git a/new-infra/TLP.pm b/new-infra/TLP.pm
index b2bb6f2a969..2045dcdab00 100644
--- a/new-infra/TLP.pm
+++ b/new-infra/TLP.pm
@@ -22,6 +22,7 @@ sub new {
 	my %params = @_;
 	my $self = {
 		name        => $params{'name'},
+		category    => defined($params{'category'}) ? $params{'category'} : "Package",
 		shortdesc   => $params{'shortdesc'},
 		longdesc    => $params{'longdesc'},
 		catalogue   => $params{'catalogue'},
@@ -105,8 +106,12 @@ sub from_fh {
 				$self->{'longdesc'} .= "$2";
 				$lastcmd = "longdesc";
 				next;
+			} elsif ($line =~ /^category\s+(Package|TLCore|Documentation)$/) {
+				$self->{'category'} = "$1";
+				$lastcmd = "category";
+				next;
 			} elsif ($line =~ /^revision\s+(.*)$/) {
-				$self->{'revision'} .= "$1";
+				$self->{'revision'} = "$1";
 				$lastcmd = "revision";
 				next;
 			} elsif ($line =~ /^catalogue\s+(.*)$/) {
@@ -212,6 +217,7 @@ sub writeout {
 	my $fd = (@_ ? $_[0] : STDOUT);
 	format_name $fd "multilineformat";
 	print $fd "name ", $self->name, "\n";
+	print $fd "category ", $self->category, "\n";
 	defined($self->{'revision'}) && print $fd "revision $self->{'revision'}\n";
 	defined($self->{'catalogue'}) && print $fd "catalogue $self->{'catalogue'}\n";
 	defined($self->{'shortdesc'}) && print $fd "shortdesc $self->{'shortdesc'}\n";
@@ -257,6 +263,51 @@ sub writeout {
 	}
 }
 
+sub writeout_simple {
+	my $self = shift;
+	my $fd = (@_ ? $_[0] : STDOUT);
+	format_name $fd "multilineformat";
+	print $fd "name ", $self->name, "\n";
+	print $fd "category ", $self->category, "\n";
+	if (defined($self->{'depends'})) {
+		foreach (@{$self->{'depends'}}) {
+			print $fd "depend $_\n";
+		}
+	}
+	if (defined($self->{'executes'})) {
+		foreach (@{$self->{'executes'}}) {
+			print $fd "execute $_\n";
+		}
+	}
+	if (defined($self->{'docfiles'}) && (@{$self->{'docfiles'}})) {
+		print $fd "docfiles\n";
+		foreach (sort @{$self->{'docfiles'}}) {
+			print $fd " $_\n";
+		}
+	}
+	if (defined($self->{'srcfiles'}) && (@{$self->{'srcfiles'}})) {
+		print $fd "srcfiles\n";
+		foreach (sort @{$self->{'srcfiles'}}) {
+			print $fd " $_\n";
+		}
+	}
+	if (defined($self->{'runfiles'}) && (@{$self->{'runfiles'}})) {
+		print $fd "runfiles\n";
+		foreach (sort @{$self->{'runfiles'}}) {
+			print $fd " $_\n";
+		}
+	}
+	foreach my $arch (sort keys %{$self->{'binfiles'}}) {
+		if (@{$self->{'binfiles'}{$arch}}) {
+			print $fd "binfiles arch=$arch\n";
+			foreach (sort @{$self->{'binfiles'}{$arch}}) {
+				print $fd " $_\n";
+			}
+		}
+	}
+}
+
+
 sub make_zip {
 	my ($self,$tltree,$destdir,$zipname) = @_;
 	my $zipn;
@@ -347,6 +398,11 @@ sub name {
 	if (@_) { $self->{'name'} = shift }
 	return $self->{'name'};
 }
+sub category {
+	my $self = shift;
+	if (@_) { $self->{'category'} = shift }
+	return $self->{'category'};
+}
 sub shortdesc {
 	my $self = shift;
 	if (@_) { $self->{'shortdesc'} = shift }
@@ -423,12 +479,12 @@ sub runsize {
 }
 sub add_runfiles {
 	my ($self,@files) = @_;
-	push @{ $self->{'runfiles'} }, @files;
+	&TLUtils::push_uniq(\@{ $self->{'runfiles'} }, @files);
 }
 sub add_files {
 	my ($self,$type,@files) = @_;
 	die("Cannot use add_files for binfiles, we need that arch!") if ($type eq "bin");
-	push @{ $self->{"${type}files"} }, @files;
+	&TLUtils::push_uniq(\@{ $self->{"${type}files"} }, @files);
 }
 sub depends {
 	my $self = shift;
diff --git a/new-infra/TLSRC.pm b/new-infra/TLSRC.pm
index 4229bc6f8ad..04cba813d7d 100644
--- a/new-infra/TLSRC.pm
+++ b/new-infra/TLSRC.pm
@@ -19,6 +19,7 @@ sub new {
 	my %params = @_;
 	my $self = {
 		name        => $params{'name'},
+		category    => defined($params{'category'}) ? $params{'category'} : "Package",
 		shortdesc   => $params{'shortdesc'},
 		longdesc    => $params{'longdesc'},
 		catalogue   => $params{'catalogue'},
@@ -42,6 +43,8 @@ sub from_file {
 	my @lines = <TMP>;
 	close(TMP);
 	my $name = "";
+	# default category = Package
+	my $category = "Package";
 	my $shortdesc = "";
 	my $longdesc= "";
 	my $catalogue = "";
@@ -79,15 +82,19 @@ sub from_file {
 		} else {
 			$started || die("First directive needs to be 'name'");
 			if ($line =~ /^shortdesc\s*(.*)$/) {
-				$shortdesc .= "$1 ";
+				$shortdesc = "$1";
 				$lastcmd = "shortdesc";
 				next;
+			} elsif ($line =~ /^category\s+(Package|TLCore|Documentation)$/) {
+				$category = "$1";
+				$lastcmd = "category";
+				next;
 			} elsif ($line =~ /^longdesc\s+(.*)$/) {
 				$longdesc .= "$1 ";
 				$lastcmd = "longdesc";
 				next;
 			} elsif ($line =~ /^catalogue\s+(.*)$/) {
-				$catalogue .= "$1 ";
+				$catalogue = "$1";
 				$lastcmd = "catalogue";
 				next;
 			} elsif ($line =~ /^runpatterns\s+(.*)$/) {
@@ -115,11 +122,13 @@ sub from_file {
 				$lastcmd = "depend";
 				next;
 			} else {
-				die("Unknown directive ...$line... in $_[0], please fix it!");
+				#die("Unknown directive ...$line... in $_[0], please fix it!");
+				print STDERR "Unknown directive ...$line... in $_[0], please fix it!\n";
 			}
 		}
 	}
 	$self->name("$name");
+	$self->category("$category");
 	$self->catalogue($catalogue ne "" ? "$catalogue" : "$name");
 	$self->shortdesc("$shortdesc") if ($shortdesc ne "");
 	$self->longdesc("$longdesc") if ($longdesc ne "");
@@ -136,6 +145,7 @@ sub writeout {
 	my $fd = (@_ ? $_[0] : STDOUT);
 	format_name $fd "multilineformat";
 	print $fd "name ", $self->name, "\n";
+	print $fd "category ", $self->category, "\n";
 	print $fd "catalogue $self->{'catalogue'}\n";
 	defined($self->{'shortdesc'}) && print $fd "shortdesc $self->{'shortdesc'}\n";
 	if (defined($self->{'longdesc'})) {
@@ -189,15 +199,21 @@ sub make_tlp {
 	        (defined($self->{'srcpatterns'})) ||
 			(defined($self->{'docpatterns'})) ||
 			(defined($self->{'binpatterns'})) )) {
-		foreach my $md (qw/bibtex context dvips fonts makeindex metafont
-							metapost mft omega scripts tex vtex/) {
-			push @{$self->{'runpatterns'}}, "t texmf-dist $md $self->{'name'}";
+		if ($self->category eq "Package") {
+			foreach my $md (qw/bibtex context dvips fonts makeindex metafont
+								metapost mft omega scripts tex vtex/) {
+				push @{$self->{'runpatterns'}}, "t texmf-dist $md $self->{'name'}";
+			}
+			push @{$self->{'docpatterns'}}, "t texmf-dist doc $self->{'name'}";
+			push @{$self->{'srcpatterns'}}, "t texmf-dist source $self->{'name'}"; 
+		} elsif ($self->category eq "Documentation") {
+			push @{$self->{'docpatterns'}}, "t texmf-doc doc $self->{'name'}";
+			push @{$self->{'srcpatterns'}}, "t texmf-doc source $self->{'name'}"; 
 		}
-		push @{$self->{'docpatterns'}}, "t texmf-dist doc $self->{'name'}";
-		push @{$self->{'srcpatterns'}}, "t texmf-dist source $self->{'name'}"; 
 	}
 	my $tlp = TLP->new;
 	$tlp->name($self->name);
+	$tlp->category($self->category);
 	$tlp->shortdesc($self->{'shortdesc'}) if (defined($self->{'shortdesc'}));
 	$tlp->longdesc($self->{'longdesc'}) if (defined($self->{'longdesc'}));
 	$tlp->catalogue($self->{'catalogue'}) if (defined($self->{'catalogue'}));
@@ -254,6 +270,11 @@ sub name {
 	if (@_) { $self->{'name'} = shift }
 	return $self->{'name'};
 }
+sub category {
+	my $self = shift;
+	if (@_) { $self->{'category'} = shift }
+	return $self->{'category'};
+}
 sub shortdesc {
 	my $self = shift;
 	if (@_) { $self->{'shortdesc'} = shift }
diff --git a/new-infra/TLTREE.pm b/new-infra/TLTREE.pm
index 685a1562dc6..d6b672a2e9c 100644
--- a/new-infra/TLTREE.pm
+++ b/new-infra/TLTREE.pm
@@ -222,9 +222,9 @@ sub _get_files_matching_glob_pattern {
 	my @returnfiles;
 	my $dirpart = TLUtils::dirname($globline);
 	my $basepart = TLUtils::basename($globline);
-	$basepart =~ s/\./\\./;
-	$basepart =~ s/\*/.*/;
-	$basepart =~ s/\?/./;
+	$basepart =~ s/\./\\./g;
+	$basepart =~ s/\*/.*/g;
+	$basepart =~ s/\?/./g;
 	return unless (defined($self->{'_filesofdir'}{$dirpart}));
 	my @candfiles = @{$self->{'_filesofdir'}{$dirpart}};
 	foreach my $f (@candfiles) {
diff --git a/new-infra/etc/create-tlsrc-from-tpm.pl b/new-infra/etc/create-tlsrc-from-tpm.pl
index 0315815925b..f956561b566 100755
--- a/new-infra/etc/create-tlsrc-from-tpm.pl
+++ b/new-infra/etc/create-tlsrc-from-tpm.pl
@@ -221,15 +221,21 @@ sub load_collection_tpm_data {
 sub create_tlsrc_files {
 	print "Creating tlsrc files TpmData\n\n";
 	#foreach my $t ('TLCore', 'Documentation', 'Package') {
-	foreach my $t ('TLCore') {
+	foreach my $t ('TLCore', 'Documentation') {
 		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";
-			print FOO "shortdesc $TpmData{$t}{$p}{'Title'}\n";
-			$_tmp = "longdesc $TpmData{$t}{$p}{'Description'}";
-			write FOO;
+			print FOO "category $t\n";
+			if ($TpmData{$t}{$p}{'Title'} !~ /^[[:space:]]*$/) {
+				print FOO "shortdesc $TpmData{$t}{$p}{'Title'}\n";
+			}
+			$_tmp = "$TpmData{$t}{$p}{'Description'}";
+			if (defined($_tmp) && ($_tmp !~ /^[[:space:]]*$/)) {
+				$_tmp = "longdesc $_tmp";
+				write FOO;
+			}
 			#print FOO "longdesc $TpmData{$t}{$p}{'Description'}\n";
 			foreach my $foo (@{$TpmData{$t}{$p}{'Package'}}) {
 				print FOO "depend $foo\n";
@@ -247,6 +253,7 @@ sub create_tlsrc_files {
 				print FOO "docpatterns f $foo\n";
 			}
 			foreach my $foo (@{$TpmData{$t}{$p}{'RunPatterns'}}) {
+				next if ($foo =~ /\.tpm$/);
 				print FOO "runpatterns f $foo\n";
 			}
 			foreach my $ex (@{$TpmData{$t}{$p}{'Installation'}}) {
diff --git a/new-infra/etc/read-tpm-dump-tpl.pl b/new-infra/etc/read-tpm-dump-tpl.pl
index 892b40a4529..eab4b8afbfc 100755
--- a/new-infra/etc/read-tpm-dump-tpl.pl
+++ b/new-infra/etc/read-tpm-dump-tpl.pl
@@ -194,7 +194,11 @@ sub load_collection_tpm_data {
 			$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") ];
+			foreach my $a (@Tpm::ArchList) {
+				${Tpm::CurrentArch} = $a;
+				$TpmData{$t}{$shortn}{'BinFiles'}{$a} = [ $tpm->getFileList("BinFiles") ];
+			}
+			#$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") ];
@@ -217,23 +221,24 @@ sub load_collection_tpm_data {
 
 sub dump_tpm_data {
 	print "Dumping TpmData\n\n";
-	#foreach my $t ('TLCore', 'Documentation', 'Package') {
-	foreach my $t ('Package') {
+	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";
+			print FOO "category $t\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";
 			}
-			foreach my $foo (@{$TpmData{$t}{$p}{'TLCore'}}) {
-				print FOO "depend $foo\n";
-			}
 			my @foo;
 			@foo = @{$TpmData{$t}{$p}{'DocFiles'}};
 			if ($#foo >= 0) {
@@ -249,18 +254,11 @@ sub dump_tpm_data {
 					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; }
+					next if ($foo =~ /\.tpm$/);
 					print FOO " $foo\n";
 				}
 			}
@@ -271,6 +269,15 @@ sub dump_tpm_data {
 					print FOO " $foo\n";
 				}
 			}
+			foreach my $a (sort @Tpm::ArchList) {
+				@foo = @{$TpmData{$t}{$p}{'BinFiles'}{$a}};
+				if ($#foo >= 0) {
+					print FOO "binfiles arch=$a\n";
+					foreach my $foo (sort @foo) {
+						print FOO " $foo\n";
+					}
+				}
+			}
 			close(FOO);
 		}
 	}