#! /usr/local/bin/perl5.004 -w
#
# GetOpts
#
#
# 26-Jun-1995 Created -- SD
# 11-Aug-1995 Bug in displaying default for variable in help -- SD
# 16-Aug-1995 Added 'list' to available types -- DMH
# 25-Aug-1995 '-w' silenced -- DMH
#
#######################################################################
# This software has been created by Genome Research Limited (GRL).    # 
# GRL hereby grants permission to use, copy, modify and distribute    # 
# this software and its documentation for non-commercial purposes     # 
# without fee at the user's own risk on the basis set out below.      #
# GRL neither undertakes nor accepts any duty whether contractual or  # 
# otherwise in connection with the software, its use or the use of    # 
# any derivative, and makes no representations or warranties, express #
# or implied, concerning the software, its suitability, fitness for   #
# a particular purpose or non-infringement.                           #
# In no event shall the authors of the software or GRL be responsible # 
# or liable for any loss or damage whatsoever arising in any way      # 
# directly or indirectly out of the use of this software or its       # 
# derivatives, even if advised of the possibility of such damage.     #
# Our software can be freely distributed under the conditions set out # 
# above, and must contain this copyright notice.                      #
#######################################################################

#############################################################
# &badgerGetOpt($prog, $usage, $optstruct)
#
# Parse command line arguments and options.
# $prog is the name of the program
# $usage is the program usage
# $optstruct is an associative array, indexed on option names.
# For each option should be provided an associative array, through which
# one can specify the following:
#
# type     The type of argument expected. Can be one of: int,float,text,boolean,list.
# var      The variable to store the value. If the variable is not defined,
#          it will be created.
# def      The default value.
# select   Specify a set of values from which the argument must be selected
# func     Spcify a function to check integrity of argument. GetOpts calls
#          with one parameter. Also sets $a for brevuty.
# help     Specify a comment for -help.
#
# Other features:
# 1. "--" can be used to specify end of option list.
# 2. "-help" is defined by default.
# 3. "-debug" is defined by default.
# 4. Does not support one character boolean switches loaded onto one "-"
# 5. -no<boolean> works as expected.
# 6. Returns value 0 if OK, 1 if NOT OK and 2 if help.
#
#############################################################

sub badgerGetOpt {
    local ($prog, $usage, $opts) = @_;
    local ($opt);

    ############################################################
    # Implicit options
    ############################################################

    if ( ! defined $opts->{"-help"}) {
	$opts->{"-help"} = {
	    "type" => "boolean",
	    "func" => \&badgerGetOptHelp,
	    "help" => "This help.",
	    "def" => 0
	    };
    }
    if ( ! defined $opts->{"-h"}) {
	$opts->{"-h"} = {
	    "type" => "boolean",
	    "func" => \&badgerGetOptHelp,
	    "help" => "This help.",
	    "def" => 0
	    };
    }
    if ( ! defined $opts->{"-v"}) {
	$opts->{"-v"} = {
	    "type" => "boolean",
	    "func" => \&badgerGetOptVersion,
	    "help" => "This help.",
	    "def" => 0
	    };
    }
    if ( ! defined $opts->{"-debug"}) {
	$opts->{"-debug"} = {
	    "type" => "boolean",
	    "var" => \$debug,
	    "help" => "Enable debug mode.",
	    "def" => 0
	    };
    }


    ############################################################
    # Set default values
    ############################################################
    foreach $opt ( keys %$opts ) {
	if ( defined $opts->{$opt}->{"var"} && defined $opts->{$opt}->{"def"} ) {
	    ${$opts->{$opt}->{"var"}} = $opts->{$opt}->{"def"};
        }
    }
    
    while ( @ARGV && $ARGV[0] =~ /^-/ ) {
	$opt = $ARGV[0];
	############################################################
	# Check flag and set variable
	############################################################
	if ( defined($opts->{$opt}) ) {
	    if ($opts->{$opt}->{"type"} eq "boolean") {
		$val = 1;
	    } elsif ( $opts->{$opt}->{'type'} eq 'list' ) {
		$val="";
		while ( $ARGV[1] !~ /^-/ && $ARGV[1] ne '') {
		    $val .= "$ARGV[1] ";
		    shift(@ARGV);
		}
	    } else {
		if ($#ARGV==0) {
		    warn "$prog: Argument expected for option $opt\n";
		    return 1;
		} else { shift @ARGV }
		$val = $ARGV[0];
	    }
        } elsif ( $opt =~ /^-no/ ) {
            $opt =~ s/^-no/-/;
	    if (defined $opts->{$opt} && $opts->{$opt}->{"type"} eq "boolean") {
		$val = 0;
            } else {
		warn "$prog: Unknown option $opt\n";
                warn $usage;
	        return 1;
            }
	} elsif ( $opt eq "--" ) {
	    shift @ARGV; last;
	} else {
	    warn "$prog: Unknown option $opt\n";
	    warn $usage;
	    return 1;
        }

	############################################################
	# Set variable or list array
	############################################################
	if ( defined $opts->{$opt}->{"var"} ) {
            if ( ref( $opts->{$opt}->{"var"} ) eq 'ARRAY') {
                foreach (split(':', $val)) {
		    s/^\s*|\s*$//g;
                    push( @{ $opts->{$opt}->{"var"} }, $_);
                }
            } else {
		${$opts->{$opt}->{'var'}} = $val;
	    }
        }

	############################################################
	# Check variable by type
	############################################################
        if ( $opts->{$opt}->{"type"} eq "int" ) {
	    if (! ($val =~ /^-?\d+/)) {
                warn "$prog: Argument for option $opt must be an integer\n"; return 1;
            }
	}

	############################################################
	# Check variable by integrity function
	############################################################
        if ( defined $opts->{$opt}->{"func"} ) {
	    local($a) = $val;
	    if ( ! &{$opts->{$opt}->{"func"}}($a)) {
		if ( $opts->{$opt}->{"type"} ne "boolean" ) {
		    warn "$prog: Invalid value of argument for option $opt\n";
		}
		return 1;
	    }
        }
	        
	############################################################
	# Check variable by selection of default types
	############################################################
        if ( defined $opts->{$opt}->{"select"} ) {
	    if (! grep($_ eq $val,@{$opts->{$opt}->{"select"}})) {
		warn "$prog: Invalid argument for option $opt. Should be one of [", join(",",@{$opts->{$opt}->{"select"}}),"]\n";
		return 1;
	    }
	}


      shift @ARGV;
      }

    0;

}



sub badgerGetOptHelp {
    local($opt,$noopt);
    local($width);

    if ( $a) {
	# determine width
	$width=0;
	foreach $opt ( keys %$opts ) {
	    if ($width < length($opt)) { $width = length($opt); }
	}
	$width++;

	print "$usage";
	print "Command line switches:\n";

	foreach $opt ( sort grep($opts->{$_}->{"type"} eq "boolean",keys %$opts) ) {
	    printf "  %-${width}s",$opt;
	    if (defined $opts->{$opt}->{"help"}) {
		print $opts->{$opt}->{"help"};
	    }
	    if (defined $opts->{$opt}->{"var"} && defined $opts->{$opt}->{"def"}) {
		($noopt = $opt) =~ s/-/-no/;
		print " Default: ", (${$opts->{$opt}->{"var"}} ? $opt : $noopt), ".";
            }
            print "\n";
        }


        print "Command line arguments:\n";
        foreach $opt ( sort grep($opts->{$_}->{"type"} ne "boolean",keys %$opts) ) {
	    printf "  %-${width}s",$opt;
	    if (defined $opts->{$opt}->{"help"}) {
		print $opts->{$opt}->{"help"};
	    }
	    if (defined $opts->{$opt}->{"type"}) {
		print "\tType: ", $opts->{$opt}->{"type"} , ".";
	    }
	    if (defined $opts->{$opt}->{"select"}) {
		print " Selected from: [", join(",",@{$opts->{$opt}->{"select"}}) , "].";
	    }
	    if (defined ${$opts->{$opt}->{"var"}} ) {
	        if (ref($opts->{$opt}->{"var"}) eq 'SCALAR' ) {
		    print " Default: ", ${$opts->{$opt}->{"var"}},".";
                }
            }
            print "\n";
        }
    }


    return ! $a;
}

sub badgerGetOptVersion {
    local($opt,$noopt);
    local($width);

    if ( $a ) {
	if (defined $vers) {
	    print "$prog $vers\n";
	}
    }


    return ! $a;
}



#########################################################
#
# badgerAskVar - prompt for global settings.
#
# Each item on list is a setting to ask for.
# Entries: 
# 
# [$scalar_ref, $prompt_string, $default_string]
# 
#
# my @vars = (
#     [\$single_plate, 'Plate?', 'all'],
#     [\$rows, 'Rows?', 'a,b,c,d,e,f,g,h'],
#     [\$print, 'Sent output to printer?', 'no'],
#     [\$file, 'Save output in file:', 'none']
#     );
#
# &badgerAskVar(\@vars);
#
#
#########################################################

sub badgerAskVar {

    my($list_ref)=@_;

    foreach (@{$list_ref}) {  
	if (! defined(${$$_[0]})) {
	    &askVar($$_[0], $$_[1], $$_[2]);
	} 
    }
}


sub askVar {

    my($var_ref, $prompt_str, $def)=@_;

    $$var_ref=$def;
    print "$prompt_str [$$var_ref] ";

    my $reply;
    chomp($reply=<STDIN>);

    if ( $reply ne "" ) {
        $$var_ref=$reply;
    }  
}




1;


############# end of file ###############
# Local Variables:
# mode:perl
# End:
############# end of file ###############
