#!/usr/bin/env perl
#
# (C) 2011by Argonne National Laboratory.
#     See COPYRIGHT in top-level directory.
#

# Parse C or header files to search for MPI_T control variable
# and category info, then output the info in source code form.

use strict;
use warnings;
use File::Basename qw(basename);
use Data::Dumper;
use Getopt::Long;

# Help perl find the YAML parsing module
use lib '@abs_srcdir@/local_perl/lib';
use YAML::Tiny qw();

# To format README file
use Text::Wrap;
$Text::Wrap::unexpand = 0; # disable hard tabs in output

##################################################

# set true to enable debug output
my $debug = 0;
my @cvars = ();
my @categories=();
my $yaml = YAML::Tiny->new();
my @dirs = ();
my @cfiles = ();
my %skipfiles = ();

# namespace prefix for function names
my $fn_ns = "MPIR_T_cvar";
# namespace prefix for variable and type names
my $ns = "MPIR_CVAR";
# an alternative namespace used for environment variables, unused if set to ""
my $alt_ns = "MPIR_PARAM";
# deprecated prefix for backward compatibility
my $dep_ns = "MPICH";
# MVAPICH2-specific prefix
my $mv2_ns = "MV2";

# Default :output source files
my $header_file = "@abs_srcdir@/../src/include/mpich_cvars.h";
my $c_file      = "@abs_srcdir@/../src/util/cvar/mpich_cvars.c";
my $readme_file = "@abs_srcdir@/../README.envvar";

sub Usage {
    print <<EOT;

Usage: $0 [OPTIONS]

Supported options:
    --help              - this output (optional)
    --debug             - enable some debugging output (optional)
    --namespace=STR     - use STR as variable/type prefix in generated code (optional, default=$ns)
    --alt-namespace=STR - use STR as alternaive variable/type prefix in generated code (optional, default=$alt_ns)
    --header=STR        - specify the header file name (optional, default=$header_file)
    --c-file=STR        - specify the C file name (optional, default=$c_file)
    --readme-file=STR   - specify the readme file name (optional, default=$readme_file)
    --dirs=STR          - recursively parse C or header files under the directories as specified
    --skip=STR          - skip parsing files as specified (optional)

EOT
    exit 1;
}

# Step 1: Process options
my $dirline;
my $skipline = "";
GetOptions(
    "help!"           => \&Usage,
    "debug!"          => \$debug,
    "namespace=s"     => \$ns,
    "alt-namespace=s" => \$alt_ns,
    "header=s"        => \$header_file,
    "c-file=s"        => \$c_file,
    "readme-file=s"   => \$readme_file,
    "dirs=s"          => \$dirline,
    "skips=s"         => \$skipline
) or Usage();

Usage unless $dirline;

print "dirline = $dirline\n" if $debug;
@dirs = split(/[:,;\s]+/, $dirline);

my @skips = split(/[:,;\s]+/, $skipline);
%skipfiles = map {$_ => 1} @skips;

# Step 2: Search all cfiles and put them in @cfiles.
foreach my $dir (@dirs) {
    ExpandDir($dir);
}

# Step 3: Parse each cfile and put results in  @cvars and @categories.
foreach my $cfile (@cfiles) {
    ProcessFile($cfile);
}

# Step 4: Preprocess cvars:
# *) Make sure that all categories referenced by cvars actually exist
# *) Strip out the prefix of their name (normally, MPIR_CVAR)
die "missing 'cvars', stopped" unless (@cvars);
my %cat_hash = map {$_->{name} => 1} @categories;

foreach my $p (@cvars) {
    unless (exists $cat_hash{$p->{category}}) {
        warn "Category '".$p->{category}."' referenced by '".$p->{name}."' was not found";
    }
    $p->{name} =~ s/${ns}_//;
    if (exists $p->{'alt-env'}) {
        my @alts = split(/[:,;\s]+/, $p->{'alt-env'});
        foreach my $elmt (@alts) {
            $elmt =~ s/${ns}_//;
        }
        $p->{'alt-env'} = [@alts];
    }
}

# Step 5: Output cvars and categories
print "Categories include: \n".Dumper(@categories) if $debug;
print "Cvars include :\n".Dumper(@cvars)."\n" if $debug;

my $run_timestamp = localtime();
my $uc_ns = uc($ns);

# Setup output files
open(OUTPUT_H,      '>', $header_file);
open(OUTPUT_C,      '>', $c_file);
open(OUTPUT_README, '>', $readme_file);

#===============================================================
# Step 5.1: Dump the header file.
my $hdr_guard = Header2InclGuard($header_file);
print OUTPUT_H <<EOT;
/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */
/*
 *  (C) 2010 by Argonne National Laboratory.
 *      See COPYRIGHT in top-level directory.
 */

/* Automatically generated
 *   by:   $0
 *   on:   $run_timestamp
 *
 * DO NOT EDIT!!!
 */

#if !defined($hdr_guard)
#define $hdr_guard

#include "mpitimpl.h" /* for MPIR_T_cvar_range_value_t */

/* Initializes cvar values from the environment */
int ${fn_ns}_init(void);
int ${fn_ns}_finalize(void);

/* Extern declarations for each cvar
 * (definitions in $c_file) */

EOT

foreach my $p (@cvars) {
    printf OUTPUT_H "/* declared in $p->{location} */\n";
    printf OUTPUT_H "extern %s ${uc_ns}_%s;\n", Type2Ctype($p->{type}), $p->{name};
}

print OUTPUT_H <<EOT;

/* TODO: this should be defined elsewhere */
#define ${ns}_assert MPIU_Assert

/* Arbitrary, simplifies interaction with external interfaces like MPI_T_ */
#define ${uc_ns}_MAX_STRLEN (384)

#endif /* $hdr_guard */
EOT
close(OUTPUT_H);

#===============================================================
# Step 5.2: Dump the C file.
print OUTPUT_C <<EOT;
/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */
/*
 *  (C) 2010 by Argonne National Laboratory.
 *      See COPYRIGHT in top-level directory.
 */
/* automatically generated
 *   by:   $0
 *   at:   $run_timestamp
 *
 * DO NOT EDIT!!!
 */

#include "mpiimpl.h"

/* Actual storage for cvars */
EOT
# Output the definitions
foreach my $p (@cvars) {
    my $default = FmtDefault($p->{name}, $p->{default}, $p->{type});

    if ($p->{class} eq 'device') {
        printf OUTPUT_C "#if defined MPID_%s\n", $p->{name};
        printf OUTPUT_C "%s ${uc_ns}_%s = MPID_%s;\n", Type2Ctype($p->{type}), $p->{name},
                       $p->{name};
        printf OUTPUT_C "#else\n";
    }

    if ($p->{type} eq 'string') {
        printf OUTPUT_C "%s ${uc_ns}_%s = (char*)%s;\n", Type2Ctype($p->{type}), $p->{name}, $default;
    } else {
        printf OUTPUT_C "%s ${uc_ns}_%s = %s;\n", Type2Ctype($p->{type}), $p->{name}, $default;
    }

    if ($p->{class} eq 'device') {
        printf OUTPUT_C "#endif /* MPID_%s */\n\n", $p->{name};
    }
}

# Generate the init function.
print OUTPUT_C <<EOT;

#undef FUNCNAME
#define FUNCNAME ${fn_ns}_init
#undef FCNAME
#define FCNAME MPL_QUOTE(FUNCNAME)
int ${fn_ns}_init(void)
{
    int mpi_errno = MPI_SUCCESS;
    int rc;
    const char *tmp_str;
    static int initialized = FALSE;
    MPIR_T_cvar_value_t defaultval;

    /* FIXME any MT issues here? */
    if (initialized)
        return MPI_SUCCESS;
    initialized = TRUE;

EOT

# Register categories
foreach my $cat (@categories) {
    my $desc = $cat->{description};
    $desc =~ s/"/\\"/g;
    printf OUTPUT_C qq(    /* declared in $cat->{location} */\n);
    printf OUTPUT_C qq(    MPIR_T_cat_add_desc(%s\n%s);\n\n),
        qq("$cat->{name}",),
        qq(        "$desc");
}

# Register and init cvars
foreach my $p (@cvars) {
    my $count;
    my $mpi_dtype;
    my $dftval;

    # Set count and default value of the car
    if ($p->{type} eq 'string') {
        $mpi_dtype = "MPI_CHAR";
        $count = "${uc_ns}_MAX_STRLEN";
        $dftval = FmtDefault($p->{name}, $p->{default}, $p->{type});
        printf OUTPUT_C qq(    defaultval.str = (char *)%s;\n), $dftval;
    }
    elsif ($p->{type} eq 'int' or $p->{type} eq 'boolean') {
        $mpi_dtype = "MPI_INT";
        $count = 1;
        $dftval = FmtDefault($p->{name}, $p->{default}, $p->{type});
        printf OUTPUT_C qq(    defaultval.d = %s;\n), $dftval;
    }
    elsif ($p->{type} eq 'double') {
        $mpi_dtype = "MPI_DOUBLE";
        $count = 1;
        $dftval = FmtDefault($p->{name}, $p->{default}, $p->{type});
        printf OUTPUT_C qq(    defaultval.d = %s;\n), $dftval;
    }
    elsif ($p->{type} eq 'range') {
        $mpi_dtype = "MPI_INT";
        $count = 2;
        $dftval = FmtDefault($p->{name}, $p->{default}, $p->{type});
        printf OUTPUT_C qq(    {\n);
        printf OUTPUT_C qq(        MPIR_T_cvar_range_value_t tmp = %s;\n), $dftval;
        printf OUTPUT_C qq(        defaultval.range = tmp;\n);
        printf OUTPUT_C qq(    }\n);
    }
    else {
        die "unknown type $p->{type}, stopped";
    }

    # Register the cvar
    my $desc = $p->{description};
    $desc =~ s/"/\\"/g;
    printf OUTPUT_C qq(    MPIR_T_CVAR_REGISTER_STATIC(\n%s\n%s\n%s\n%s\n%s\n%s\n%s\n%s\n%s);\n),
        qq(        $mpi_dtype,),
        qq(        ${uc_ns}_$p->{name}, /* name */),
        qq(        &${uc_ns}_$p->{name}, /* address */),
        qq(        $count, /* count */),
        qq(        $p->{verbosity},),
        qq(        $p->{scope},),
        qq(        defaultval,),
        qq(        "$p->{category}", /* category */),
        qq(        "$desc");

    if ($p->{type} eq 'string') {
print OUTPUT_C <<EOT;
    ${uc_ns}_GET_DEFAULT_STRING(${uc_ns}_$p->{name}, &tmp_str);
EOT
    }

    # Get the env variable value.
    my $env_fn = Type2EnvFn($p->{type});
    my @env_names = ();
    my $var_name = "${uc_ns}_" . $p->{name};

    # Process extra envs first so the primary always wins
    push @env_names, map { "${dep_ns}_$_" } @{$p->{'alt-env'}};
    push @env_names, map { "${mv2_ns}_$_" } @{$p->{'alt-env'}};
    push @env_names, map { "${alt_ns}_$_" } @{$p->{'alt-env'}};
    push @env_names, map { "${uc_ns}_$_" } @{$p->{'alt-env'}};
    push @env_names, "${dep_ns}_" . $p->{name};
    push @env_names, "${mv2_ns}_" . $p->{name};
    push @env_names, "${alt_ns}_" . $p->{name};
    push @env_names, "${uc_ns}_" . $p->{name};

    foreach my $env_name (@env_names) {
        # assumes rc is defined
        if ($p->{type} eq 'range') {
print OUTPUT_C <<EOT;
    rc = MPL_env2${env_fn}("$env_name", &($var_name.low), &($var_name.high));
    MPIR_ERR_CHKANDJUMP1((-1 == rc),mpi_errno,MPI_ERR_OTHER,"**envvarparse","**envvarparse %s","$env_name");
EOT
        }
        elsif ($p->{type} eq 'string') {
print OUTPUT_C <<EOT;
    rc = MPL_env2${env_fn}("$env_name", &tmp_str);
    MPIR_ERR_CHKANDJUMP1((-1 == rc),mpi_errno,MPI_ERR_OTHER,"**envvarparse","**envvarparse %s","$env_name");
EOT
        }
        else {
print OUTPUT_C <<EOT;
    rc = MPL_env2${env_fn}("$env_name", &($var_name));
    MPIR_ERR_CHKANDJUMP1((-1 == rc),mpi_errno,MPI_ERR_OTHER,"**envvarparse","**envvarparse %s","$env_name");
EOT
        }
    }
    if ($p->{type} eq 'string') {
print OUTPUT_C <<EOT;
    if (tmp_str != NULL) {
        ${var_name} = MPIU_Strdup(tmp_str);
        ${ns}_assert(${var_name});
        if (${var_name} == NULL) {
            MPIU_CHKMEM_SETERR(mpi_errno, strlen(tmp_str), "dup of string for ${var_name}");
            goto fn_fail;
        }
    }
    else {
        ${var_name} = NULL;
    }
EOT
    }
    print OUTPUT_C "\n";
}

print OUTPUT_C <<EOT;
fn_exit:
    return mpi_errno;
fn_fail:
    goto fn_exit;
}

EOT

print OUTPUT_C <<EOT;
int ${fn_ns}_finalize(void)
{
    int mpi_errno = MPI_SUCCESS;

EOT

foreach my $p (@cvars) {
    my $var_name = "${uc_ns}_" . $p->{name};

    if ($p->{type} eq 'string') {
        # Need to cleanup after whatever was strduped by the init routine
print OUTPUT_C <<EOT;
    if (${var_name} != NULL) {
        MPIU_Free(${var_name});
        ${var_name} = NULL;
    }

EOT
    }
}

print OUTPUT_C <<EOT;
fn_exit:
    return mpi_errno;
fn_fail:
    goto fn_exit;
}

EOT
close(OUTPUT_C);

#===============================================================
#Step 5.3 Dump the readme file
print OUTPUT_README <<EOT;
(C) 2010 by Argonne National Laboratory.
    See COPYRIGHT in top-level directory.

Automatically generated
  by:   $0
  at:   $run_timestamp
DO NOT EDIT!!!

This file lists the various environment variables available to change the
behavior of the MPICH library.  These are intended to be used by advanced
users.
---------------------------------------------------------------------------

EOT

foreach my $p (@cvars) {
    my @env_names = ();
    my $first;
    my $alt;
    my $default;

    # process extra envs first so the primary always wins
    push @env_names, "${alt_ns}_" . $p->{name};
    push @env_names, "${dep_ns}_" . $p->{name};
    push @env_names, "${mv2_ns}_" . $p->{name};
    push @env_names, map { "${uc_ns}_$_" } @{$p->{'alt-env'}};
    push @env_names, map { "${alt_ns}_$_" } @{$p->{'alt-env'}};
    push @env_names, map { "${dep_ns}_$_" } @{$p->{'alt-env'}};
    push @env_names, map { "${mv2_ns}_$_" } @{$p->{'alt-env'}};

    print OUTPUT_README "${uc_ns}_$p->{name}\n";

    $first = 1;
    foreach $alt (@env_names) {
        if ($first) {
            print OUTPUT_README "    Aliases: $alt\n";
        } else {
            print OUTPUT_README "             $alt\n";
        }
        $first = 0;
    }

    print OUTPUT_README wrap("    Description: ", "        ", $p->{description} . "\n");
    $default = FmtDefault($p->{name}, $p->{default}, $p->{type});
    print OUTPUT_README "    Default: $default\n";
    print OUTPUT_README "\n";
}

close(OUTPUT_README);

#===============================================================
# Helper subroutines used in this script

# Transform a cvar type to a C-language type
sub Type2Ctype {
    my $type = shift;
    my %typemap = (
        'int'     => 'int',
        'double'  => 'double',
        'string'  => 'char *',
        'boolean' => 'int',
        'range'   => "MPIR_T_cvar_range_value_t",
    );
    die "unknown type '$type', stopped" unless exists $typemap{$type};
    return $typemap{$type};
}

# Transform a default value into a C value
sub FmtDefault {
    my $name = shift;
    my $val = shift;
    my $type = shift;

    if ($type eq 'string') {
        $val =~ s/"/\\"/g;
        if ($val eq 'NULL' or $val eq 'null') { return "NULL"; }
        else { return qq("$val"); }
    }
    elsif ($type eq 'boolean') {
        if    ($val =~ m/^(0|f(alse)?|no?)$/i)   { return qq(0); }
        elsif ($val =~ m/^(1|t(rue)?|y(es)?)$/i) { return qq(1); }
        else {
            warn "WARNING: type='$type', bad val='$val', continuing";
            return qq(0); # fail-false
        }
    }
    elsif ($type eq 'range') {
        if ($val !~ "-?[0-9]+:-?[0-9]+") {
            die "Unable to parse range value '$val', stopped";
        }
        $val =~ s/:/,/;
        return qq({$val});
    }
    else {
        return qq($val);
    }
}

# turns /path/foo_BAR-baz.h into FOO_BAR_BAZ_H_INCLUDED
sub Header2InclGuard {
    my $header_file = shift;
    my $guard = basename($header_file);
    $guard =~ tr/a-z\-./A-Z__/;
    $guard .= "_INCLUDED";
    die "guard contains whitespace, stopped" if ($guard =~ m/\s/);
    return $guard;
}

sub Type2EnvFn {
    my $type = shift;
    my %typemap = (
        'int' =>  'int',
        'string' => 'str',
        'boolean' => 'bool',
        'double' => 'double',
        'range' => 'range',
    );

    die "unknown type '$type', stopped" unless exists $typemap{$type};
    return $typemap{$type};
}

# Parse a file, search the MPI_T_CVAR_INFO_BLOCK if any.
# Distill cvars and categories from the block.
# Push the results to back of @cvars and @categories respectively.
sub ProcessFile {
    my $cfile = $_[0];
    my $cvar_info_block = undef;
    my $in_cvar_info_block = 0;

    #print "Processing file $cfile\n" if $debug;
    open my $CFILE_HANDLE, "< $cfile" or die "Error: open file $cfile -- $!\n";
    while (<$CFILE_HANDLE>) {
        if (/END_MPI_T_CVAR_INFO_BLOCK/) {
            last;
        } elsif ($in_cvar_info_block) {
            $cvar_info_block .= $_;
        } elsif (/BEGIN_MPI_T_CVAR_INFO_BLOCK/) {
            $in_cvar_info_block = 1;
            print "Found MPI_T_CVAR_INFO_BLOCK in $cfile\n" if $debug;
        }
    }
    close $CFILE_HANDLE;

    # Do some checking to ensure a correct cvar info block, also
    # add file locations to help users' debugging.
    if ($cvar_info_block) {
        my $info = ($yaml->read_string($cvar_info_block))->[0];
        if (exists $info->{cvars}) {
            # Remember location where the cvar is defined. Put that into
            # comments of the generated *.h file so that users know where
            # to look when meeting compilation errors.
            foreach my $cvar (@{$info->{cvars}}) {
                $cvar->{location} = $cfile;
                die "ERROR: cvar has no name in $cfile\n" unless exists $cvar->{name};
                die "ERROR: cvar $cvar->{name} has no type in $cfile\n" unless exists $cvar->{type};
                die "ERROR: cvar $cvar->{name} has no verbosity in $cfile\n" unless exists $cvar->{verbosity};
                die "ERROR: cvar $cvar->{name} has no scope in $cfile\n" unless exists $cvar->{scope};
                die "ERROR: cvar $cvar->{name} has no class in $cfile\n" unless exists $cvar->{class};
                die "ERROR: cvar $cvar->{name} has no description in $cfile\n" unless exists $cvar->{description};
            }
            push (@cvars, @{$info->{cvars}});
        }

        if (exists $info->{categories}) {
            # Do the same trick to categories
            foreach my $cat (@{$info->{categories}}) {
                $cat->{location} = $cfile;
                die "ERROR: category has no name in $cfile\n" unless exists $cat->{name};
                die "ERROR: category $cat->{name} has no description in $cfile\n"
                    unless exists $cat->{description};
            }
            push (@categories, @{$info->{categories}});
        }
    }
}

# Search cfiles recursively in the directory passed in.
# Push file names along with their paths to back of @cfiles.
sub ExpandDir {
    my $dir = $_[0];
    my @subdirs = ();
    my $DIR_HANDLE;
    opendir $DIR_HANDLE, "$dir" or die "Error: open directory $dir -- $!\n";
    while (my $filename = readdir $DIR_HANDLE) {
        if ($filename =~ /^\./) {
            next;
        } elsif (-d "$dir/$filename") {
            $subdirs[$#subdirs + 1] = "$dir/$filename";
        } elsif ($filename =~ /(.*\.[Cchi])(pp){0,1}$/) {
            if (!defined($skipfiles{"$dir/$filename"}))
            {
                $cfiles[$#cfiles + 1] = "$dir/$filename";
            }
        }
    }
    closedir $DIR_HANDLE;

    # Recursively search subdirs
    foreach $dir (@subdirs) {
        ExpandDir($dir);
    }
}