#!@DASPERL
! +-======-+ 
!  Copyright (c) 2003-2007 United States Government as represented by 
!  the Admistrator of the National Aeronautics and Space Administration.  
!  All Rights Reserved.
!  
!  THIS OPEN  SOURCE  AGREEMENT  ("AGREEMENT") DEFINES  THE  RIGHTS  OF USE,
!  REPRODUCTION,  DISTRIBUTION,  MODIFICATION AND REDISTRIBUTION OF CERTAIN 
!  COMPUTER SOFTWARE ORIGINALLY RELEASED BY THE UNITED STATES GOVERNMENT AS 
!  REPRESENTED BY THE GOVERNMENT AGENCY LISTED BELOW ("GOVERNMENT AGENCY").  
!  THE UNITED STATES GOVERNMENT, AS REPRESENTED BY GOVERNMENT AGENCY, IS AN 
!  INTENDED  THIRD-PARTY  BENEFICIARY  OF  ALL  SUBSEQUENT DISTRIBUTIONS OR 
!  REDISTRIBUTIONS  OF THE  SUBJECT  SOFTWARE.  ANYONE WHO USES, REPRODUCES, 
!  DISTRIBUTES, MODIFIES  OR REDISTRIBUTES THE SUBJECT SOFTWARE, AS DEFINED 
!  HEREIN, OR ANY PART THEREOF,  IS,  BY THAT ACTION, ACCEPTING IN FULL THE 
!  RESPONSIBILITIES AND OBLIGATIONS CONTAINED IN THIS AGREEMENT.
!  
!  Government Agency: National Aeronautics and Space Administration
!  Government Agency Original Software Designation: GSC-15354-1
!  Government Agency Original Software Title:  GEOS-5 GCM Modeling Software
!  User Registration Requested.  Please Visit http://opensource.gsfc.nasa.gov
!  Government Agency Point of Contact for Original Software:  
!  			Dale Hithon, SRA Assistant, (301) 286-2691
!  
! +-======-+ 
#lnlist
# REVISION HISTORY:
#  ?????????  Owens   - add error checking
#  15Feb2007  Todling - add option to append suffix to linked filename (4d-var)
#

use Env;                         # Make env variables available
use FindBin;                     # find location of the this script
use lib "$FindBin::Bin";         # make perl libraries available
use File::Basename;              # for basename()
use Manipulate_time;             # token_resolve()
use Getopt::Std;                 # the getopts() subroutine
use Err_Log;                     # Error Logging 

my $date;
my $time;
my $rc_file;
my $fvwork;
my $strict_mode;
my $acq_latest;
my %lookup;
my @type_list;
 
# Get fvwork location 
  if  ( exists ($ENV{'FVWORK'}) ) {
       $fvwork = $ENV{'FVWORK'};
  }else{
       $fvwork = ".";
  }

# Check for strict mode
  if ( ( exists ($ENV{'STRICT'}) ) && ($ENV{'STRICT'} == 1)) {
     $strict_mode = 1;
  }else{
     $strict_mode = 0;
  }

# Get options and arguments
  getopts('a:d:t:r:s:');

# Set date
  if ($opt_d){
      $date = $opt_d;
  }else{
      die "($0) FATAL ERROR Date is required with -d yyyymmdd ";
  }

# Set time
  if ($opt_t){
      $time = $opt_t;
  }else{
      die "($0) FATAL ERROR Time is required with -t hhmmss ";
  }
  
# Check for obsys.acq.latest location
  if ($opt_a){
      $acq_latest = $opt_a;
  }else{
      $acq_latest = "$fvwork/obsys.acq.latest";
  }

# Check for lnlist.rc file location
  if ($opt_r){
      $rc_file = $opt_r;
  }else{
      $rc_file = "$fvwork/lnlist.rc";
  }

# Check if a suffix is to be appended to the file names
  if ($opt_s) {
       $suf = `printf "%02d" $opt_s`;
       $suf = ".$suf";
  } else {
       $suf = "";
  }

# Enable Error Logging 
  $error_logging = 0;
  if ( exists ($ENV{'ERROR_LOG_NAME'})){
      $error_logging = 1;
     ($error_log = $ENV{'ERROR_LOG_NAME'})=~ s/-L //;
      $expid = "x";
      $expid = $ENV{'EXPID'} if ( exists ($ENV{'EXPID'}));
  }
  print "error_logging = $error_logging\n";

# get hash table from rc file

  unless ( open( RC, "$rc_file" ) ) {
         die  "($0) FATAL ERROR: RC file $rc_file can not be opened.\n";
  }
  while ( <RC>) {
     chomp;
     if ((! /^#/ )&&(/.{1,}/))  {             # if not a comment and not a blank line
          $_ =~ tr/\t/ /s;   $_ =~ s/ //g;    # remove all white spaces
          @pair = split("=>", $_);
          $lookup{$pair[0]} = $pair[1];
     }
  }
  close(RC);

# Set list of valid types by keys of hash table
  @type_list = keys(%lookup);

# get list of observation files from obsys.acq.latest and check
# for link destinations in hash table %lookup

  unless ( open( LATEST, $acq_latest ) ) {
         die  "($0) FATAL ERROR: Configuration file '", $acq_latest, "' can not be opened.\n";
  }
# read acq file
  while ( <LATEST> ) {
     chomp;
     if ((! /^#/ )&&(/.{1,}/))  {             # if not a comment and not a blank line
          $_ =~ tr/\t/ /s;   $_ =~ s/ //g;    # remove all white spaces
          @arr = split ("=>", $_);
          if ($arr[1] ne '.') {               # input acq file has stdname
            $name = $arr[1];
          } else {
            $name = basename($arr[0]);        # no stdname (remove path)
          }
# compare with valid list
          $found = 0;
LOOP1:    foreach $type ( @type_list ) {
              if ( $name =~ $type ){
                   $dest = $lookup{$type};
                   $dest = "${dest}${suf}";
                   $found = 1;
                   last LOOP1;
              }
          }
# resolve name for status reporting
          $resolved_name = token_resolve($name, $date, $time);
# if we have a match create the link
          if ( $found ){
# remove any existing links
               unlink ($dest);
# create new link
               $rc=symlink("${fvwork}/${resolved_name}", $dest);
# check status of link creation
               if (!$rc){
                        if ($strict_mode) { 
                             err_log (5, "acquire", "${date}","${expid}","89",
                             {'err_desc' => "lnlist: FATAL ERROR: cannot symlink ${fvwork}/${resolved_name} to $dest .",
                              'log_name' => "$error_log" })if ($error_logging);
                             die "($0) FATAL ERROR cannot symlink ${fvwork}/${resolved_name} to $dest\n"; 
                        }else{
                             err_log (4, "acquire", "${date}","${expid}","89",
                             {'err_desc' => "lnlist: WARNING: cannot symlink ${fvwork}/${resolved_name} to $dest .",
                              'log_name' => "$error_log" })if ($error_logging);
                             warn "($0) WARNING cannot symlink ${fvwork}/${resolved_name} to $dest\n" ;
                        } 
               } 
          }else{
                  if ($strict_mode) {
                        err_log (5, "acquire", "${date}","${expid}","89",
                        {'err_desc' => "lnlist: FATAL ERROR No matching type found for $resolved_name check $rc_file .",
                         'log_name' => "$error_log" })if ($error_logging);
                        die "($0) FATAL ERROR No matching type found for $resolved_name check $rc_file\n";
                  }else{
                        err_log (4, "acquire", "${date}","${expid}","89",
                        {'err_desc' => "lnlist: WARNING: No matching type found for $resolved_name check $rc_file .",
                         'log_name' => "$error_log" })if ($error_logging);
                         warn "($0) WARNING No matching type found for $resolved_name check $rc_file\n";
                  }
          }
     }
  }
  close(LATEST);
#######################################################
#######################################################
exit (0);