#! /usr/bin/env perl
# (Tested with -w; 2/23/07)
# 
# Find the parse.sub routine.

use warnings;

my $maintdir = "maint";
my $rootdir  = ".";
if ( ! -s "maint/parse.sub" ) {
    my $program = $0;
    $program =~ s/extractparms//;
    if (-s "$program/parse.sub") {
	$maintdir = $program;
	$rootdir  = $program;
	$rootdir  =~ s/\/maint//g;
	print "Rootdir = $rootdir\n" if $debug;
    }
}
require "$maintdir/parse.sub";

$debug = 0;
$showfiles = 0;
$quiet = 0;
$wwwFormat = 1;
$wwwFullpage = 1;
# params has key "name" and value envname:filename:description
%params = ();

# Strict is used to control checking of error message strings.
$gStrict = 0;
if (defined($ENV{"DEBUG_STRICT"})) { $gStrict = 1; }

# Check for special args
@files = ();
%skipFiles = ();
$outfile = "";
foreach $arg (@ARGV) {
    if ($arg =~ /^-showfiles/) { $showfiles = 1; }
    elsif( $arg =~ /-debug/) { $debug = 1; }
    elsif( $arg =~ /-quiet/) { $quiet = 1; }
    elsif( $arg =~ /-outfile=(.*)/) { $outfile = $1; }
    elsif( $arg =~ /-strict/)  { $gStrict = 1; }
    elsif( $arg =~ /-skip=(.*)/) { $skipFiles{$1} = 1; }
    else {
	print "Adding $arg to files\n" if $debug;
	if (-d $arg) {
	    # Add all .c files from directory $arg to the list of files 
	    # to process (this lets us shorten the arg list)
	    @files = (@files, &ExpandDir( $arg ));
	}
	else {
	    $files[$#files+1] = $arg;
	}
    }
}
# End of argument processing

# Setup the basic file for errnames - Now determined in ExpandDirs
#@errnameFiles = ( "$rootdir/src/mpi/errhan/errnames.txt" );

if ($outfile ne "") {
    $OUTFD = "MyOutFile";
    open( $OUTFD, ">$outfile" ) or die "Could not open $outfile\n";
}
else {
    $OUTFD = STDOUT;
}
# Setup before processing the files

# Process the definitions
foreach $file (@files) {
    print "$file\n" if $showfiles;
    &ProcessFile( $file );
}

# Create the output files from the input that we're read
if ($wwwFormat) {
    &OutputWebpage;
}


#-----------------------------------------------------------------------------
# ROUTINES
# ----------------------------------------------------------------------------

# ==========================================================================
# Call this for each file
# This reads a C source or header file and adds does the following:
#
$filename = "";    # Make global so that other routines can echo filename
sub ProcessFile
{ 
    # Leave filename global for AddTest
    $filename = $_[0];
    my $linecount = 0;
    open (FD, "<$filename" ) or die "Could not open $filename\n";

    while (<FD>) {
	$linecount++;
	# Next, remove any comments
	$_ = StripComments( FD, $_ );
	# Skip the definition of the function
	if (/int\s+MPIU_Param_/) { $remainder = ""; next; }
	# Match the known routines and macros.
	# MPIU_Param_register( const char name[], const char envname[], 
        #                 const char description[] )
	%KnownErrRoutines = ( 'MPIU_Param_register'      => '0:1:2',
			      );
	while (/(MPIU_Param_[a-z0-9_]+)\s*(\(.*)$/) {
	    my $routineName = $1;
	    my $arglist     = $2;
	    if (!defined($KnownErrRoutines{$routineName})) {
		print "Skipping $routineName\n" if $debug;
		last;
	    }
	    print "Found $routineName\n" if $debug;
	    my ($nameArgLoc,$envnameArgLoc,$descripArgLoc) = 
		split(/:/,$KnownErrRoutines{$routineName});

	    ($leader, $remainder, @args ) = &GetSubArgs( FD, $arglist );
	    # Discard leader 
	    if ($debug) {
		print "Line begins with $leader\n";   # Use $leader to keep -w happy
		foreach $arg (@args) {
		    print "|$arg|\n";
		}
	    }
	    # Process the signature
	    
	    # if signature does not match new function prototype, then skip it
	    if ($#args < $descripArgLoc) {
		if (!defined($bad_syntax_in_file{$filename})) {
		    $bad_syntax_in_file{$filename} = 1;
		    print STDERR "Warning: $routineName call with too few arguments in $filename\n";
		}
		next;
	    }
	    my $name    = $args[$nameArgLoc];
	    my $envname = $args[$envnameArgLoc];
	    my $descrip = $args[$descripArgLoc];
	    $name =~ s/^\"//; $name =~ s/\"$//;
	    $envname =~ s/^\"//; $envname =~ s/\"$//;
	    $descrip =~ s/^\"//; $descrip =~ s/\"$//;
	    $params{$name} = "$envname:$filename:$descrip";

	    # Temp for debugging
	    #print STDOUT "$name\t$envname\t$descrip\n";
	}
	continue
        {
            $_ = $remainder;
        }
    }		
    close FD;
}

# Get all of the .c files from the named directory, including any subdirs
# Also, add any errnames.txt files to the errnamesFiles arrays
sub ExpandDir {
    my $dir = $_[0];
    my @otherdirs = ();
    my @files = ();
    opendir DIR, "$dir";
    while ($filename = readdir DIR) {
	if ($filename =~ /^\./ || $filename eq ".svn") {
	    next;
	}
	elsif (-d "$dir/$filename") {
	    $otherdirs[$#otherdirs+1] = "$dir/$filename";
	}
	elsif ($filename =~ /(.*\.[chi])$/) {
	    # Test for both Unix- and Windows-style directory separators
	    if (!defined($skipFiles{"$dir/$filename"}) &&
		!defined($skipFiles{"$dir\\$filename"})) {
		$files[$#files + 1] = "$dir/$filename";
	    }
	}
	elsif ($filename eq "errnames.txt") {
	    $errnameFiles[$#errnameFiles+1] = "$dir/$filename";
	}
    }
    closedir DIR;
    # (almost) tail recurse on otherdirs (we've closed the directory handle,
    # so we don't need to worry about it anymore)
    foreach $dir (@otherdirs) {
	@files = (@files, &ExpandDir( $dir ) );
    }
    return @files;
}


sub OutputWebpage {
    if ($wwwFullpage) {
	print $OUTFD "<html>\n<head>\n<title>Parameters for MPICH2</title></head>\n";
	print $OUTFD "<body>\n<h2>Parameters for MPICH2</h2>\r\n";
    }
    &OutputWebbody;
    if ($wwwFullpage) {
	print $OUTFD "</body>\n</html>\r\n";
    }
}

sub OutputWebbody {
    print $OUTFD "<dl>\n";
    foreach my $key (sort(keys(%params))) {
	my ($envname, $filename, $descript);
	if ($params{$key} =~ /^([^:]*):([^:]*):(.*)/) {
	    $envname  = $1;
	    $filename = $2;
	    $descript = $3;

	    print STDOUT "<dt>$key ($envname)\n<dd>$descript\n";
	}
    }
    print $OUTFD "</dl>\n";
}