#!/usr/bin/perl -w
#
# tlsrc2tlp.pl
# generate tlp files from tlsrc files
# (c) 2007 Norbert Preining
#
# This file is licensed under the GNU General Public Licence version 2
# (not later)

use strict;

my %tls;
my %tldb;
my $opt_debug = 0;
my %AllFiles;

my $tlpline;

&main(@ARGV);

1;




sub main {
	my (@tlsrc) = @_;
	foreach my $f (@tlsrc) {
		read_tlsrc_file($f);
	}
	initialize_all_files();
	my $ts = $#tlsrc + 1;
	my $fs = 0;
	foreach my $f (keys %tls) {
		$fs++;
		if ($fs/10 == int($fs/10)) { print "$fs from $ts\n"; }
		generate_tlp_data($f);
		write_tlp_file($f);
	}
	#foreach my $f (keys %tldb) {
	#	write_tlp_file($f);
	#}
	foreach my $f (keys %AllFiles) {
		if ($AllFiles{$f}{'used'} != 1) {
			print STDERR "Not covered file: $f\n";
		}
	}
}

sub read_tlsrc_file {
	my ($tlsrc) = @_;
	open(TMP,"<$tlsrc") || die("Cannot open $tlsrc: $!");
	my @lines = <TMP>;
	close(TMP);
	my $name = "";
	my $shortdesc = "";
	my $longdesc= "";
	my $catalogue = "";
	my (@executes, @depends);
	my (@runpatterns, @docpatterns, @binpatterns, @srcpatterns);
	my $started = 0;
	my $finished = 0;
	my $lastcmd = "";

	logit("Working on $tlsrc\n");
	foreach my $line (@lines) {
		$line =~ /^\s*#/ && next;          # skip comment lines
		if ($line =~ /^\s*$/) {
			if (!$started) { next; }
			if ($finished) { next; }
			die("No empty line allowed in tlsrc files!");
		}
		if ($line =~ /^ /) {
			if ( ($lastcmd eq "longdesc") ||
			     ($lastcmd eq "runpattern")  ||
			     ($lastcmd eq "binpattern")  ||
			     ($lastcmd eq "docpattern")  ||
			     ($lastcmd eq "srcpattern")  ||
			     ($lastcmd eq "execute")  ||
				 ($lastcmd eq "depend") ) {
				$line =~ s/^ /$lastcmd /;
			} else {
				die("Continuation of $lastcmd not allowed, please fix tlsrc!\n");
			}
		}
		if ($line =~ /^name\s*([\w-]+)$/) {
			logit("found name: $1\n");
			$name = "$1";
			$lastcmd = "name";
			$started && die("Cannot have two name directives!");
			$started = 1;
		} else {
			$started || die("First directive needs to be 'name'");
			if ($line =~ /^shortdesc\s*(.*)$/) {
				logit("found shortdesc: $1\n");
				$shortdesc .= "$1 ";
				$lastcmd = "shortdesc";
				next;
			} elsif ($line =~ /^longdesc\s*(.*)$/) {
				logit("found longdesc: $1\n");
				$longdesc .= "$1 ";
				$lastcmd = "longdesc";
				next;
			} elsif ($line =~ /^catalogue\s*(.*)$/) {
				logit("found catalogue: $1\n");
				$catalogue .= "$1 ";
				$lastcmd = "catalogue";
				next;
			} elsif ($line =~ /^runpattern\s*(.*)$/) {
				logit("found runpattern: $1\n");
				push @runpatterns, "$1";
				$lastcmd = "runpattern";
				next;
			} elsif ($line =~ /^srcpattern\s*(.*)$/) {
				logit("found srcpattern: $1\n");
				push @srcpatterns, "$1";
				$lastcmd = "srcpattern";
				next;
			} elsif ($line =~ /^docpattern\s*(.*)$/) {
				logit("found docpattern: $1\n");
				push @docpatterns, "$1";
				$lastcmd = "docpattern";
				next;
			} elsif ($line =~ /^binpattern\s*(.*)$/) {
				logit("found binpattern: $1\n");
				push @binpatterns, "$1";
				$lastcmd = "binpattern";
				next;
			} elsif ($line =~ /^execute\s*(.*)$/) {
				logit("found execute: $1\n");
				push @executes, "$1";
				$lastcmd = "execute";
				next;
			} elsif ($line =~ /^depend\s*(.*)$/) {
				logit("found depend: $1\n");
				push @depends, "$1";
				$lastcmd = "depend";
				next;
			} else {
				die("Unknown directive ...$line... in $tlsrc, please fix it!");
			}
		}
	}
	logit("Done reading the source file, filling the data structure!\n");
	if ($catalogue ne "") {
		$tls{$name}{'catalogue'} = "$catalogue";
	} else {
		$tls{$name}{'catalogue'} = "$name";
	}
	if ($shortdesc ne "") {
		$tls{$name}{'shortdesc'} = "$shortdesc";
	}
	if ($longdesc ne "") {
		$tls{$name}{'longdesc'} = "$longdesc";
	}
	if ($#srcpatterns >= 0) {
		$tls{$name}{'srcpatterns'} = [ @srcpatterns ];
	}
	if ($#runpatterns >= 0) {
		$tls{$name}{'runpatterns'} = [ @runpatterns ];
	}
	if ($#binpatterns >= 0) {
		$tls{$name}{'binpatterns'} = [ @binpatterns ];
	}
	if ($#docpatterns >= 0) {
		$tls{$name}{'docpatterns'} = [ @docpatterns ];
	}
	if ($#executes >= 0) {
		$tls{$name}{'executes'} = [ @executes ];
	}
	if ($#depends>= 0) {
		$tls{$name}{'depends'} = [ @depends ];
	}
}

sub initialize_all_files {
	foreach my $l (`svn status -v`) {
		chomp($l);
		next if ($l =~ /^\?/);		# ignore files not under version control
		if ($l =~ /^(.)(.)(.)(.)(.)(.)..\s*(\d+)\s+(\d+)\s+\w+\s+(.+)$/) {
			my $lastchanged = $8;
			my $entry = "$9";
			next if -d $entry;
			$AllFiles{$entry}{'used'} = 0;
			$AllFiles{$entry}{'lastchangedrev'} = $lastchanged;
		} else {
			die("Cannot read svn status output line: $l");
		}
	}
}

#
# possible optimizations:
# - compile perl regexps once at the beginning before entering the big loop
#   in the loop mega action
#
sub generate_tlp_data {
	my ($tlp) = @_;
	# predefined runpattern if all are missing
	# WARNING
	# Note that this will NOT NOT NOT find files in leaf directories named
	# after the package but OUTSIDE texmf-dist, so files in
	# 	texmf-doc/..../packagename/
	# will NOT be found.
	if (!(defined($tls{$tlp}{'runpatterns'}))) {
		my $l = "d texmf-dist/(bibtex|context|dvips|fonts|makeindex|metafont|metapost|mft|omega|scripts|tex|tex4ht|vtex)/.*/$tlp";
		@{$tls{$tlp}{'runpatterns'}} = ("$l");
	}
	if (!(defined($tls{$tlp}{'docpatterns'}))) {
		my $l = "d texmf-dist/doc/.*/$tlp";
		@{$tls{$tlp}{'docpatterns'}} = ("$l");
	}
	if (!(defined($tls{$tlp}{'srcpatterns'}))) {
		my $l = "d texmf-dist/source/.*/$tlp";
		@{$tls{$tlp}{'srcpatterns'}} = ("$l");
	}
	$tldb{$tlp}{'name'} = $tls{$tlp};
	if (defined($tls{$tlp}{'shortdesc'})) {
		$tldb{$tlp}{'shortdesc'} = $tls{$tlp}{'shortdesc'};
	}
	if (defined($tls{$tlp}{'longdesc'})) {
		$tldb{$tlp}{'longdesc'} = $tls{$tlp}{'longdesc'};
	}
	if (defined($tls{$tlp}{'catalogue'})) {
		$tldb{$tlp}{'catalogue'} = $tls{$tlp}{'catalogue'};
	}
	if (defined($tls{$tlp}{'executes'})) {
		$tldb{$tlp}{'executes'} = $tls{$tlp}{'executes'};
	}
	if (defined($tls{$tlp}{'depends'})) {
		$tldb{$tlp}{'depends'} = $tls{$tlp}{'depends'};
	}
	$tldb{$tlp}{'runfiles'} = [ ];
	$tldb{$tlp}{'docfiles'} = [ ];
	$tldb{$tlp}{'binfiles'} = [ ];
	$tldb{$tlp}{'srcfiles'} = [ ];
	$tldb{$tlp}{'packageversion'} = 0;
	my $filemax;
	FILELABEL: foreach my $f (keys %AllFiles) {
		$filemax = $AllFiles{$f}{'lastchangedrev'};
		foreach my $p (@{$tls{$tlp}{'runpatterns'}}) {
			if (pattern_hit($f,$p,"run")) {
				$AllFiles{$f}{'used'} = 1;
				logit("Hit\n");
				$tldb{$tlp}{'packageversion'} = $filemax > $tldb{$tlp}{'packageversion'} ? $filemax : $tldb{$tlp}{'packageversion'};
				$tldb{$tlp}{'runfiles'} = [ @{$tldb{$tlp}{'runfiles'}}, $f ];
				next FILELABEL;
			}
		}
		foreach my $p (@{$tls{$tlp}{'docpatterns'}}) {
			if (pattern_hit($f,$p,"doc")) {
				$AllFiles{$f}{'used'} = 1;
				logit("Hit\n");
				$tldb{$tlp}{'packageversion'} = $filemax > $tldb{$tlp}{'packageversion'} ? $filemax : $tldb{$tlp}{'packageversion'};
				$tldb{$tlp}{'docfiles'} = [ @{$tldb{$tlp}{'docfiles'}}, $f ];
				next FILELABEL;
			}
		}
		foreach my $p (@{$tls{$tlp}{'binpatterns'}}) {
			if (pattern_hit($f,$p,"bin")) {
				$AllFiles{$f}{'used'} = 1;
				logit("Hit\n");
				$tldb{$tlp}{'packageversion'} = $filemax > $tldb{$tlp}{'packageversion'} ? $filemax : $tldb{$tlp}{'packageversion'};
				$tldb{$tlp}{'binfiles'} = [ @{$tldb{$tlp}{'binfiles'}}, $f ];
				next FILELABEL;
			}
		}
		foreach my $p (@{$tls{$tlp}{'srcpatterns'}}) {
			if (pattern_hit($f,$p,"src")) {
				$AllFiles{$f}{'used'} = 1;
				logit("Hit\n");
				$tldb{$tlp}{'packageversion'} = $filemax > $tldb{$tlp}{'packageversion'} ? $filemax : $tldb{$tlp}{'packageversion'};
				$tldb{$tlp}{'srcfiles'} = [ @{$tldb{$tlp}{'srcfiles'}}, $f ];
				next FILELABEL;
			}
		}
	}
}

sub write_tlp_file {
	my ($tlp) = @_;
	open(TLP,">tlp/$tlp.tlp") || die("Cannot open tlp/$tlp.tlp for writing: $!");
	print TLP "name $tlp\n";
	print TLP "packageversion $tldb{$tlp}{'packageversion'}\n";
	if (defined($tldb{$tlp}{'shortdesc'})) {
		$tlpline = "shortdesc $tldb{$tlp}{'shortdesc'}";
		write TLP;
	}
	if (defined($tldb{$tlp}{'longdesc'})) {
		$tlpline = "longdesc $tldb{$tlp}{'longdesc'}";
		write TLP;
	}
	if (defined($tldb{$tlp}{'catalogue'})) {
		print TLP "catalogue $tldb{$tlp}{'catalogue'}\n";
	}
	if (defined($tldb{$tlp}{'executes'})) {
		foreach (@{$tldb{$tlp}{'executes'}}) {
			print TLP "execute $_\n";
		}
	}
	if (defined($tldb{$tlp}{'depends'})) {
		foreach (@{$tldb{$tlp}{'depends'}}) {
			print TLP "depend $_\n";
		}
	}
	my @tmp;
	@tmp = @{$tldb{$tlp}{'docfiles'}};
	if ($#tmp >= 0) {
		print TLP "docfiles\n";
		foreach (@tmp) {
			print TLP " $_\n";
		}
	}
	@tmp = @{$tldb{$tlp}{'srcfiles'}};
	if ($#tmp >= 0) {
		print TLP "srcfiles\n";
		foreach (@tmp) {
			print TLP " $_\n";
		}
	}
	@tmp = @{$tldb{$tlp}{'binfiles'}};
	if ($#tmp >= 0) {
		print TLP "binfiles\n";
		foreach (@tmp) {
			print TLP " $_\n";
		}
	}
	@tmp = @{$tldb{$tlp}{'runfiles'}};
	if ($#tmp >= 0) {
		print TLP "runfiles\n";
		foreach (@tmp) {
			print TLP " $_\n";
		}
	}
	close(TLP);
}

sub logit {
	$opt_debug && print STDERR @_;
}

sub pattern_hit {
	my ($file, $pattern, $patterntype) = @_;
	$pattern =~ /^(d|f) (.*)$/;
	my $pattype = $1;
	my $patdata = $2;
	if ($pattype eq "d") {
		#my $dirn = `dirname $file`;	# bad, should be rewritten
		#chomp($dirn);
		my $dirn = $file;
		$dirn =~ s@/[^/]*$@@;
		logit("matching >>>$patdata<<< against >>>$dirn<<<\n");
		if ($dirn =~ /^$patdata$/) {
			return 1;
		}
	} elsif ($pattype eq "f") {
		logit("matching >>>$patdata<<< against >>>$file<<<\n");
		if ($file =~ /^$patdata$/) {
			return 1;
		}
	} else {
		die("Unknown pattern specification: $pattern!");
	}
}


###### Formats
format TLP =
^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$tlpline
 ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<~~
$tlpline
.


### Local Variables:
### perl-indent-level: 4
### tab-width: 4
### indent-tabs-mode: t
### End:
# vim:set tabstop=4: #