#
# evap.pl - evaluate_parameters 2.1 for Perl
#
# lusol@lehigh.EDU, 93/11/07
#
# Made to conform, as much as possible, to the C function evap. The C, Perl
# and Tcl versions of evap are patterned after the Control Data procedure
# CLP$EVALUATE_PARAMETERS for the NOS/VE operating system, although neither
# approaches the richness of CDC's implementation.
#
# Availability is via anonymous FTP from ftp.Lehigh.EDU (128.180.63.4) in the
# directory pub/evap/evap-2.x.
#
# Stephen O. Lidie, Lehigh University Computing Center.
#
# Copyright (C) 1993 - 1994 by Stephen O. Lidie.  All rights reserved.
#
# For related information see the evap/C header file evap.h.  Complete
# help can be found in the man pages evap(2), evap.c(2), evap.pl(2),
# evap.tcl(2) and evap_pac(2).
#     
# 
#                           Revision History 
#
# lusol@Lehigh.EDU 93/05/03 (PDT version 1.2)  Version 1.6
#   . Original release - similar to version 1.6 of the C function evap.
#     Differences: support for `list of'; no support for types `application'
#     and `name'; no suport for default environment variables.
#   . For MS-DOS beasts set the internal variable $evap'DOS = 1.
#
# lusol@Lehigh.EDU 93/08/24 (PDT version 2.0)  Version 2.0
#   . The syntax for initializing the default value(s) for a `list of' command
#     line parameter has been defined and implemented:  ("val 1", "val 2"),
#     strangely enough the same syntax that Perl uses (-:, since that and eval
#     made my life much easier.  NOTE: in general you should quote components
#     of your lists, even if they're not type string, so that Perl/eval can
#     properly parse the list for evaluate_parameters.
#   . Essentially unnoticeable bug fix concerning `optional_file_list'.
#   . In a keyword type defintion 'key key1, key2, keyend' a space character
#     after the comma is no longer required.
#   . Various bug fixes when displaying -help information:  always surround
#     strings with double quotes, separate list with commas, convert boolean
#     values to TRUE or FALSE.
#   . Empty a `list of' variable the first time it's specified on the command
#     line.  Previously, list values specified on the command line were simply
#     pushed onto the list of PDT default values.
#   . Fix expansion of $HOME and ~ for file types that broke when I added the
#     stdin/stdout mod at the last second (-:!  Sigh, my QA was done on DOS.
#   . Handle default environment variables just like evap/C.  (DOS and Unix!)
#   . Similarly to evap/C, return program name in $opt_help.
#   . PDT lines beginning with # are considered comments and are ignored.
#   . In addition to returning command line values in scalar/list variables of
#     the form $opt_parameter and @opt_parameter, return them in the 
#     associative arrays %options and %Options as:
#
#       Perl 4: a single string `joined' with the multi-dimensional array
#               emulation character ($;)
#       Perl 5: a reference to a list
#
#     and indexed by the name of the parameter's full-spelling.
#   . Defer evaluation of file, boolean and backticked items if -help is
#     requested so that the unevaluated PDT values are displayed.
#
# lusol@Lehigh.EDU 94/03/29 (PDT version 2.0)  Version 2.1
#   . Replace help alias `disci' with `?'.
#   . Add ON/OFF as valid boolean values.
#   . Also return parameter values in %Options.
#   . Move documentation from evap.pl to the man page evap.pl(2).
#   . Obey MANPAGER (or PAGER) environment variable and page help output.
#     Default pager is `more'.  Since this changes the behavior of
#     evaluate_parameters, the boolean environment variable D_EVAP_DO_PAGE
#     can be set to FALSE/NO/OFF/0, any case, to disable this automatic
#     paging.
#   . Implement Help Hooks to customize evap's help output.
#   . Use only a command's basename for -usage_help.
#   . To use evaluate_parameters as an embedded command line processor call
#     the internal routine `$evap'evap_pac'.
#
# $Id: evap.pl,v 2.1.0.5 1994/06/01 01:03:08 lusol Exp $
#




sub evap {
    
    package evap;
    
    local( *PDT, *MM ) = @_;	# Parameter Description Table, Message Module
    
    $DOS = 0 unless defined( $DOS  ); # 1 iff MS-DOS, else Unix
    $message_modules = "./libevapmm.a";

    eval 'BEGIN {}';
    $Perl_version_major = $@ ? 4 : 5;

    local( $pdt_reg_exp1 ) = '^(.)(.)(.?)$';
    local( $pdt_reg_exp2 ) = '^TRUE$|^YES$|^ON$|^1$';
    local( $pdt_reg_exp3 ) = '^FALSE$|^NO$|^OFF$|^0$';
    local( $pdt_reg_exp4 ) = '^\s*no_file_list\s*$';
    local( $pdt_reg_exp5 ) = '^\s*optional_file_list\s*$';
    local( $pdt_reg_exp6 ) = '^\s*required_file_list\s*$';
    local( $full_help ) = 0;
    local( $usage_help ) = 0;
    local( $file_list ) = 'optional_file_list';
    local( $error ) = 0;
    local( $pkg ) = (caller)[0];
    local( $value, $rt, $type, $required, @P_PARAMETER, %P_INFO, %P_ALIAS, @P_REQUIRED, %P_VALID_VALUES, %P_ENV );
    local( $option, $default_value, $list, $parameter, $alias, @keys0, @keys, $found, $length, %P_EVALUATE, %P_DEFAULT_VALUE );
    
    
    $evap_embed = 0 unless defined( $evap_embed ); # 1 iff embed evap in the application
    if ( $evap_embed ) {	# Initialize for a new call in case evaluate_parameters is embedded in an application.
	$variable_name_old = "${pkg}\'opt_help";
	$vnn = "${pkg}\'options";
	$vnn2 = "${pkg}\'Options";
	&evap_set_value(0,  'w', '', '', $variable_name_old, $vnn, $vnn2, 'help' ); # clear `help' indicator
    }
    
    #
    # Verify correctness of the PDT.  Check for duplicate parameter names
    # and aliases.  Extract default values and possible keywords.  Decode
    # the user syntax and convert into a simpler form (ala NGetOpt) for
    # internal use.  Handle 'file list' too.
    #

    @local_pdt = @PDT;
    unshift( @local_pdt, 'help, ?: switch' );	# supply -help automatically
    @P_PARAMETER = ();		# no parameter names
    %P_INFO = ();		# no encoded parameter information
    %P_ALIAS = ();		# no aliases
    @P_REQUIRED = ();		# no required parameters
    %P_VALID_VALUES = ();	# no keywords
    %P_ENV = ();		# no default environment variables
    %P_EVALUATE = ();		# no PDT values evaluated yet
    %P_DEFAULT_VALUE = ();	# no default values yet

  OPTIONS:
    foreach $option ( @local_pdt ) {

	$option =~ s/\s*$//;	# trim trailing spaces
	next OPTIONS if $option =~ /^#.*|PDT\s+|pdt\s+|PDT$|pdt$/;
	$option =~ s/\s*PDTEND|\s*pdtend//;
	next OPTIONS if $option =~ /^ ?$/;
	
	if ( $option =~ /$pdt_reg_exp4|$pdt_reg_exp5|$pdt_reg_exp6/ ) {
	    $file_list = $option; # remember user specified file_list
	    next OPTIONS;
	}
	
        ($parameter, $alias, $_) = ($option =~ /^\s*(\S*)\s*,\s*(\S*)\s*:\s*(.*)$/);
	&evap_PDT_error( "Error in an evaluate_parameters 'parameter, alias: type' option specification:  \"$option\".\n" )
	    unless defined( $parameter ) && defined( $alias ) && defined( $_ );
	&evap_PDT_error( "Duplicate parameter $parameter:  \"$option\".\n" ) if defined( $P_INFO{$parameter} );
	push( @P_PARAMETER, $parameter ); # update the ordered list of parameter names

        /(\bswitch\b|\binteger\b|\bstring\b|\breal\b|\bfile\b|\bboolean\b|\bkey\b|\bname\b|\bapplication\b)/; # type/list
        ($list, $type, $_)=($`, $1, $');
	&evap_PDT_error( "Parameter $parameter has an undefined type:  \"$option\".\n" ) unless defined( $type );
	&evap_PDT_error( "Expecting 'list of', found:  \"$list\".\n") if $list ne '' && $list !~ /\s*list\s+of\s+/;
        $list = '1' if $list;	# list state = 1, possible default PDT values
        $type = 'w' if $type =~ /^switch$/;
	$type = substr( $type, 0, 1 );

        ($_, $default_value) = /\s*=\s*/ ? ($`, $') : ('', ''); # get possible default value
	if ( $default_value =~ /^([^\(]{1})(\w*)\s*,\s*(.*)/ ) { # if environment variable AND not a list
	    $default_value = $3;
	    $P_ENV{$parameter} = $1 . $2;
	}
        $required = ($default_value eq '$required') ? 'R' : 'O';
        $P_INFO{$parameter} = defined $type ? $required . $type . $list : "";
	push( @P_REQUIRED, $parameter ) if $required =~ /^R$/; # update the list of $required parameters

        if ( $type =~ /^k$/ ) {
	    $_ =~ s/,/ /g;
	    @keys = split( ' ' );
	    pop( @keys );	# remove 'keyend'
	    $P_VALID_VALUES{$parameter} = join( ' ', @keys );
        } #ifend keyword type
	
	foreach $value (keys %P_ALIAS) {
	    &evap_PDT_error( "Duplicate alias $alias:  \"$option\".\n" ) if $alias eq $P_ALIAS{$value};
	}
	$P_ALIAS{$parameter} = $alias; # remember alias

	&evap_PDT_error( "Cannot have 'list of switch':  \"$option\".\n" ) if $P_INFO{$parameter} =~ /^.w1$/;

        if ( $default_value ne '' && $default_value ne '$required' ) {
	    $default_value = $ENV{$P_ENV{$parameter}} if $P_ENV{$parameter} && $ENV{$P_ENV{$parameter}};
	    $P_DEFAULT_VALUE{$parameter} = $default_value;
	    $variable_name_old = "${pkg}\'opt_${parameter}";
	    $vnn = "${pkg}\'options";
	    $vnn2 = "${pkg}\'Options";
            &evap_set_value(0,  $type, $list, $default_value, $variable_name_old, $vnn, $vnn2, $parameter ); # initialize
        }
	
    } # forend OPTIONS

    if ( $error ) {
        print STDERR "Inspect the file \"evap.pl\" for details on PDT syntax.\n";
        exit( 1 );
    }

    # Process arguments from the command line, stopping at the first
    # parameter without a leading dash, or a --.  Convert a parameter
    # alias into its full form, type-check parameter values and store
    # the value into global variables for use by the caller.  When
    # complete call evap_fin to perform final processing.
    
  ARGUMENTS:
    while ( $#ARGV >= $[) {
	
	$option = shift (@ARGV); # get next command line parameter
	$value = undef;		# assume no value
	
	$full_help = 1 if $option =~ /^-(full_help|\?\?\?)$/;
	$usage_help = 1 if $option =~ /^-(usage_help|\?\?)$/;
	$option = '-help' if $full_help || $usage_help;
	
	if ( $option =~ /^(--|-)/ ) { # check for end of parameters
	    if ( $option eq '--' ) {
		return( &evap_fin );
	    }
	    $option = $';	# option name without dash
	} else {		# not an option, push it back on the list
	    unshift (@ARGV, $option);
	    return( &evap_fin );
	}
	
	foreach $alias (keys %P_ALIAS) { # replace any alias with the full parameter spelling
	    $option = $alias if $option eq $P_ALIAS{$alias};
	}
	
	if ( ! defined( $rt = $P_INFO{$option} ) ) {
	    $found = 0;
	    $length = length( $option );
	    foreach $key (keys %P_INFO) { # try substring match
		if ( $option eq substr( $key, $[, $length ) ) {
		    if ( $found ) {
			print STDERR "Ambiguous parameter: -$option.\n";
			$error++;
			last;
		    }
		    $found = $key; # remember full spelling
		}
	    } # forend
	    $option = $found ? $found : $option;
	    if ( ! defined( $rt = $P_INFO{$option} ) ) {
		print STDERR "Invalid parameter: -$option.\n";
		$error++;
		next ARGUMENTS;
	    }
	} # ifend non-substring match
	
	($required, $type, $list) = ( $rt =~ /$pdt_reg_exp1/ ); # unpack encoded information
	
	if ( $type !~ /^w$/ ) {
	    if ( $#ARGV < $[ ) { # if argument list is exhausted
		print STDERR ("Value required for parameter -$option.\n");
		$error++;
		next ARGUMENTS;
	    } else {
		$value = shift (@ARGV);	# get argument value, then perform type-checking
	    }
	}
	
	if ( $type =~ /^w$/ ) { # switch
	    $value = 1;
	} elsif ( $type =~ /^i$/ ) { # integer
	    if ( $value !~ /^[+-]?[0-9]+$/ ) {
		print STDERR "Expecting integer reference, found \"$value\" for parameter -$option.\n";
		$error++;
		undef $value;
	    }
	} elsif ( $type =~ /^r$/ ) { # real number, int is also ok
	    if ( $value !~ /^\s*[+-]?(\d+(\.\d*)?|\.\d+)([eE][+-]?\d+)?\s*$/ ) {
		print STDERR "Expecting real reference, found \"$value\" for parameter -$option.\n";
		$error++;
		undef $value;
	    }
	} elsif ( $type =~ /^s$|^n$|^a$/ ) { # string (or name or application for evap/C compatibility)
	} elsif ( $type =~ /^f$/ ) { # file
	    if ( length( $value ) > 255 ) {
		print STDERR "Expecting file reference, found \"$value\" for parameter -$option.\n";
		$error++;
		undef $value;
	    }
	} elsif ( $type =~ /^b$/ ) { # boolean
	    $value =~ tr/a-z/A-Z/;
	    if ( $value !~ /$pdt_reg_exp2|$pdt_reg_exp3/i ) {
		print STDERR "Expecting boolean reference, found \"$value\" for parameter -$option.\n";
		$error++;
		undef $value;
            }
	} elsif ( $type =~ /^k$/ ) { # keyword
	    #
	    # First try exact match, then substring match.
	    #
	    undef( $found );
	    @keys = split( ' ', $P_VALID_VALUES{$option} );
	    for ( $i = 0; $i <= $#keys && ! defined( $found ); $i++ ) {
		$found = 1 if $value eq $keys[$i];
	    }
	    if ( ! defined( $found ) ) { # try substring match
		$length = length( $value );
		for ( $i = 0; $i <= $#keys; $i++ ) {
		    if ( $value eq substr( $keys[$i], $[, $length ) ) {
			if ( defined( $found ) ) {
			    print STDERR "Ambiguous keyword for parameter -$option: $value.\n";
			    $error++;
			    last; # for
			}
			$found = $keys[$i]; # remember full spelling
		    }
		} # forend
		$value = defined( $found ) ? $found : $value;
	    } # ifend
	    if ( ! defined( $found ) ) {
		print STDERR "\"$value\" is not a valid value for the parameter -$option.\n";
		$error++;
		undef $value;
	    }
	} # ifend type-check
	
	next ARGUMENTS if ! defined( $value );
	    
    	$list = '2' if $list =~ /^1$/; # list state = 2, empty list this time only
        $variable_name_old = "${pkg}\'opt_${option}";
        $vnn = "${pkg}\'options";
        $vnn2 = "${pkg}\'Options";
	&evap_set_value(1,  $type, $list, $value, $variable_name_old, $vnn, $vnn2, $option ) if defined( $value );
	@P_REQUIRED = grep( $option ne $_, @P_REQUIRED ); # remove from $required list if specified
	$P_INFO{$option} = $required . $type . '3' if $list; # list state = 3, don't empty list from now on

    } # whilend ARGUMENTS
    
    return( &evap_fin );
    
} # end evap




sub evap'evap_fin {

    #
    # Finish up evaluate_parameters processing:
    #
    # If -usage_help, -help or -full_help was requested then do it and exit.  Else,
    #   
    #  . Store program name in `help' variables.
    #  . Perform deferred evaluations.
    #  . Ensure all $required parameters have been given a value.
    #  . Ensure the validity of the trailing file list.
    #  . Exit with a Unix return code of 1 if there were errors and $evap_embed = 0,
    #    else return to the calling Perl program with a proper return code.
    #
    
    package evap;
    
    local( $m, $p, $required, $type, $list, $def, $rt, $def, $element, $is_string, $pager, $do_page );

    $variable_name = "\$${pkg}\'opt_help";

    # Define Help Hooks text as required.

    if ( ! defined( $evap_Help_Hooks{'P_HHURFL'} ) ) { $evap_Help_Hooks{'P_HHURFL'} = " file(s)\n"; }
    if ( ! defined( $evap_Help_Hooks{'P_HHUOFL'} ) ) { $evap_Help_Hooks{'P_HHUOFL'} = " [file(s)]\n"; }
    if ( ! defined( $evap_Help_Hooks{'P_HHUNFL'} ) ) { $evap_Help_Hooks{'P_HHUNFL'} = "\n"; }
    if ( ! defined( $evap_Help_Hooks{'P_HHBRFL'} ) ) { $evap_Help_Hooks{'P_HHBRFL'} =
							   "\nfile(s) required by this command\n\n"; }
    if ( ! defined( $evap_Help_Hooks{'P_HHBOFL'} ) ) { $evap_Help_Hooks{'P_HHBOFL'} =
							   "\n[file(s)] optionally required by this command\n\n"; }
    if ( ! defined( $evap_Help_Hooks{'P_HHBNFL'} ) ) { $evap_Help_Hooks{'P_HHBNFL'} = "\n"; }
    if ( ! defined( $evap_Help_Hooks{'P_HHERFL'} ) ) { $evap_Help_Hooks{'P_HHERFL'} =
							   "Trailing file name(s) required.\n"; }
    if ( ! defined( $evap_Help_Hooks{'P_HHENFL'} ) ) { $evap_Help_Hooks{'P_HHENFL'} =
							   "Trailing file name(s) not permitted.\n"; }

    if ( eval( $variable_name ) ) { # see if help was requested
	
	local( $optional );
	local( %parameter_help ) = ();
	local( $parameter_help_in_progress ) = 0;
	local( %type_list ) = (
			       'w', 'switch',
			       'i', 'integer',
			       's', 'string',
			       'r', 'real',
			       'f', 'file',
			       'b', 'boolean',
			       'k', 'key',
			       'n', 'name',
			       'a', 'application',
			       );

	# Establish the proper pager and open the pipeline.  Do no paging
	# if the boolean environment variable D_EVAP_DO_PAGE is FALSE.

	$pager = $ENV{'MANPAGER'} || $ENV{'PAGER'} || 'more';
	$pager = '|' . $pager;
	if ( defined( $ENV{'D_EVAP_DO_PAGE'} ) && (($do_page = $ENV{'D_EVAP_DO_PAGE'}) ne '') ) {
	    $do_page =~ tr/a-z/A-Z/;
	    if ( $do_page =~ /$pdt_reg_exp3/ ) {
		$pager = '>-';
	    }
	}
	open( PAGER, "$pager" );
	
	print PAGER "Command Source:  $0\n\n\n\n" if $full_help;

	# Print the Message Module text and save any full help.  The key
	# is the parameter name and the value is a list of strings with
	# the newline as a separator.  If there is no Message Module or
	# it's empty then display an abbreviated usage message.
	
        if ( $usage_help || ! defined( @MM ) || ($#MM < $[) ) {
	    
	    split( /\//, $0 );	# only basename for usage help
	    print PAGER "\nUsage: ", $_[$#_];
	    $optional = '';
	    foreach $p (@P_PARAMETER) {
		if ( $P_INFO{$p} =~ /^R..?$/ ) { # if $required
		    print PAGER " -$P_ALIAS{$p}";
		} else {
		    $optional .= " -$P_ALIAS{$p}";
		}
	    } # forend
	    print PAGER " [$optional]" if $optional;
	    if ( $file_list =~ /$pdt_reg_exp5/ ) {
		print PAGER "$evap_Help_Hooks{'P_HHUOFL'}";
	    } elsif ( $file_list =~ /$pdt_reg_exp6/ ) {
		print PAGER "$evap_Help_Hooks{'P_HHURFL'}";
	    } else {
		print PAGER "$evap_Help_Hooks{'P_HHUNFL'}";
	    }
	    
        } else {
	    
	  MESSAGE_LINE:
	    foreach $m (@MM) {
		
		if ( $m =~ /^\.(.*)$/ ) { # look for 'dot' leadin character
		    $p = $1; # full spelling of parameter
		    $parameter_help_in_progress = 1;
		    $parameter_help{$p} = "\n";
		    next MESSAGE_LINE;
		} # ifend start of help text for a new parameter
		if ( $parameter_help_in_progress ) { 
		    $parameter_help{$p} .=  $m . "\n";
		} else {
		    print PAGER $m, "\n";
		}
		
	    } # forend MESSAGE_LINE
	    
	} # ifend usage_help

	# Pass through the PDT list printing a standard evap help summary.

        print PAGER "\nParameters:\n";
	if ( ! $full_help ) { print PAGER "\n"; }
	
      ALL_PARAMETERS:
        foreach $p (@P_PARAMETER) {

	    if ( $full_help ) { print PAGER "\n"; }
	    
	    if ( $p =~ /^help$/ ) {
		print PAGER "-$p, $P_ALIAS{$p}, usage_help, full_help: Display Command Information\n";
                if ( $full_help ) {
         	    print PAGER "\n\tDisplay information about this command, which includes\n";
		    print PAGER "\ta command description with examples, plus a synopsis of\n";
		    print PAGER "\tthe command line parameters.  If you specify -full_help\n";
		    print PAGER "\trather than -help complete parameter help is displayed\n";
		    print PAGER "\tif it's available.\n";
	        }
		next ALL_PARAMETERS;
	    }
	    
	    $rt = $P_INFO{$p};	# get encoded required/type information
	    ($required, $type, $list) = ($rt =~ /$pdt_reg_exp1/); # unpack
	    $type = $type_list{$type};
	    $is_string = ( $type =~ /^string$/ );
	    
	    print PAGER "-$p, $P_ALIAS{$p}: ", $list ? 'list of ' : '', $type; 
	    
	    print PAGER " ", join( ', ', split( ' ', $P_VALID_VALUES{$p} ) ), ", keyend" if $type =~ /^key$/;
	    
            local( *glob ) = "$pkg".'\'opt_'.$p;
	    if ( $list ) {
                $def = defined( @glob ) ? 1 : 0;
	    } else {
                $def = defined( $glob ) ? 1 : 0;
            }
    
	    if ( ($required =~ /^O$/) || ( $def == 1) ) { # if $optional or defined
		
                if ( $def == 0 ) { # undefined and $optional
    		    print PAGER "\n";
                } else {	# defined (either $optional or $required), display the default value(s)
                    if ( $list ) {
			print PAGER $P_ENV{$p} ? " = $P_ENV{$p}, " : " = ";
			print PAGER $is_string ? "(\"" : "(", $is_string ? join( '", "', @glob ) : join( ', ', @glob),
			      $is_string ? "\")\n" : ")\n";
                    } else {	# not 'list of'
			print PAGER $P_ENV{$p} ? " = $P_ENV{$p}, " : " = ";
			print PAGER $is_string ? "\"" : "", $glob, $is_string ? "\"\n" : "\n";
                    } # ifend 'list of'
                } # ifend
		
	    } elsif ( $required =~ /R/ ) {
		print PAGER $P_ENV{$p} ? " = $P_ENV{$p}, " : " = ";
		print PAGER "\$required\n";
	    } else {
		print PAGER "\n";
	    } # ifend $optional or defined parameter
	    
            if ( $full_help ) {
		if ( defined( $parameter_help{$p} ) ) {
		    print PAGER "$parameter_help{$p}";
		} else {
		    print PAGER "\n";
		}
	    }
	    
	} # forend ALL_PARAMETERS

	if ( $file_list =~ /$pdt_reg_exp5/ ) {
	    print PAGER "$evap_Help_Hooks{'P_HHBOFL'}";
	} elsif ( $file_list =~ /$pdt_reg_exp6/ ) {
	    print PAGER "$evap_Help_Hooks{'P_HHBRFL'}";
	} else {
	    print PAGER "$evap_Help_Hooks{'P_HHBNFL'}";
	}

	close( PAGER );
	if ( $evap_embed ) {
	    return( -1 );
	} else {
	    exit( 0 );
	}
	
    } # ifend help requested

    # Evaluate remaining unspecified command line parameters.  This has been deferred until now so that
    # if -help was requested the user sees unevaluated boolean, file and backticked values.

    foreach $parameter (@P_PARAMETER) {
	if ( ! $P_EVALUATE{$parameter} && $P_DEFAULT_VALUE{$parameter} ) {
	    ($required, $type, $list) = ($P_INFO{$parameter} =~ /$pdt_reg_exp1/);
	    if ( $type ne 'w' ) {
		$variable_name_old = "${pkg}\'opt_${parameter}";
		$vnn = "${pkg}\'options";
		$vnn2 = "${pkg}\'Options";
		$list = 2 if $list; # force re-initialization of the list
		&evap_set_value(1, $type, $list, $P_DEFAULT_VALUE{$parameter}, $variable_name_old, $vnn, $vnn2,	$parameter );
	    } # ifend non-switch
	} # ifend not specified
    } # forend all PDT parameters

    # Store program name for caller.

    $variable_name_old = "${pkg}\'opt_help";
    $vnn = "${pkg}\'options";
    $vnn2 = "${pkg}\'Options";
    &evap_set_value(0,  'w', '', $0, $variable_name_old, $vnn, $vnn2, 'help' ); # initialize program name
    
    # Ensure all $required parameters have been specified on the command line.

    foreach $p (@P_REQUIRED) {
	print STDERR "Parameter $p is required but was omitted.\n";
	$error++;
    } # forend
    
    # Ensure any required files follow, or none do if that is the case.

    if ( $file_list =~ /$pdt_reg_exp4/ && $#ARGV > $[ - 1 ) {
        print STDERR "$evap_Help_Hooks{'P_HHENFL'}";
        $error++;
    } elsif ( $file_list =~ /$pdt_reg_exp6/ && $#ARGV == $[ - 1 ) {
        print STDERR "$evap_Help_Hooks{'P_HHERFL'}";
        $error++;
    }
    
    print STDERR "Type $0 -? for command line parameter information.\n" if $error;

    exit( 1 ) if $error && ! $evap_embed;
    if ( ! $error ) {
	return( 1 );
    } else {
	return( 0 );
    }
    
} # end evap_fin




sub evap'evap_PDT_error {

    #
    # Inform the application developer that they've screwed up!
    #

    package evap;

    local( $msg ) = @_;

    print STDERR "$msg";
    $error++;
    next OPTIONS;

} # end evap_PDT_error
   



sub evap'evap_set_value {
    
    #
    # Store a parameter's value; some parameter types require special type
    # conversion.  Store values the old way in scalar/list variables of the
    # form $opt_parameter and @opt_parameter, as well as the new way in an
    # associative arrays named %options and %Options.  In Perl 5 'list of'
    # parameters are returned as a reference in %options/%Options; in Perl 4
    # these parameters are returned as a string 'joined' with the multi-
    # dimensional array emulation character ($;).
    #
    # Evaluate items in grave accents (backticks), boolean and files if
    # `evaluate' is TRUE.
    #
    # Handle list syntax (item1, item2, ...) for 'list of' types.
    #
    # Lists are a little weird as they may already have default values from the
    # PDT declaration. The first time a list parameter is specified on the
    # command line we must first empty the list of its default values.  The
    # P_INFO list flag thus can be in one of three states: 1 = the list has
    # possible default values from the PDT, 2 = first time for this command
    # line parameter so empty the list and THEN push the parameter's value, and
    # 3 = from now just keep pushing new command line values on the list.
    #
    
    package evap;    
    
    local( $evaluate, $type, $list, $v, *parameter_old, *parameter_new, *parameter_new2, $parameter_new_hash ) = @_;
    local( $value, @values );

    if ( $list =~ /^2$/ ) {	# empty list of default values
	@parameter_old = ();
	if ( $Perl_version_major == 5 ) {
            eval "\$parameter_new{\$parameter_new_hash} = \\\@parameter_old";
            eval "\$parameter_new2{\$parameter_new_hash} = \\\@parameter_old";
        } else {
            $parameter_new{$parameter_new_hash} = '';
            $parameter_new2{$parameter_new_hash} = '';
        }
    }

    if ( $list && $v =~ /^\(+.*\)+$/ ) { # check for list
	@values = eval "$v"; # let Perl do the walking
    } else {
	$v =~ s/["|'](.*)["|']/$1/; # remove any bounding superfluous quotes
	@values = $v;		# a simple scalar	
    } # ifend initialize list of values

    foreach $value (@values) {

        if ( $evaluate ) {
            $P_EVALUATE{$parameter_new_hash} = 'evaluated';
            $value =~ /^(`*)([^`]*)(`*)$/; # check for backticks
	    chop( $value = `$2` ) if $1 eq '`' && $3 eq '`';
	    if ( ! $DOS && $type =~ /^f$/ ) {
                local( @path ) = split( /\//, $value );
	        if ( $value =~ /^stdin$/ ) {
                    $value = '-';
                } elsif ( $value =~ /^stdout$/ ) {
                    $value = '>-';
                } elsif ( $path[$[] =~ /(^~$|^\$HOME$)/ ) {
		    $path[$[] = $ENV{'HOME'};
                    $value = join( '/', @path );
                }
            } # ifend file type

            if ( $type =~ /^b$/ ) {
	        $value = '1' if $value =~ /$evap'pdt_reg_exp2/i;
	        $value = '0' if $value =~ /$evap'pdt_reg_exp3/i;
            } # ifend boolean type
        } # ifend evaluate

        if ( $list ) {		# extend list with new value
	    push( @parameter_old, $value );
	    if ( $Perl_version_major == 5 ) {
                eval "\$parameter_new{\$parameter_new_hash} = \\\@parameter_old";
                eval "\$parameter_new2{\$parameter_new_hash} = \\\@parameter_old";
            } else {
	        $parameter_new{$parameter_new_hash} = '' unless defined( $parameter_new{$parameter_new_hash} );
                $parameter_new{$parameter_new_hash} .= ($parameter_new{$parameter_new_hash} ? $; : '') . $value;
	        $parameter_new2{$parameter_new_hash} = '' unless defined( $parameter_new2{$parameter_new_hash} );
                $parameter_new2{$parameter_new_hash} .= ($parameter_new2{$parameter_new_hash} ? $; : '') . $value;
            }
        } else {		# store scalar value
	    $parameter_old = $value;
            $parameter_new{$parameter_new_hash} = $value;
            $parameter_new2{$parameter_new_hash} = $value;
        }

    } # forend
	
} # end evap_set_value




sub evap_pac {

    #
    # Process Application Commands
    #
    # An application command can be envoked by entering either its full spelling or the alias.
    #

    local( $prompt, $I, %cmds ) = @_;
    local( $proc, $args, %long, %alias, $name, $long, $alias );

    require "shellwords.pl";

    $evap'evap_embed = 1;	# enable embedding
    $evap'shell = ( defined( $ENV{'SHELL'} ) && $ENV{'SHELL'} ne '' ) ? $ENV{'SHELL'} : '/bin/sh';
    $cmds{'display_application_commands|disac'} = "evap'evap_disac_proc( %cmds )";
    $cmds{'!'} = "evap'evap_bang_proc";

    # First, create new associative command name arrays with full/alias names.

    foreach $name ( keys %cmds ) {
        if ( $name =~ /\|/ ) {
            ($long, $alias) = ($name =~ /(.*)\|(.*)/);
	    $long{$long} = $cmds{$name};
	    $alias{$alias} = $cmds{$name};
        } else {
	    $long{$name} = $cmds{$name};
	}
    }

    print STDOUT "$prompt";

  GET_USER_INPUT:
    while ( <$I> ) {

	next GET_USER_INPUT if /^\s*$/;	# ignore empty input lines

	if ( /^\s*!(.+)/ ) {
	    $_ = '! ' . $1;
	}

        ($0, $args) = /\s*(\S+)\s*(.*)/;
	if ( defined( $long{$0} ) ) {
	    $proc = $long{$0};
	} elsif ( defined( $alias{$0} ) ) {
	    $proc = $alias{$0};
	} else  {
            print STDERR "Error - unknown command `$0'.  Type \"disac -do f\" for a\n";
	    print STDERR "list of valid application commands.  You can then ...\n\n";
            print STDERR "Type \"xyzzy -?\" for help on application command `xyzzy'.\n";
	    next GET_USER_INPUT;
        }
	
	if ( $0 eq '!' ) {
	    @ARGV = $args;
	} else {
	    @ARGV = &shellwords( $args );
	}
        eval "&$proc;";		# call the evap/user procedure
	print STDERR $@ if $@;

    } # whilend GET_USER_INPUT
    continue { # while GET_USER_INPUT
        print STDOUT "$prompt";
    } # continuend
    print STDOUT "\n";

} # end evap_pac

 


sub evap'evap_bang_proc {
    
    #
    # Issue one or more commands to the user's shell.  If the SHELL environment
    # variable is not defined or is empty, then /bin/sh is used.
    #

    package evap;

    local( $cmd ) = $main'ARGV[$[];
    return if $cmd eq '';

    &evap_setup_for_evap( "evap", "bang" );
    $evap_Help_Hooks{'P_HHUOFL'} = " Command(s)\n";
    $evap_Help_Hooks{'P_HHBOFL'} = "\nA list of shell Commands.\n\n";
    if ( &main'evap( *PDT, *MM ) != 1 ) { return; }

    system( "$evap'shell -c '$cmd'" );

} # end evap_bang_proc

 


sub evap'evap_disac_proc {
    
    #
    # Display the list of legal application commands.
    #

    package evap;

    local( %commands ) = @_;
    local( @brief, @full, $name, $long, $alias );

    &evap_setup_for_evap( "evap", "disac" );
    if ( &main'evap( *PDT, *MM ) != 1 ) { return; }

    foreach $name ( keys %commands ) {
        if ( $name =~ /\|/ ) {
            ($long, $alias) = ($name =~ /(.*)\|(.*)/);
        } else {
	    $long = $name;
            $alias = '';
	}
        push( @brief, $long );
        push( @full, ($alias ne '') ? "$long, $alias" : "$long" );
    }

    open( H, ">$Options{'output'}" );
    if ( $Options{'display_option'} eq 'full' ) {
        print H "\nCommands and aliases for this application:\n\n";
	print H "  ", join( "\n  ", sort( @full ) ), "\n";
    } else {
        print H join( "\n", sort( @brief ) ), "\n";
    }
    close( H );

} # end evap_disac_proc

 


sub evap'evap_setup_for_evap {
    
    #
    # Initialize evap_pac's builtin commands' PDT/MM variables.
    #

    package evap;

    local( $pkg, $command ) = @_;

    open( IN, "ar p $message_modules ${command}_pdt|" );
    eval "@${pkg}'PDT = <IN>;";                        # initialize Parameter Description Table
    close( IN );
    open( IN, "ar p $message_modules ${command}.mm|" );
    eval "@${pkg}'MM = grep( \$@ = s/\n\$//, <IN> );"; # initialize Message Module
    close( IN );

} # end evap_setup_for_evap




1;
