package get_hash_from_file;
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(get_hash_from_file);

sub get_hash_from_file

{
#  get_hash_from_file.pm                        WJS  Feb 10
#
#   Arguments:
#	Name of input file.  Required
#	  The input file contains comment lines of the form
#		# comments
#	  and data lines of the form
#		keyname=valuestring
#	List of diagnostic sinks (comma-separated)  Optional unless following
#	  arguments are specified.  May be empty
#       Lines of get_hash_from_file input, 1 per argument, formatted according
#	  to rules of get_hash_from_file input files.  Only lines
#	  that set control parameters are allowed.  These arguments
#	  are processed before the input file is processed.  Optional.
#   Please see get_hash_from_file.doc for options, details, etc
#
#   Returns an even number of values:
#	1) status: "OK" or a short problem description
#	2) pair count/error text:
#		number of key/value pairs (if status = "OK")
#		problem details (if status != "OK)
#	3-N) alternating key name and value strings, in the order in which
#	     they came from the file.  Returned only if status "OK"

  $version = "get_hash_from_file.pl  version 1.0  19 Feb 2010";

##################################

  ($input_file,$diagnostic_sink_list,@initialization_lines) = @_;

#   Not allowing input file named "0" 
  $input_file  ||  return ("BADINPUTARG","empty input file name");

  (defined $diagnostic_sink_list) || ($diagnostic_sink_list = "");
  @diagnostic_sink_list = split (/\,/,$diagnostic_sink_list);
#   Create an hash of file handles and open status keyed by diagnostic file
#   name
  $diag_sink_handle_and_open_status{"STDERR"} = 
	$diag_sink_handle_and_open_status{"stderr"} =
	$diag_sink_handle_and_open_status{"/dev/stderr"} =
							"STDERR,1";
  $diag_sink_handle_and_open_status{"STDOUT"} = 
	$diag_sink_handle_and_open_status{"stdout"} =
	$diag_sink_handle_and_open_status{"/dev/stdout"} =
							"STDOUT,1";
  $n_sinks = 0;
  foreach (@diagnostic_sink_list) {
#     Allow duplicates.  Probably worthy of a diagnostic - maybe I'm
#     getting soft
    if ( ! (defined $diag_sink_handle_and_open_status{$_})  ) {
      $n_sinks++;
      $diag_sink_handle_and_open_status{$_} = "SINK_$n_sinks,0";
    }
  }

  $n_diagnostics = 0;
  @diag_msgs_stack = ();

  %control_params = 
		 ("comment_char" => '#',
		  "parameter_initial_key_char" => '!',
		  "redundant_initial_key_char" => '$',
		  "redundant_line_end_char" => ';',
		  "key_value_separator_string" => '=',
		  "value_delim_initial_1" => '"',
		  "value_delim_terminating_1" => '"',
		  "value_delim_initial_2" => "'",
		  "value_delim_terminating_2" => "'");
#   Among other things, consistency check defines a scalar (eg $comment_char)
#   for each control param
  ($status,$msg) = &consistency_check();
  ($status eq "OK") || (return "BADCONTROLPARAM",$msg);

#   At this point, $n_input_recs is tracking, as a negative number,
#   the get_hash_from_file calling argument being processed.  Used
#   for error messages
  $n_input_recs = -2;
  foreach (@initialization_lines) {
    $n_input_recs--;
    ($status,$msg,$key,$value) = &do_a_line($_);
    if ($status eq "OK") {
      if ($msg eq "DATAPAIR") {
	$n_input_recs = -$n_input_recs;
	$string_for_errs = &visually_delimit($_);
	return "BADARG",
		"Argument $n_input_recs to get_hash_from_file " .
					"sets a non-control parameter\n" .
		"Argument is $string_for_errs";
      } elsif ($msg eq "CONTROLPAIR") {
#	Work (setting the parameter, then checking for consistency)
#	is done at lower levels.  Parameters are global ...
      } else {
	return "INTERNALERROR","do_a_line returned unknown OK subcode $msg";
      }
    } elsif ($status eq "NEXT") {
    } else {
      return $status,$msg;
    }
  }


  $! = 0;
  ($status = open (IN,$input_file)) ||
	return ("BADOPEN",
		"Problem opening file $input_file  " .
				"return_from_open = $status; \$! = $!");

  $n_diagnostics = 0;
  $n_input_recs = 0;
  $n_input_pairs = 0;		# Includes pairs that modify ghff behavior
  $n_input_pairs_to_return = 0;
  @return = ();

#   No error checking attempted on file reads
  while  ( defined($rec = <IN>) )  {
    $n_input_recs++;
    ($status,$msg,$key,$value) = &do_a_line($rec);
    if ($status eq "OK") {
      $n_input_pairs++;
      if ($msg eq "DATAPAIR") {
	((defined $key) && (defined $value)) ||
	      return "INTERNALERROR","do_a_line returned OK w/o key or value";
	$n_input_pairs_to_return++;
	push @return,$key;
	push @return,$value;
      } elsif ($msg eq "CONTROLPAIR") {
#	Work (setting the parameter, then checking for consistency)
#	is done at lower levels.  Parameters are global ...
      } else {
	return "INTERNALERROR","do_a_line returned unknown OK subcode $msg";
      }
    } elsif ($status eq "NEXT") {
    } else {
      return $status,$msg;
    }
  }

  close (IN);

  if ($n_diagnostics == 0) {
    return "OK",$n_input_pairs_to_return,@return;
  } else {
    return "DIAGS",
	"$n_diagnostics error conditions encountered and logged";
  }

#   No idea if next stuff will ever get used, so avoid "only 1 use" diagnostic
  undef $original_rec;
  undef $trimmed_original_rec;
  undef $n_input_recs;
  undef $n_input_pairs;
  undef $n_input_pairs_to_return;
  undef $version;

#   Because these are defined with a $$param_name, they generate
#   "only 1 use" diagnostics
  undef $comment_char;
  undef $parameter_initial_key_char;
  undef $redundant_initial_key_char;
  undef $redundant_line_end_char;
  undef $key_value_separator_string;
  undef $value_delim_initial_1;
  undef $value_delim_terminating_1;
  undef $value_delim_initial_2;
  undef $value_delim_terminating_2;
}


sub do_a_line
{
  my ($rec) = @_;

  my ($safe,$rest);
  my ($original_rec,$trimmed_original_rec);
  my ($nothing_there_msg,$errtext,$string_for_errs);
  my ($first_char,$last_char,$key,$value);
  my ($removed_init,$removed_trailing);
  my ($status,$msg,$w_d_status,$w_d_msg);

  chomp $rec;
  $rec || return "NEXT";
  $original_rec = $rec;

#   Remove comments
  if ($comment_char) {
    $safe = quotemeta($comment_char);
    ($rec,undef) = split (/$safe/,$rec);
    $rec || return "NEXT";
  }

#     Trim whitespace
  $rec =~ s/\s+$//;
  $rec =~ s/^\s+//;
  $rec || return "NEXT";
  $trimmed_original_rec = $rec;
  $string_for_errs = &visually_delimit($trimmed_original_rec);
  $nothing_there_msg = &errmsg("Nothing substantive in $string_for_errs");

#   Remove "perl start/stop characters" and trim again 
#   Done in 2 steps since we can have one but not both defined - 
#     it's not REALLY a delimiting case 
  $removed_init = $removed_trailing = 0; 

  if ($redundant_initial_key_char) {
    ($first_char,$rest) = ($rec =~ /^(.)(.*)/);
    ($first_char eq $redundant_initial_key_char) && 
				($removed_init = 1) && ($rec = $rest);
  }

#   Remember that somebody could type a 0!  NO ($val) tests when looking
#   for undefined/empty strings!

  if ( &nothing($rec) ) {
    ($status,$msg) = ("BADLINE",$nothing_there_msg);
    ($w_d_status,$w_d_msg) = &write_diagnostic($msg);
#     Next is true if write_diagnostic is happy, but ended up not writing
#     anything.  Most likely, user did not specify a sink.  Anyway, rules
#     say that if we can't write a diagnostic, we must return
    ($w_d_status eq "NOSINKSWRITTEN") && return $status,$msg;
#     $w_d_status not "OK" probably means diagnostic file open failure
#     At this point, we have the BADLINE diagnostic and the write_diagnostic
#     error, and we have to choose which to report.  Choose the error
    return ($w_d_status eq "OK") ? ("NEXT") : ($w_d_status,$w_d_msg);
  }
  if ($redundant_line_end_char) {
    ($rest,$last_char) = ($rec =~ /(.*)(.)$/);
    ($last_char eq $redundant_line_end_char) && 
				($removed_trailing = 1) && ($rec = $rest);
   }
  if ( &nothing($rec) ) {
    ($status,$msg) = ("BADLINE",$nothing_there_msg);
    ($w_d_status,$w_d_msg) = &write_diagnostic($msg);
    ($w_d_status eq "NOSINKSWRITTEN") && return $status,$msg;
    return ($w_d_status eq "OK") ? ("NEXT") : ($w_d_status,$w_d_msg);
  }

  $rec =~ s/\s+$//;
  $rec =~ s/^\s+//;
  if ( &nothing($rec) ) {
    ($status,$msg) = ("BADLINE",$nothing_there_msg);
    ($w_d_status,$w_d_msg) = &write_diagnostic($msg);
    ($w_d_status eq "NOSINKSWRITTEN") && return $status,$msg;
    return ($w_d_status eq "OK") ? ("NEXT") : ($w_d_status,$w_d_msg);
  }

#     Both or neither ...
  if ($redundant_initial_key_char && $redundant_line_end_char) {
    if 	(	($removed_init && ( ! $removed_trailing))
				|| 
	 	(( ! $removed_init) && $removed_trailing)	)	 {
      $status = "BADLINE";
      $msg =
	&errmsg("Unmatched line delimiters ",
		&visually_delimit
		      ($redundant_initial_key_char . $redundant_line_end_char), 
		" leading/trailing line $string_for_errs");
      ($w_d_status,$w_d_msg) = &write_diagnostic($msg);
      ($w_d_status eq "NOSINKSWRITTEN") && return $status,$msg;
      return ($w_d_status eq "OK") ? ("NEXT") : ($w_d_status,$w_d_msg);
    }
  }


#   Split into key and value and trim again
  $safe = quotemeta ($key_value_separator_string);
  if ($rec !~ /$safe/) {
    $status = "BADLINE";
    $msg = &errmsg("No key/value separator in $string_for_errs");
    ($w_d_status,$w_d_msg) = &write_diagnostic($msg);
    ($w_d_status eq "NOSINKSWRITTEN") && return $status,$msg;
    return ($w_d_status eq "OK") ? ("NEXT") : ($w_d_status,$w_d_msg);
  }

  ($key,$value) = split (/$safe/,$rec,2);
  if ( &nothing($key)) {
    $status = "BADKEY";
    $msg = &errmsg("No key in $string_for_errs");
    ($w_d_status,$w_d_msg) = &write_diagnostic($msg);
    ($w_d_status eq "NOSINKSWRITTEN") && return $status,$msg;
    return ($w_d_status eq "OK") ? ("NEXT") : ($w_d_status,$w_d_msg);
  }
  if ( &nothing($value)) {
    $status = "BADVALUE";
    $msg = &errmsg("No value in $string_for_errs");
    ($w_d_status,$w_d_msg) = &write_diagnostic($msg);
    ($w_d_status eq "NOSINKSWRITTEN") && return $status,$msg;
    return ($w_d_status eq "OK") ? ("NEXT") : ($w_d_status,$w_d_msg);
  }



#   DON'T strip leading whitespace.  If present, it's because
#   of a string like	$ ab=5;  and it's an error
  $key =~ s/\s+$//;
  if ( &nothing($key)) {
    $status = "BADKEY";
    $msg = &errmsg("No key in $string_for_errs");
    ($w_d_status,$w_d_msg) = &write_diagnostic($msg);
    ($w_d_status eq "NOSINKSWRITTEN") && return $status,$msg;
    return ($w_d_status eq "OK") ? ("NEXT") : ($w_d_status,$w_d_msg);
  }

  $value =~ s/\s+$//;
  $value =~ s/^\s+//;
  if ( &nothing($value)) {
    $status = "BADVALUE";
    $msg = &errmsg("No value in $string_for_errs");
    ($w_d_status,$w_d_msg) = &write_diagnostic($msg);
    ($w_d_status eq "NOSINKSWRITTEN") && return $status,$msg;
    return ($w_d_status eq "OK") ? ("NEXT") : ($w_d_status,$w_d_msg);
  }


#   Remove delimiters from value.  NOT same as removing $; pair, since
#   either of those may be empty, but here if one delim was defined, the
#   other was, too.
  ($removed_delims,$value) = 
		&remove_delims ($value,
				$value_delim_initial_1,
				$value_delim_terminating_1);
  ($removed_delims eq "INTERNALERROR")  && return "INTERNALERROR",$value;
  if ($removed_delims eq "NG") {
    $status = "BADVALUE";
#     value is an error message if $removed_delims not "OK"
    $msg = &errmsg("$value in $string_for_errs");
    ($w_d_status,$w_d_msg) = &write_diagnostic($msg);
    ($w_d_status eq "NOSINKSWRITTEN") && return $status,$msg;
    return ($w_d_status eq "OK") ? ("NEXT") : ($w_d_status,$w_d_msg);
  }
  ($removed_delims eq "TRUE") ||
      (
	($removed_delims,$value) = 
		&remove_delims ($value,
			$value_delim_initial_2,
			$value_delim_terminating_2)
      );
  ($removed_delims eq "INTERNALERROR")  && return "INTERNALERROR",$value;
  if ($removed_delims eq "NG") {
    $status = "BADVALUE";
#     $value is an error message if $removed_delims not "OK"
    $msg = &errmsg("$value in $string_for_errs");
    ($w_d_status,$w_d_msg) = &write_diagnostic($msg);
    ($w_d_status eq "NOSINKSWRITTEN") && return $status,$msg;
    return ($w_d_status eq "OK") ? ("NEXT") : ($w_d_status,$w_d_msg);
  }


#   If key/value is to modify get_hash_from_file behavior, do it
#   Otherwise, add key/value to list
#   Problems w/key in the control parameter case are fatal
  ($first_char,$rest) = ($key =~ /^(.)(.*)/);
  if ($first_char eq $parameter_initial_key_char) {
    $key = $rest;
    &nothing($key) &&
		return "BADKEY",
		       &errmsg("No control parameter in $string_for_errs");
    ($key =~ /^([\w\-\_]+)$/)
			||
		return "BADKEY",
		       &errmsg("Illegal characters in control parameter ",
		       &visually_delimit($key),
	     	       " found in record $string_for_errs");
    ($status,$errtext) = &adjust_get_hash_from_file_behavior($key,$value);
    ($status eq "OK") || 
	    return "BADVALUE",&errmsg("Problem w/control parameter\n",$errtext);
  } else {
    if (  ($key !~ /^([\w\-\_]+)$/)  )   {
      $status = "BADKEY",
      $msg = &errmsg("Illegal characters in key ",
	     	     &visually_delimit($key),
	     	     " found in record $string_for_errs");
      ($w_d_status,$w_d_msg) = &write_diagnostic($msg);
      ($w_d_status eq "NOSINKSWRITTEN") && return $status,$msg;
      return ($w_d_status eq "OK") ? ("NEXT") : ($w_d_status,$w_d_msg);
    }
    return "OK","DATAPAIR",$key,$value;
  }
  return "OK","CONTROLPAIR";
}


sub errmsg
#   Cobble together an error string id'ed by line # 
#   Caller is responsible for things like spaces between arguments
#   Routine was once much fancier & might be again, so leave it in
{
  my ($msg,$n);
#   $n_input_recs is global ... and this kludge shows why using globals
#   isn't so great - code at call depth 2 or deeper is compensating for
#   the state of things at call depth 0
  if ($n_input_recs > 0) {
    $msg = "Line $n_input_recs: ";
  } else {
    $n = -$n_input_recs;
    $msg = "get_hash_from_file calling argument $n: ";
  }

  foreach (@_) {
#     Nothingness probably an error, but let it go
    $msg .= $_;
  }
  return $msg;
}


sub visually_delimit
#   Return ->input<- ... taking into account situations where input
#   contains - or < or >
{
  my ($input) = @_;
  my (@inside_delims) = ("><","}{","||","::","!!","##");
  my (@outside_delims) = ("--","==","><","}{","++");
  my ($status);
  my ($inside_front,$inside_end,$outside_front,$outside_end);

  ($status,$inside_front,$inside_end) = 
				&neither_char_in_string($input,@inside_delims);
  ($status eq "OK") || 
		return "--ERRMAKINGTHISSTRING>$input<ERRMAKINGTHISSTRING--";
#  If none of the candidates suffice, use a set that doesn't match the
#   first and last characters of the input string.  As long as we have
#   > 2 pairs in our delimiter list, we get an answer
  if ( ! $inside_front) {
    if (length($input) == 1) {
      $c_first = $c_last = $input;
    } else {
     ($c_first,$c_last) = ($input =~ /(.).*(.)/);
    }
    ($status,$inside_front,$inside_end) = 
		&neither_char_in_string(  $c_first.$c_last  ,@inside_delims  );
    ($status eq "OK") || 
		return "--ERRMAKINGTHISSTRING>$input<ERRMAKINGTHISSTRING--";
  }

#   If none of the candidates suffice, use a copy of the inside set
  ($status,$outside_front,$outside_end) = 
		&neither_char_in_string($input,@outside_delims);
  ($status eq "OK") || 
		return "--ERRMAKINGTHISSTRING>$input<ERRMAKINGTHISSTRING--";
  if ( ! $outside_front) {
    $outside_front = $inside_front;
    $outside_end = $inside_end;
  }

  return $outside_front . $inside_front . $input . $inside_end . $outside_end;
}


sub neither_char_in_string
{
  ($string,@pairs) = @_;
  my ($c1,$c2,$status,$safe1,$safe2,@retval);
#   Can't figure out a way to do this w/o the status flag.
#   Would normally test index to see if had exceeded max, but foreach'es
#     are so much nicer than indices ...
  $status = "FOUND";
  foreach (@pairs) {
    (length($_) == 2) || 
	return "INTERNALERROR",
			"Arg $_ to neither_char_in_string not 2 chars long";
    ($c1,$c2) = /(.)(.)/;
    $safe1 = quotemeta($c1);
    $safe2 = quotemeta($c2);
    ($string =~ /[$safe1$safe2]/) && next;
    $status = "NOT_FOUND";
    last;
  }
  @retval = ($status eq "FOUND") ? () : ($c1,$c2);
  return "OK",@retval;
}


sub remove_delims
{
  my ($string,$init,$trail,$dummy) = @_;
  my ($status,$delims_as_pair,$string_for_errs);
  my ($first_char,$rest,$last_char);
  my ($removed_init,$removed_trailing);

  (defined $dummy) && return "INTERNALERROR","Extra arg";
  ($status,$delims_as_pair) = &check_delimiter_pair($init,$trail);
  ($status eq "NG") && 
	return "INTERNALERROR",
		"remove_delims asked to remove " .
		"unpaired delimiters $delims_as_pair";

  $string_for_errs = &visually_delimit($string);

  if ($init && $trail) {


    $removed_init = $removed_trailing = 0;
    ($first_char,$rest) = ($string =~ /^(.)(.*)/);
    ($first_char eq $init) && ($removed_init = 1) && ($string = $rest);
    &nothing($string) && 
	return "NG",
		"string $string_for_errs consists of a single delimiter";

    ($rest,$last_char) = ($string =~ /(.*)(.)$/);
    ($last_char eq $trail) && ($removed_trailing = 1) && ($string = $rest);
#     Note that empty $string here is A-OK.  This is how we tell people to
#     specify empty string, and specifying the empty string is probably
#     one of the few things people may actually want to do w/this program

    $removed_init && $removed_trailing && ($removed = "TRUE");
    ( ! $removed_init)  &&  ( ! $removed_trailing) && ($removed = "FALSE");
    (defined $removed) ||  
			return "NG","unpaired delimiters in $string_for_errs";

    return $removed,$string;


  } else {
    return "FALSE",$string;
  }
}




sub adjust_get_hash_from_file_behavior
{
  my ($key,$value) = @_;
  my ($simple_param_list);  

#   Keys must match keys in doc, not varnames here.  This routine
#   responsible for reconciling the 2 sets.  Hey, they're close ...
#   consistency_check routine does validation, etc
  $simple_param_list = join "|",(
				   "comment_char",
				   "parameter_initial_key_char",
				   "redundant_initial_key_char",
				   "redundant_line_end_char",
				   "key_value_separator_string"
				);
  if ($key =~ /^($simple_param_list)$/) {
    $control_params{$key} = $value;
  } elsif ($key eq "value_delim_pair_1") {
    (defined $value) || ($value = "");
    (length($value) <= 2) ||
	  return "NG",
		"parameter value_delim_pair_1 is more than 2 characters long";
    ($control_params{"value_delim_initial_1"},
     $control_params{"value_delim_terminating_1"})
		= 
	&delims_from_delim_string($value);
  } elsif ($key eq "value_delim_pair_2") {
    (defined $value) || ($value = "");
    (length($value) <= 2) ||
	  return "NG",
		"parameter value_delim_pair_2 is more than 2 characters long";
    ($control_params{"value_delim_initial_2"},
     $control_params{"value_delim_terminating_2"})
		= 
	&delims_from_delim_string($value);
  } else {
    return "NG","Unknown control parameter $key";
  }

  return &consistency_check();
}



sub consistency_check
{
  my ($s,$c,$msg,$l,$safe);
  my ($init_1,$term_1,$delims_as_pair_1,$status_1);
  my ($init_2,$term_2,$delims_as_pair_2,$status_2);
  my ($control_param,$value);

  while (  ($control_param,$value) = each %control_params ) {
    ($control_param eq "key_value_separator_string") && next;
    (length($value) > 1) &&
	  return "NG",
			"parameter " . $control_param . 
			" (value " . $value . ")" .
			" is more than 1 character in length";
    ($value =~ /[\w\d\_\-\s]/) &&
	  return "NG",
			"parameter " . $control_param . 
			" may not be a letter, number, _, -, or" .
			" a whitespace character (empty strings are allowed)";
  }

#   key/value separator
  ($s = $control_params{"key_value_separator_string"}) || 
	  return "NG","the key/value separator string must be non-empty";
  ($s =~ /[\w\d\_\-\s]/) &&
    return "NG",
	"the key/value separator string " .
	&visually_delimit($s) . " may not contain" .
	" letters, numbers, _, -, or whitespace characters";
  $l = length($s);
  while (  ($control_param,$value) = each %control_params ) {
    ($control_param eq "key_value_separator_string") && next;
    if ($l == 1) {
      ($s eq $value) &&
	return "NG",
		"the key/value separator character $s" .
		"  matches the $control_param character";
    } else {
      $safe = quotemeta($value); 
      ($s =~ /$safe/) &&
	return "NG",
		"the character " . 
		$value . 
		" in the key/value separator string " . 
		$s .
		" matches the $control_param character";
    }
  }

#   comment character
  $c = $control_params{"comment_char"};
  while (  ($control_param,$value) = each %control_params ) {
    ($control_param eq "comment_char") && next;
    ($c eq $value) &&
	return "NG","comment character $c matches the $control_param character";
  }

#   Initial key chars shouldn't match
#   Suppose they can (original design); eg, both = $, so that we expect
#	$key = val;
#	    &&
#	$$control_param = val;
#   Consider  $abc=1;  vs  $xyz=1    First is regular defn using
#     "$;" wrapping.  2nd is control parameter defn NOT using "$;" wrapping
#     2nd gets picked up as error ... until user turns off trailing ;
#     Then you have a file of  abc=1  mixed w/  $xyz=1
#   Just not worth it
  $c = $control_params{"redundant_initial_key_char"};
  ($c eq $control_params{"parameter_initial_key_char"}) &&
		return "NG","Both initial key characters defined to $c";


#   line-end character
  $c = $control_params{"redundant_line_end_char"};
  foreach ("value_delim_initial_1","value_delim_terminating_1",
	   "value_delim_initial_2","value_delim_terminating_2") {
    ($c eq $control_params{$_}) &&
	return "NG","line end character $c matches the $_ character";
  }


#   Must be a pair of delimiters or no delimiters (most likely handled
#   before this routine, but hey, this is the checker ...), and if the 2 sets
#   match, it's an error
  $init_1 = $control_params{"value_delim_initial_1"};
  $term_1 = $control_params{"value_delim_terminating_1"};
  ($status_1,$delims_as_pair_1) = &check_delimiter_pair($init_1,$term_1);
  ($status_1 eq "NG") && 
	return ($status_1,
		"Unpaired value_delim_pair_1 delimiters $delims_as_pair_1");

  $init_2 = $control_params{"value_delim_initial_2"};
  $term_2 = $control_params{"value_delim_terminating_2"};
  ($status_2,$delims_as_pair_2) = &check_delimiter_pair($init_2,$term_2);
  ($status_2 eq "NG") && 
	return ($status_2,
		"Unpaired value_delim_pair_2 delimiters $delims_as_pair_2");

  (($status_1 eq "OK_NOTPRESENT") || ($status_2 eq "OK_NOTPRESENT"))
	&&  return "OK";
  (
    ($init_1 eq $init_2) || (init_1 eq $term_2)
			 ||
    ($term_1 eq $init_2) || (term_1 eq $term_2)
  )
		&&
    return "NG","delimiter pairs may not have characterss in common.  " .
		"value_delim_pair_1 is $delims_as_pair_1; " .
		"value_delim_pair_2 is $delims_as_pair_2";

#   Define scalars (eg $comment_char) for each control param
  foreach (keys %control_params) {
    $$_ = $control_params{$_};
  }

  return "OK";  # ... after 116 lines (of 493 in whole routine) of checking
		# code (1st cut).  Users say "What could go wrong?"
		# Note this is checking stuff that people will probably not use
}



sub delims_from_delim_string
{
  my ($value) = @_;
  my ($init,$trail);

  if (length($value) == 0) {
    $init = $trail = ""; 
  } elsif (length($value) == 1) {
    $init = $trail = $value; 
  } elsif (length($value) == 2) {
    ($init,$trail) = ($value =~ /(.)(.)/);
  } else {
#     Just in case ... Presumably consistency_check will die on next vals
    $init = $trail = "BAD_LENGTH_IN_DELIMS_FROM_DELIM_STRING_CALL";
  }

  return $init,$trail;
}



sub check_delimiter_pair
{
  my ($init,$trail) = @_;

  $init && $trail &&  return "OK_PRESENT";
  ( (! $init) && (! $trail)  )  &&  return "OK_NOTPRESENT";

  $init || ($init = " ");
  $trail || ($trail = " ");
  return "NG",&visually_delimit($init.$trail);
}


sub write_diagnostic
{
  my ($msg,$dummy) = @_;
  my ($i,$handle,$already_open,$n_sinks_written);
  my ($w_d_status,$w_d_msg);

  (defined $dummy) && 
	&quit ("Internal error - wrong # non-empty args to write_diagnostic");

#   Next is probably an error, too, but getting tired of error handling
  ($msg eq "") && ($msg = "*** No msg in call to write_diagnostic ***");

#   Account for the potential to be recursively called.
  push @diag_msgs_stack,$msg;

  $n_sinks_written = 0;
  $i = 0;
  for ($i = 0; $i < @diagnostic_sink_list; $i++) {
    $sink = $diagnostic_sink_list[$i];
    ($handle,$already_open,$dummy) = 
		split /\,/,$diag_sink_handle_and_open_status{$sink};
    ($handle && ! $dummy) ||
	return "INTERNALERROR",
		"diag_sink_handle_and_open_status structure ".
			"not properly initialized"; 
    if ($already_open) {
      $open_status = $already_open;
    } else {
      $! = 0;
      $open_status = open ($handle, "> $sink");
      if ($open_status) {
	$open_status = 1;
	$diag_sink_handle_and_open_status{$sink} = "$handle,1";
      } else {
	$open_status = 0;
#	  Try to write write_diagnostics problems to other sinks.
#	  If it succeeds, we continue.  If no sinks work, arrange it
#	  so that get_hash_from_file will quit.  (In that case, I think
#	  we'd get only 1 "couldn't open sink" diagnostic, though ...)
	$diagnostic_sink_list[$i] = 
			$diagnostic_sink_list[$#diagnostic_sink_list];
	$#diagnostic_sink_list--;
	($w_d_status,$w_d_msg) =
		&write_diagnostic ("Failure to open diagnostic sink $sink. " .
				"\$! = $!");
	($w_d_status eq "NOSINKSWRITTEN") &&
		return "BADOPEN","Failure to open diagnostic sink $sink. " .
				"\$! = $!";
	($w_d_status eq "OK") && 
		$n_sinks_written++;	# During the recursion.  Note that in
					# this iteration, $open_status still = 0
#	  Next check is just to keep head on straight during recursion testing!
	($w_d_status ne "BADOPEN") && 
	    return "INTERNALERROR",
		"unexpected status $w_d_status returned from write_diagnostic";
      }
    }
    if ($open_status == 1) {
      foreach (@diag_msgs_stack) {
	chomp;
#	  Be nice to check this for errors (but see open error handling above)
	print $handle ("$_\n");
      }
      $n_sinks_written++;
    }
  }
  @diag_msgs_stack = ();

#   If all the sinks fail, we end up here, at the "top level", as if
#   no sinks had ever been specified.  This WILL result in an immediate
#   return from get_hash_from_file, but w/the original diagnostic, rather
#   than the preferred "couldn't open diagnostic file" problem.
#     Leaving it that way for v 1.0
  if ($n_sinks_written == 0) {
    return "NOSINKSWRITTEN";
  } else {
    $n_diagnostics++;	# global
    return "OK";
  }
}


sub close_sinks
{
  my ($handle,$status);

  foreach (@diagnostic_sink_list) {
    ($handle,$status,$dummy) = split /\,/,$diag_sink_handle_and_open_status{$_};
    ($handle && ! $dummy) ||
	&quit ("Internal error - diag_sink_handle_and_open_status structure" .
		" not properly initialized"); 
    if (($status != 0) && ($handle ne "STDERR") && ($handle ne "STDOUT")) {
      close ($handle);
#	Mark handle closed so we don't try to close it again ... not
#	that I think perl cares, and not that we tested to see that the
#	close actually succeeded, etc.
      $diag_sink_handle_and_open_status{$_} = "$handle,0";
    }
  }
  return;
}

sub nothing
#   Return TRUE in the "bad" conditions of undefined string or empty string
{
  my ($string) = @_;
  (defined $string) || (return 1);
  return ($string eq "");
}

1;