package StingArgs;

use strict;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
use Term::ANSIColor qw(:constants);

require Exporter;

@ISA = qw(Exporter AutoLoader);

@EXPORT = qw( getCommandArguments printCommandArguments moduleArguments PrintCommandHeader );

sub _getFormattingCharacterMap {
	my %fcmap = (
		'section' => '',
		'arg' => '',
		'default' => '',
		'end' => ''
	);

	if (defined($ENV{'ARACHNE_PRETTY_HELP'})) {
		if ($ENV{'ARACHNE_PRETTY_HELP'} eq 'Color') {
			$fcmap{'section'} = (RED . BOLD);
			$fcmap{'arg'} = (MAGENTA . BOLD);
			$fcmap{'default'} = BLUE;
			$fcmap{'end'} = RESET;
		} elsif ($ENV{'ARACHNE_PRETTY_HELP'} eq 'Bold') {
			$fcmap{'section'} = BOLD;
			$fcmap{'arg'} = BOLD;
			$fcmap{'arg'} = BOLD;
			$fcmap{'default'} = "";
			$fcmap{'end'} = RESET;
		}
	}

	return %fcmap;
}

sub _usage {
	my ($requiredArgsRef, $helpRef) = @_;
	my %requiredArgs = %$requiredArgsRef;
	my %help = (defined($helpRef)) ? %$helpRef : ();
	my %optionalArgs;
	my %fcmap = &_getFormattingCharacterMap();
	
	print "\n$fcmap{'section'}Usage: $0 arg1=value1 arg2=value2 ...$fcmap{'end'}\n\n";

	print "$fcmap{'section'}Required arguments:$fcmap{'end'}\n\n";

	foreach my $key (sort { $a cmp $b } keys(%requiredArgs)) {
		next if ($key =~ /_postprocess/ || $key =~ /_preprocess/);
		if (defined($requiredArgs{$key})) { $optionalArgs{$key} = $requiredArgs{$key}; }
		else {
			print "$fcmap{'arg'}$key$fcmap{'end'}\n";

			if (defined($help{$key})) {
				print "  $help{$key}\n";
			}
		}
	}
	print "\n";
	
	return unless keys(%optionalArgs);
	
	print "$fcmap{'section'}Optional arguments:$fcmap{'end'}\n\n";

	foreach my $key (sort { $a cmp $b } keys(%optionalArgs)) {
		if (defined($requiredArgs{$key})) {
			print "$fcmap{'arg'}$key$fcmap{'end'} $fcmap{'default'}default: " . ((ref($requiredArgs{$key}) eq 'ARRAY') ? "\"{" . join(",", @{$requiredArgs{$key}}) . "}\"" : $requiredArgs{$key}) . "$fcmap{'end'}\n";

			if (defined($help{$key})) {
				print "  $help{$key}\n";
			}
		}
	}
	print "\n";
}

# Parse the command-line arguments in Arachne style (including the ability to have whitespace between an equal sign and the parameter.
sub getCommandArguments {
	my %requiredArgs = @_;
	my %help;

	# Clean up our required arguments
	foreach my $key (keys(%requiredArgs)) {
		if (ref($requiredArgs{$key}) eq 'HASH') {
			$help{$key} = ${$requiredArgs{$key}}{'help'};
			$requiredArgs{$key} = ${$requiredArgs{$key}}{'value'};
		}
		if (defined($requiredArgs{$key})) {
			$requiredArgs{$key} =~ s/[\r\n]//g;
		}
	}

	# Set our required argument defaults.
	my %args = (
		'NO_HEADER' => 0,
		%requiredArgs,
	);

	if (defined($requiredArgs{'NH'}) && $requiredArgs{'NH'} =~ /(True|true|1)/) {
		$args{'NO_HEADER'} = 1;
		delete($args{'NH'});
		delete($requiredArgs{'NH'});
	}

	# Print usage and exit if we're not supplied with any arguments.
	if ($#ARGV == -1) {
		if (defined($requiredArgs{'_usage'})) { &{$requiredArgs{'_usage'}}(\%requiredArgs, \%help); }
		else { &_usage(\%requiredArgs, \%help); }
		exit(-1);
	}

	# Clean up the command-line arguments so that we can accept arguments with spaces and things like 'KEY= VALUE' in addition to the normal 'KEY=VALUE'.
	for (my $i = 0; $i <= $#ARGV; $i++) {
		my $arg = $ARGV[$i];
		if ($arg =~ /\w+=$/) {
			until (($i+1) > $#ARGV || $ARGV[$i+1] =~ /\w+=/) { $arg .= $ARGV[++$i]; }
		}
		
		if ($arg =~ /(NO_HEADER|NH)=(\s)?(True|true|1)/) { # Turn off automatic banner
			$args{'NO_HEADER'} = 1;
		} elsif ($arg =~ /(.+)=(.+)/) {
			my ($key, $value) = ($1, $2);

			# Store arguments that are of no interest to us in a separate variable.  This makes it convenient to allow certain arguments to pass through to another script by simply appending this extra argument to its command-line.
			if (!exists($requiredArgs{$key})) {
				$args{'_extra'} .= " $key=\"$value\"";
			}

			if    ($value eq 'True'  || $value eq 'true'  || ($value =~ /^\d+$/ && $value == 1)) { $args{$key} = 1; } # Parse boolean values
			elsif ($value eq 'False' || $value eq 'false' || ($value =~ /^\d+$/ && $value == 0)) { $args{$key} = 0; }
			elsif ($value =~ /{(.+)}/) { # Parse array values
				$value = $1;
				$value =~ s/\s+//g;
				my @values = split(",", $value);
				$args{$key} = \@values;
			} else { # Parse a regular ol' KEY=VALUE pair
				$args{$key} = $value;
			}
		} elsif ($arg =~ /(.+)=$/) { # Parse a KEY=VALUE pair where VALUE is empty
			$args{$1} = "";
		} elsif ($arg =~ /-(h|help|\?)/) { # Print help
			if (defined($requiredArgs{'_usage'})) { &{$requiredArgs{'_usage'}}(\%requiredArgs, \%help); }
			else { &_usage(\%requiredArgs, \%help); }

			exit(-1);
		}
	}

	# Pre-process arguments
	if (defined($requiredArgs{'_preprocess'})) {
		&{$requiredArgs{'_preprocess'}}(\%args);
		delete($args{'_preprocess'});
	}

	# Print the header box with info about the command
	&PrintCommandHeader() unless ($args{'NO_HEADER'});

	# Did the user forget any arguments?
	my $missingArgs = 0;
	foreach my $requiredArg (keys(%requiredArgs)) {
		if ($requiredArg !~ /_(pre|post)process/ && !defined($args{$requiredArg})) {
			print "$requiredArg must be supplied.\n";
			$missingArgs = 1;
		}
	}

	if ($missingArgs) { die ("Error: some required arguments were not supplied.\n"); }

    # Post-process arguments
    if (defined($requiredArgs{'_postprocess'})) {
		&{$requiredArgs{'_postprocess'}}(\%args);
		delete($args{'_postprocess'});
	}

	# We're all good!
	return %args;
}

# Print our command arguments
sub printCommandArguments {
	my ($argsref) = @_;
	my %args = %$argsref;

	foreach my $key (sort { $a cmp $b } keys(%args)) {
		if (ref($args{$key}) eq 'ARRAY') {
			print "$key => {" . join(",", @{$args{$key}}) . "}\n";
		} else {
			print "$key => $args{$key}\n";
		}
	}
}



# Returns a hash (by reference) with the required command-line arguments
# for the named C++ module.
# The trick is to run the module with no arguments, prompting the usage message
# (defined in system/ParsedArgs.cc), and then capture and parse this message.
sub moduleArguments($) {
    my ($module_name) = @_;
    my %args;
    my ($key, $value);
    
    # Temporarily setenv ARACHNE_PRETTY_HELP to "Bold" - to help with parsing
    my $temp = $ENV{'ARACHNE_PRETTY_HELP'};
    $ENV{'ARACHNE_PRETTY_HELP'} = "Bold";
    
    # Escape character - appears in output when ARACHNE_PRETTY_HELP="Bold"
    my $esc = chr(27);
    my $optional = 0;
    
    open (FH, "$module_name |");
    
    # Process each line of output into a command-line argument
    foreach my $line (<FH>) {
	
	$optional = 1 if ($line =~ /Optional arguments/);
	
	# Match line against the specific stdout format given in ParsedArgs
	next unless ($line =~ /$esc\[01m(.+?)$esc\[0m(.+)/);
	$key = $1;
	
	# If an argument is optional, but no value is specified in the usage
	# message, this means that the default value is in fact an empty string
	$value = $optional ? "" : undef;
	
	# Look for a default value in this line
	if ($2 =~ /default\: (.+)$/) {
	    $value = $1;
	}
	
	$args{$key} = $value;
    }
    close FH;
    $ENV{'ARACHNE_PRETTY_HELP'} = $temp;
    
    
    
    return \%args;
}




# Print the fancy header box with info about the command,
# including arguments supplied to it
# This parallels the function PrintTheCommandPretty in system/ParsedArgs.cc
sub PrintCommandHeader {
    
    my ($fh, $prefix, $thickbar) = (*STDOUT, ''); # default values
    $fh     = $_[0] if ($_[0]); # filehandle to print the header to
    $prefix = $_[1] if ($_[1]); # string to be prepended to every line of the header
    $thickbar = $_[2] if ($_[2]); # print a thicker version of the bar ('=')
    my $width = 80;
    
    my @stat = stat $0;
    my $mtime = localtime($stat[9]);
    
    my $bar = $thickbar ? '='x$width : '-'x$width;
    my $timestamp = localtime() . " run (pid=" . $$ . "), last modified $mtime";
    
    my $command = $0;
    $command .= ' ' while length $command < $width - 1;
    $command .= "\\";
    
    # Fill @args_parsed with lines of (parsed) info about the args
    my @args = @ARGV;
    my @args_parsed = ();
    my $line = '    ';
    while (@args) {
	my $arg = shift @args;
	
	# Start a new line, if necessary
	if (length($line) + 1 + length($arg) >= $width - 1 &&
	    $line ne '') {
	    $line .= ' ' while length $line < $width - 1;
	    $line .= "\\";
	    push @args_parsed, $line;
	    $line = '    ';
	}
	
	$line .= "$arg ";
    }
    if ($line) {
	push @args_parsed, $line;
    }
    
    
    # We have prepared the output lines;
    # now, prepend each line with the prefix, and append a newline
    map {$_ = "$prefix$_\n"} ($bar, $timestamp, $command, @args_parsed);
    
    # Print lines to filehandle
    print $fh $bar;
    print $fh $timestamp;
    print $fh $command;
    print $fh @args_parsed;
    print $fh $bar;
    print $fh "\n";
}


1;