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

# script TODO:
# - generate initialization function to read vals from env vars
# - deal with string escaping in generated C strings
# - sort/collate cvars by name/category

use strict;
use warnings;

# help perl find the YAML parsing module
use lib 'maint/local_perl/lib';

use YAML::Tiny qw();
use File::Basename qw(basename);
use Data::Dumper;
use Getopt::Long;

# I'm pretty sure this is a standard lib module across all perl5
# installs, but we can work around this easily if that doesn't turn out
# to be true. [goodell@ 2010-04-26]
use Digest::MD5 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;

# 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";

# cvar description file
my $cvar_file = "src/util/cvar/cvars.yml";

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

GetOptions(
    "help!"       => \&print_usage_and_exit,
    "debug!"      => \$debug,
    "namespace=s" => \$ns,
    "alt-namespace=s" => \$alt_ns,
    "param-file"  => \$cvar_file,
    "header=s"    => \$header_file,
    "c-file=s"    => \$c_file,
    "readme-file=s" => \$readme_file,
) or die "unable to parse options, stopped";

sub print_usage_and_exit {
    print <<EOT;
Usage: $0 [OPTIONS]

Supported options:

    --help            - this output
    --debug           - enable some debugging output
    --namespace=STR   - use STR as variable/type prefix in generated code
    --param-file=FILE - use FILE as input describing cvars

EOT
    exit 1;
}

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

########################################################################
# read the config file and turn it into a perl hash/array object

# NOTE: if multiple configuration files are supported in the future,
# this is the place that should be modified to read them all in and
# merge them into a single consistent configuration object

my $yaml = YAML::Tiny->new();
my $cvars = ($yaml->read($cvar_file))->[0]; # [0] is for the first document
print Dumper($cvars)."\n" if $debug;
die "not a HASH, stopped" unless ref($cvars) eq "HASH";

########################################################################
# validate the config file

# only simple checks for now, just make sure that all categories
# referenced by cvars actually exist
my %cat_hash = (map { ($_->{name} => 1) } @{$cvars->{categories}});
foreach my $p (@{$cvars->{cvars}}) {
    unless (exists $cat_hash{$p->{category}}) {
        warn "category '".$p->{category}."' referenced by '".$p->{name}."' was not found";
    }
}

########################################################################
# setup output files
open(CVAR_HDR,    '>', $header_file);
open(CVAR_C,      '>', $c_file);
open(CVAR_README, '>', $readme_file);

my $hdr_guard = header_to_incl_guard($header_file);
my $cvar_file_md5 = md5sum($cvar_file);

print CVAR_HDR <<EOT;
/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */
/*
 *  (C) 2011 by Argonne National Laboratory.
 *      See COPYRIGHT in top-level directory.
 */
/* automatically generated
 *   by:   $0
 *   on:   $run_timestamp
 *   from: $cvar_file (md5sum $cvar_file_md5)
 *
 * DO NOT EDIT!!!
 */

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

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

EOT

print CVAR_C <<EOT;
/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */
/*
 *  (C) 2011 by Argonne National Laboratory.
 *      See COPYRIGHT in top-level directory.
 */
/* automatically generated
 *   by:   $0
 *   at:   $run_timestamp
 *   from: $cvar_file (md5sum $cvar_file_md5)
 *
 * DO NOT EDIT!!!
 */

#include "mpiimpl.h"

EOT

print CVAR_README <<EOT;
(C) 2011 by Argonne National Laboratory.
    See COPYRIGHT in top-level directory.

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

########################################################################
# now the actual cvars
die "missing 'cvars', stopped" unless exists $cvars->{cvars};

print CVAR_HDR <<EOT;
/* 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

# XXX DJG TODO collate and separate by category
foreach my $p (@{$cvars->{cvars}}) {
    printf CVAR_HDR "extern %s ${uc_ns}_%s;\n",
        type2ctype($p->{type}), $p->{name};
}

print CVAR_C "/* actual storage for cvars */\n";

foreach my $p (@{$cvars->{cvars}}) {
    my $default;
    if ($p->{type} eq "string") {
        # handle strings specially to avoid various const issues
        $default = fmt_default($p->{name}, undef, "NULL", $p->{type});
    }
    else {
        $default = fmt_default($p->{name}, $p->{default}, $p->{defaultliteral}, $p->{type});
    }

    if ($p->{class} eq "device") {
	printf CVAR_C "#if defined MPID_%s\n", $p->{name};
	printf CVAR_C "%s ${uc_ns}_%s = MPID_%s;\n", type2ctype($p->{type}), $p->{name},
	               $p->{name};
	printf CVAR_C "#else\n";
    }
    printf CVAR_C "%s ${uc_ns}_%s = %s;\n", type2ctype($p->{type}), $p->{name}, $default;
    if ($p->{class} eq "device") {
	printf CVAR_C "#endif /* MPID_%s */\n\n", $p->{name};
    }
}

# FIXME the mpi_errno bit is MPICH-specific
print CVAR_C <<EOT;

#undef FUNCNAME
#define FUNCNAME ${fn_ns}_init
#undef FCNAME
#define FCNAME MPIU_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

foreach my $p (@{$cvars->{cvars}}) {
    my $count = 1;
    my $mpi_dtype;
    if ($p->{type} eq 'string') {
        $mpi_dtype = "MPI_CHAR";
        $count = "MPIR_CVAR_MAX_STRLEN";
        my $str_val = fmt_default($p->{name}, $p->{default}, $p->{defaultliteral}, $p->{type});
        printf CVAR_C qq(    defaultval.str = (char *)%s;\n), $str_val;
    }
    elsif ($p->{type} eq 'int' or $p->{type} eq 'boolean') {
        $mpi_dtype = "MPI_INT";
        $count = 1;
        my $int_val = fmt_default($p->{name}, $p->{default}, $p->{defaultliteral}, $p->{type});
        printf CVAR_C qq(    defaultval.d = %s;\n), $int_val;
    }
    elsif ($p->{type} eq 'unsigned') {
        $mpi_dtype = "MPI_UNSINGED";
        $count = 1;
        my $double_val = fmt_default($p->{name}, $p->{default}, $p->{defaultliteral}, $p->{type});
        printf CVAR_C qq(    defaultval.u = %s;\n), $double_val;
    }
    elsif ($p->{type} eq 'unsigned long') {
        $mpi_dtype = "MPI_DOUBLE";
        $count = 1;
        my $double_val = fmt_default($p->{name}, $p->{default}, $p->{defaultliteral}, $p->{type});
        printf CVAR_C qq(    defaultval.ul = %s;\n), $double_val;
    }
    elsif ($p->{type} eq 'unsigned long long') {
        $mpi_dtype = "MPI_DOUBLE";
        $count = 1;
        my $double_val = fmt_default($p->{name}, $p->{default}, $p->{defaultliteral}, $p->{type});
        printf CVAR_C qq(    defaultval.ull = %s;\n), $double_val;
    }
    elsif ($p->{type} eq 'double') {
        $mpi_dtype = "MPI_DOUBLE";
        $count = 1;
        my $double_val = fmt_default($p->{name}, $p->{default}, $p->{defaultliteral}, $p->{type});
        printf CVAR_C qq(    defaultval.d = %s;\n), $double_val;
    }
    elsif ($p->{type} eq 'range') {
        $mpi_dtype = "MPI_INT";
        $count = 2;
        my $range_val = fmt_default($p->{name}, $p->{default}, $p->{defaultliteral}, $p->{type});
        printf CVAR_C qq(    {\n);
        printf CVAR_C qq(        MPIR_T_cvar_range_value_t tmp = %s;\n), $range_val;
        printf CVAR_C qq(        defaultval.range = tmp;\n);
        printf CVAR_C qq(    }\n);
    }
    else {
        die "unknown type $p->{type}, stopped";
    }

    my $desc = $p->{description};
    $desc =~ s/"/\\"/g;

    printf CVAR_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 CVAR_C <<EOT;
    ${uc_ns}_GET_DEFAULT_STRING(${uc_ns}_$p->{name}, &tmp_str);
EOT
    }

    my $env_fn = type_to_env_fn($p->{type});
    my @env_names = ();
    my $var_name = "${uc_ns}_" . $p->{name};

    # process extra envs first so the primary always wins
    push @env_names, @{$p->{'abs-alt-env'}} if $p->{'abs-alt-env'};
    push @env_names, map { "${dep_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, "${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 CVAR_C <<EOT;
    rc = MPL_env2${env_fn}("$env_name", &($var_name.low), &($var_name.high));
    MPIU_ERR_CHKANDJUMP1((-1 == rc),mpi_errno,MPI_ERR_OTHER,"**envvarparse","**envvarparse %s","$env_name");
EOT
        }
        elsif ($p->{type} eq 'string') {
            print CVAR_C <<EOT;
    rc = MPL_env2${env_fn}("$env_name", &tmp_str);
    MPIU_ERR_CHKANDJUMP1((-1 == rc),mpi_errno,MPI_ERR_OTHER,"**envvarparse","**envvarparse %s","$env_name");
EOT
        }
        else {
            print CVAR_C <<EOT;
    rc = MPL_env2${env_fn}("$env_name", &($var_name));
    MPIU_ERR_CHKANDJUMP1((-1 == rc),mpi_errno,MPI_ERR_OTHER,"**envvarparse","**envvarparse %s","$env_name");
EOT
        }
    }
    if ($p->{type} eq 'string') {
        print CVAR_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 CVAR_C "\n";
}

foreach my $cat (@{$cvars->{categories}}) {
    my $desc = $cat->{description};
    $desc =~ s/"/\\"/g;
    printf CVAR_C qq(    MPIR_T_cat_add_desc(%s\n%s);\n\n),
        qq("$cat->{name}",),
        qq(        "$desc");
}

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

EOT

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

EOT

foreach my $p (@{$cvars->{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 CVAR_C <<EOT;
    if (${var_name} != NULL) {
        MPIU_Free(${var_name});
        ${var_name} = NULL;
    }

EOT
    }
}


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

EOT

foreach my $p (@{$cvars->{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, 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, @{$p->{'abs-alt-env'}} if $p->{'abs-alt-env'};

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

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

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


########################################################################
# clean up

close(CVAR_C);

print CVAR_HDR <<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 (4096)

/* helper macros for safely getting the default value of a cvar */
EOT

print CVAR_HDR <<EOT;
#endif /* $hdr_guard */
EOT
close(CVAR_HDR);

print CVAR_README <<EOT;
---------------------------------------------------------------------------

Automatically generated
  by:   $0
  at:   $run_timestamp
  from: $cvar_file (md5sum $cvar_file_md5)

EOT
close(CVAR_README);

########################################################################
# helper subroutines

# 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 fmt_default {
    my $name = shift;
    my $val = shift;
    my $literalval = shift;
    my $type = shift;

    if (defined($literalval)) {
        die "Both \"default\" and \"defaultliteral\" fields were specified for cvar \"$name\", stopped" if defined($val);
        return qq($literalval);
    }

    die "Exactly one of \"default\" or \"defaultliteral\" fields must be specified for cvar \"$name\", stopped" unless defined($val);

    if ($type eq "string") {
        $val =~ s/"/\\"/g;
        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 foo_BAR-baz.h into FOO_BAR_BAZ_H_INCLUDED
sub header_to_incl_guard {
    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 md5sum {
    my $file = shift;
    my $md5 = Digest::MD5->new();

    open FILE, '<', $file;
    binmode(FILE);
    $md5->addfile(*FILE);
    close FILE;

    return $md5->hexdigest;
}

sub type_to_env_fn {
    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};
}

