#!/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 paramters 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 variable and type names
my $ns = "MPIR_Param";
# an alternative namespace used for environment variables, unused if set
# to ""
my $alt_ns = "MPICH";

# parameter description file
my $param_file = "src/util/param/params.yml";

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

GetOptions(
    "help!"       => \&print_usage_and_exit,
    "debug!"      => \$debug,
    "namespace=s" => \$ns,
    "alt-namespace=s" => \$alt_ns,
    "param-file"  => \$param_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 parameters

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 $params = ($yaml->read($param_file))->[0]; # [0] is for the first document
print Dumper($params)."\n" if $debug;
die "not a HASH, stopped" unless ref($params) eq "HASH";

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

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

########################################################################
# setup output files
open(PARAM_HDR,    '>', $header_file);
open(PARAM_C,      '>', $c_file);
open(PARAM_README, '>', $readme_file);

my $hdr_guard = header_to_incl_guard($header_file);
my $param_file_md5 = md5sum($param_file);

print PARAM_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: $param_file (md5sum $param_file_md5)
 *
 * DO NOT EDIT!!!
 */

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

EOT

print PARAM_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: $param_file (md5sum $param_file_md5)
 *
 * DO NOT EDIT!!!
 */

#include "mpiimpl.h"

EOT

print PARAM_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 MPICH2 library.  These are intended to be used by advanced
users.
---------------------------------------------------------------------------

EOT

########################################################################
# actually process file contents, starting w/ categories
die "missing 'categories', stopped" unless exists $params->{categories};

# write enum first
print PARAM_HDR <<EOT;
/* parameter categories */
enum ${ns}_category_id_t {
EOT
my $num_categories = scalar @{$params->{categories}};
foreach my $cat (@{$params->{categories}}) {
    printf PARAM_HDR "    ${uc_ns}_CATEGORY_ID_%s,\n", $cat->{name};
}
# then write full contents tuple
print PARAM_HDR <<EOT;
    ${uc_ns}_NUM_CATEGORIES
};

struct ${ns}_category_t {
    const enum ${ns}_category_id_t id;
    const char *name;
    const char *description;
};

/* array of category info for runtime usage */
extern struct ${ns}_category_t ${ns}_categories[${uc_ns}_NUM_CATEGORIES];

EOT

print PARAM_C <<EOT;
/* array of category info for runtime usage */
struct ${ns}_category_t ${ns}_categories[${uc_ns}_NUM_CATEGORIES] = {
EOT
foreach my $cat (@{$params->{categories}}) {
    my $desc = $cat->{description};
    $desc =~ s/"/\\"/g;
    printf PARAM_C qq(    { ) .
        qq(${uc_ns}_CATEGORY_ID_%s,\n) .
        qq(      "%s",\n) .
        qq(      "%s" },\n),
        $cat->{name}, $cat->{name}, $desc;
}
print PARAM_C <<EOT;
};

EOT


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

print PARAM_HDR <<EOT;
/* parameter values */
enum ${ns}_id_t {
EOT
my $num_params = @{$params->{parameters}};
# XXX DJG TODO collate and separate by category
foreach my $p (@{$params->{parameters}}) {
    printf PARAM_HDR "    ${uc_ns}_ID_%s,\n", $p->{name};
}
print PARAM_HDR <<EOT;
    ${uc_ns}_NUM_PARAMS
};

/* initializes parameter values from the environment */
int ${ns}_init_params(void);

int ${ns}_finalize(void);

enum ${ns}_type_t {
    ${uc_ns}_TYPE_INVALID = 0,
    ${uc_ns}_TYPE_INT,
    ${uc_ns}_TYPE_DOUBLE,
    ${uc_ns}_TYPE_BOOLEAN,
    ${uc_ns}_TYPE_STRING,
    ${uc_ns}_TYPE_RANGE
};

typedef struct ${ns}_param_range_val {
    int low;
    int high;
} ${ns}_param_range_val_t;

/* used to represent default values */
struct ${ns}_param_default_val_t {
    const enum ${ns}_type_t type;

    /* not a union b/c of initialization portability issues */
    const int i_val; /* also used for booleans */
    const double d_val;
    const char *s_val;
    const ${ns}_param_range_val_t r_val;
};

struct ${ns}_t {
    const enum ${ns}_id_t id;
    const char *name;
    const char *description;
    const struct ${ns}_param_default_val_t default_val;
    void *val_p; /* ptr to the actual value */
};

/* array of parameter info for runtime usage */
extern struct ${ns}_t ${ns}_params[${uc_ns}_NUM_PARAMS];

/* extern declarations for each parameter
 * (definitions in $c_file) */
EOT

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

print PARAM_C <<EOT;
/* array of parameter info for runtime usage */
struct ${ns}_t ${ns}_params[${uc_ns}_NUM_PARAMS] = {
EOT

# XXX DJG TODO collate and separate by category
foreach my $p (@{$params->{parameters}}) {
    my $type_enum_val = "${uc_ns}_TYPE_".uc($p->{type});
    my ($int_val, $str_val, $double_val, $range_val) = (-1, qq(""), "0.0", "{0,0}");

    if ($p->{type} eq "string") {
        $str_val = fmt_default($p->{name}, $p->{default}, $p->{defaultliteral}, $p->{type});
    }
    elsif ($p->{type} eq "int") {
        $int_val = fmt_default($p->{name}, $p->{default}, $p->{defaultliteral}, $p->{type});
    }
    elsif ($p->{type} eq "double") {
        $double_val = fmt_default($p->{name}, $p->{default}, $p->{defaultliteral}, $p->{type});
    }
    elsif ($p->{type} eq "boolean") {
        $int_val = fmt_default($p->{name}, $p->{default}, $p->{defaultliteral}, $p->{type});
    }
    elsif ($p->{type} eq "range") {
        $range_val = fmt_default($p->{name}, $p->{default}, $p->{defaultliteral}, $p->{type});
    }
    else {
        die "unknown type $p->{type}, stopped";
    }

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

    printf PARAM_C qq(    { ) .
        qq(${uc_ns}_ID_%s,\n) .
        qq(      "%s",\n) .
        qq(      "%s",\n) .
        #          T    I   D   S  R     ptr
        qq(      { %s, %s, %s, %s, %s }, %s },\n),
        $p->{name}, $p->{name}, $desc,
        $type_enum_val, $int_val, $double_val, $str_val, $range_val, "&${uc_ns}_".$p->{name};
}

print PARAM_C <<EOT;
};

/* actual storage for parameters */
EOT
foreach my $p (@{$params->{parameters}}) {
    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});
    }
    printf PARAM_C "%s ${uc_ns}_%s = %s;\n", type2ctype($p->{type}), $p->{name}, $default;
}

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

#undef FUNCNAME
#define FUNCNAME ${ns}_init_params
#undef FCNAME
#define FCNAME MPIU_QUOTE(FUNCNAME)
int ${ns}_init_params(void)
{
    int mpi_errno = MPI_SUCCESS;
    int rc;
    const char *tmp_str;
    static int initialized = FALSE;

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

EOT

foreach my $p (@{$params->{parameters}}) {
    my $env_fn = type_to_env_fn($p->{type});
    my @env_names = ();
    my $var_name = "${uc_ns}_" . $p->{name};
    my $var_suffix = $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 { "${alt_ns}_$_" } @{$p->{'alt-env'}};
    push @env_names, map { "${uc_ns}_$_" } @{$p->{'alt-env'}};
    push @env_names, "${alt_ns}_" . $p->{name};
    push @env_names, "${uc_ns}_" . $p->{name};

    if ($p->{type} eq 'string') {
        print PARAM_C <<EOT;
    ${uc_ns}_GET_DEFAULT_STRING($var_suffix, &tmp_str);
EOT
    }
    foreach my $env_name (@env_names) {
        # assumes rc is defined
        if ($p->{type} eq 'range') {
            print PARAM_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 PARAM_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 PARAM_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 PARAM_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 PARAM_C "\n";
}

print PARAM_C <<EOT;
fn_fail:
    return mpi_errno;
}

EOT

print PARAM_C <<EOT;
int ${ns}_finalize(void)
{
    int mpi_errno = MPI_SUCCESS;

EOT

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

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

EOT
    }
}


print PARAM_C <<EOT;
fn_fail:
    return mpi_errno;
}

EOT

foreach my $p (@{$params->{parameters}}) {
    my @env_names = ();
    my $first;
    my $alt;
    my $default;

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

    print PARAM_README "${alt_ns}_$p->{name}\n";

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

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


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

close(PARAM_C);

print PARAM_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 parameter */
EOT
my @type_field = (
    ['INT','i_val'],
    ['DOUBLE','d_val'],
    ['BOOLEAN','i_val'],
    ['STRING','s_val'],
    ['RANGE','r_val'],
);
foreach my $tuple (@type_field) {
    my ($type,$field) = @$tuple;
    print PARAM_HDR <<EOT;
#define ${uc_ns}_GET_DEFAULT_${type}(p_suffix_,out_ptr_)                                               \\
    do {                                                                                               \\
        ${ns}_assert(${uc_ns}_TYPE_${type} == ${ns}_params[${uc_ns}_ID_##p_suffix_].default_val.type); \\
        *(out_ptr_) = ${ns}_params[${uc_ns}_ID_##p_suffix_].default_val.${field};                      \\
    } while (0)
EOT
}
print PARAM_HDR <<EOT;

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

print PARAM_README <<EOT;
---------------------------------------------------------------------------

Automatically generated
  by:   $0
  at:   $run_timestamp
  from: $param_file (md5sum $param_file_md5)

EOT
close(PARAM_README);

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

# transform a parameter type to a C-language type
sub type2ctype {
    my $type = shift;
    my %typemap = (
        'int'     => 'int',
        'double'  => 'double',
        'string'  => 'char *',
        'boolean' => 'int',
        'range'   => "${ns}_param_range_val_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 parameter \"$name\", stopped" if defined($val);
        return qq($literalval);
    }

    die "Exactly one of \"default\" or \"defaultliteral\" fields must be specified for parameter \"$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};
}