#!/bin/perl -I/usr/local/lib/perl5 -w
#+
# restore_state -- restore previously saved INSTRUMENT configuration
#
# Purpose:
#	Return the instrument to the state it was in when the
#	"save_state" command was last executed.
#
# Usage:
#	restore_state [-clobber] [-verify] [-debug] [-noxeq]
#		[save_file [script_file]]
# 
# Flags:
#	-(c)lobber	clobber existing script file
#	-(v)erify	validate keywords upon completion
#	-(d)ebug	print troubleshooting output
#	-(n)oxeq	do not execute the script to restore parameters,
#			only build it and exit
#	
# Arguments:
#	save_file = name of the save file to read.  The default is
#		to read the file ~/.save_state.YYYY-MMM-DD.  If the
#       	default file is read, it is also deleted.
#	script_file = name of the shell script to generate.  The default is
#		~/.restore_state.$$
# 
# Output:
#	None, unless -debug option is set
# 
# Restrictions: 
#	- Unless the clobber flag is set, this script will not
#       	overwrite an existing script file 
#
# Exit values:
#	 0 = normal completion
#	 1 = error parsing input save file
#	 2 = fatal error
#	 4 = error running script file
#	 8 = error validating keyword
#
# Example:
#	1) save all settings to the default save file, and restore them:
#		save_state
#		       ...additional commands...
#		restore_state
# 
# 	2) save all settings, including INFOMAN-only keywords, 
#	then restore and verify settings:
#		save_state -i
#		       ...additional commands...
#		restore_state -v
# 
# 	3) save state to a named file, then restore from that file:
#		save_state state1
#		       ...additional commands...
#		restore_state state1
# 
# 	4) generate, but do not execute, a script named "myscript" to 
#	restore all settings, taking readings from the default file:
#		save_state
#		restore_state -n default myscript
# 
# 	5) provide debugging output while restoring:
#		save_state
#		restore_state -d
#-
# Modification history:
#	2002-Mar-01	GDW	Original version
#	2002-Apr-15	GDW	Fixed bug in handling of $$value;
#				quoted all non-numeric string values
#	2003-Jun-02	GDW	Fixed bug in handling of strings with embedded quotes
#-----------------------------------------------------------------------

use strict;
use File::Basename;
do "/home/deimos/src/procs/info/state_defs.pl";

# variable declarations...
my( $no_xeq);
my( %option);
my( $background);
my( $clobber);
my( $verify);
my( $debug);
my( $i);
my( $max_args) = 1;
my( $save_file);
my( $lib, $keyword, $value);
my( %lib, %value, %to_restore, %to_verify);
my( @keywords);
my( @buf);
my( @status) = (0,0,0,0);
my( @cmd);
my( $count) = 0;
my( $new_value);
my( $usage) = "Usage: restore_state [-clobber] [-verify] [-debug] [-noxeq] [save_file [script_file]]\n";
my( $script_file);
my( $script_file_default) = "$ENV{HOME}/.restore_state.$$";
my( $default) = "default";

# define acceptable tolerances for various keywords...
my( %tolerance);
$tolerance{"g3tltwav"}	= 1;		# 1 Angstroms
$tolerance{"g4tltwav"}	= 1;		# 1 Angstroms
$tolerance{"g3tltval"}	= 0.0001;	# 0.0001 deg
$tolerance{"g4tltval"}	= 0.0001;	# 0.0001 deg
$tolerance{"dwfocraw"}	= 10;		# 10 counts
$tolerance{"dwfocval"}	= 10;		# 10 counts
$tolerance{"tvfocraw"}	= 10;		# 10 counts
$tolerance{"tvfocval"}	= 10;		# 10 counts
$tolerance{"focusval"}	= 10;		# 10 counts

#----------------------------------------
# Parsing arguments
#----------------------------------------

# process switches...
$i = 0;
while( $i<=$#ARGV){
  $_ = $ARGV[$i];
  if( m/^-(.)/){
    $option{$1} = 1;
    shift;
  } else {
    $i++;
  }
}

# check for help flag...
exec "help restore_state" if $option{"h"} or $option{"?"};

# check additional options...
$clobber=1 if $option{"c"};
$debug=1   if $option{"d"};
$no_xeq=1  if $option{"n"};
$verify=1  if $option{"v"};

# output...
if ( $debug){
  print STDERR "Debug mode enabled\n";
  print STDERR "Clobber mode enabled\n" if $clobber;
  print STDERR "No XEQ mode enabled\n"  if $no_xeq;
  print STDERR "Verify mode enabled\n"  if $verify;
}

# process remaining arguments...
if( $#ARGV >= 0){
  $save_file = shift;
} else {
  $save_file = $X::save_file_default;
}

if( $#ARGV >= 0){
  $script_file = shift
} else {
  $script_file = $script_file_default;
}

# complain if unparsed arguments remain...
die "$usage" if $#ARGV >= 0;

# allow use of default save file...
$save_file = $X::save_file_default if $save_file eq $default;

# verify that script filename is fully qualified...
$script_file = dirname($script_file) . "/" . basename($script_file);

#----------------------------------------
# Parsing input file
#----------------------------------------

# parse input file...
print STDERR "Save file is $save_file\n" if $debug;
open( SAVEFILE, "<$save_file")
  or die "ERROR: Can't open save file $save_file";
while( <SAVEFILE> ){

  # skip comments...
  next if m/^\#/;

  # attempt to read tokens...
  @buf = split;
  if( @buf < 3){
    warn "WARNING: trouble parsing line $. of the save file; skipping...\n";
    $status[0] = 1;
    next
  }

  # extract tokens...
  $lib = lc(shift @buf);
  $keyword = lc(shift @buf);
  $value = join " ", @buf;

  # insert tokens into hash, using keyword and library as hash indices...
  $value{$lib}{$keyword} = $value;

}
close(SAVEFILE)
  or die "ERROR: Can't close save file $save_file";

#----------------------------------------
# Building restoration script
#----------------------------------------

# create a duplicate "to_restore" hash to serve as a master list...
foreach $lib ( keys %value){
  foreach $keyword (keys %{ $value{$lib}}){
    $to_restore{$lib}{$keyword} = 1
  }
}

# verify non-existence of output file...
if ( -e $script_file ){
  if( $clobber){
    unlink $script_file
  } else {
    die "ERROR: Operation would overwrite existing script file $script_file\n"
  }
}

# begin to build script...  
open( SCRIPT, ">$script_file") 
  or die "ERROR: Can't open script file $script_file\n"; 
print STDERR "Building script file $script_file\n" if $debug; 
print SCRIPT "#!/usr/bin/sh\n";

# set motor keywords...
$background = 1; # most motors are slow and can move in parallel...
$lib = "deimot";
foreach $keyword (keys %{ $to_restore{$lib}}){

  # do not move grating or wavelength in background.  I think the
  # rationale here is that the wavelength move must wait until after
  # the grating is clamped up...
  next if ( $keyword eq "gratenam" 
	    or $keyword eq "g3tltwav" 
	    or $keyword eq "g4tltwav");
  &Add_To_Script( $lib, $keyword, \%value, \%to_restore, \%to_verify, 
		  \%tolerance, \$count, $background) 
    if $to_restore{$lib}{$keyword};
}
$background = 0;
foreach $keyword (qw( gratenam g3tltwav g4tltwav)){
  &Add_To_Script( $lib, $keyword, \%value, \%to_restore, \%to_verify, 
		  \%tolerance, \$count, $background) 
    if $to_restore{$lib}{$keyword};
}

# set remaining keywords...
$background = 0;
foreach $lib ( keys %to_restore){
  foreach $keyword (keys %{ $to_restore{$lib}}){
    next if ( $keyword eq "gratenam" 
	      or $keyword eq "g3tltwav" 
	      or $keyword eq "g4tltwav");
    &Add_To_Script( $lib, $keyword, \%value, \%to_restore, \%to_verify, 
		    \%tolerance, \$count, $background) 
      if $to_restore{$lib}{$keyword};
  }
}


# wait for tasks to complete...
print SCRIPT qq(wait\n);
print SCRIPT qq(exit\n);
close SCRIPT
  or die "ERROR: can't close script file $script_file\n";

# short circuit if no execute...
exit &b2i(@status) if $no_xeq;

# continue only if changes are required...
if( $count == 0){
  print STDERR "No changes required\n" if $debug;
} else {

  # execute the script...
  print STDERR "Executing script file $script_file\n" if $debug;
  chmod( 0755, $script_file) == 1
    or die "ERROR: can't chmod script file $script_file\n";
  if( system( "$script_file") != 0){
    warn "WARNING: script file exited with nonzero status\n";
    $status[2] = 1 
  }
  
  #----------------------------------------
  # Verifying keywords
  #----------------------------------------
  
  if( $verify){
    print STDERR "Verifying keywords\n" if $debug;
    foreach $lib ( keys %to_verify){
      foreach $keyword (keys %{ $to_verify{$lib}}){

	# verify values...
	if( &Verify_Keyword( $lib, $keyword, \%value, \%tolerance, \$new_value)){
	  print STDERR "Verified $lib " . uc($keyword) . " = $new_value\n" if $debug;
	} else {
	  $status[3] = 1;      
	  warn "ERROR: verify failed for " 
	    . uc($lib) . " keyword " . uc($keyword) 
	      . " want '" . $value{$lib}{$keyword}
	  . "' got '" . $new_value
	    . "'\n";
	}
      }
    }
  }
}

#----------------------------------------
# Clean up and exit
#----------------------------------------
print STDERR "Cleaning up\n" if $debug;
unlink $save_file if ($save_file eq $X::save_file_default 
		      and &b2i(@status) == 0);
unlink $script_file if ($script_file eq $script_file_default 
			and &b2i(@status) == 0);
exit &b2i(@status);

#----------------------------------------
# Verify_Keyword - return true if the current value of the 
# specified keyword matches the desired value
#----------------------------------------
sub Verify_Keyword {
  my( $lib, $keyword, $value, $tolerance, $new_value) = (@_);
  my( $status) = 1;
  my( $delta);

  # obtain current value of the keyword...
  $$new_value = &Show( $lib, $keyword);

  # perform numerical comparison if a tolerance is defined
  # for this keyword... 
  if ($$tolerance{$keyword}) {
    $delta = abs($$new_value - $$value{$lib}{$keyword});
    $status = 0 if $delta > $$tolerance{$keyword};
	
  # otherwise, make a case-insensitive string comparison...
  } else {
    $status = 0 if uc($$value{$lib}{$keyword}) ne uc($$new_value);
  }

  # return true if agreement was detected...
  return $status;
}

#----------------------------------------
# Add_To_Script: Write keywords to script file
# 
# This routine will first use the Verify_Keyword routine to check
# whether the specified keyword needs to be changed (no sense changing
# keywords which are already correct).  It then writes the required
# command to the script file, appending an ampersand if appropriate
# ($background==1).  The keyword is then deleted from the list of
# keywords to be restored (%to_restore) and is added to the list of
# keyword to be verified (%to_verify).
#----------------------------------------
sub Add_To_Script {
  my( $lib, $keyword, $value, $to_restore, $to_verify, 
      $tolerance, $count, $background) = @_;
  my( %ampersand, $local_value);
  $ampersand{0} = '' ; 
  $ampersand{1} = '&' ; 
  if (not &Verify_Keyword( $lib, $keyword, \%$value, \%$tolerance)){
      $_ = $value{$lib}{$keyword};

      # quote anything that's not a numeric pattern...
      if ( not m/^-?(?:\d+(?:\.\d*)?|\.\d+)$/ ){ 

	# deal with quotes...
	s/'/'\\''/g;
	$_ = qq('$_')
}
      print SCRIPT qq(modify -s $lib $keyword=$_ silent wait $ampersand{$background}\n);
      $$to_verify{$lib}{$keyword} = 1;
      $$count++;
  }
  delete $$to_restore{$lib}{$keyword};
}

#----------------------------------------
# b2i - convert a binary series of bits to a integer
#----------------------------------------
sub b2i {
  my( @status) = @_;
  my( $s) = 0;
  my( $i);

  for ( $i=0 ; $i<@status ; $i++){
    if ( $status[$i]){
      $s += 2**$i
    }
  }
  return $s
}