#!/usr/bin/perl
#---#!/usr/bin/perl

# $Id: Generic.pm,v 1.2 2007-08-21 00:06:18 ericf Exp $
#
# $Log: not supported by cvs2svn $
# Revision 1.1.1.1  2007/04/17 22:28:01  ericmg
# initial import into erda insarcvs
#
# Revision 1.1.1.1  2007/04/03 03:40:02  ericmg
# initial import into erda insarcvs
#
# Revision 1.4  2005/12/16 18:45:38  bswift
# RSC keyword documentation changes.
#

package   Generic;
require   Exporter;
use       File::Basename;

@ISA    = qw(Exporter);
@EXPORT = qw(ByteRead TrimWhite Log IOcheck Median Norm Message Prog_name Read_infile Status Link_here Use_rsc Doc_rsc Min);
use Env qw(INT_SCR INT_BIN);

### Usage: ByteRead (infile, bytes_from_start, #bytes_to_read, [1])
### returns #bytes read from a point in the infile
### returns the first string, entering 1 returns all

sub Min {
  $val1 = shift;
  $val2 = shift;
  if($val1 <= $val2) 
	{ return ($val1); }
  else 
	{ return ($val2); }
}

sub ByteRead {
  $infile = shift;
  $start  = shift;
  $bytes  = shift;
  $num    = shift;

  #Old, ugly version of io, builds big buffered arrays that slow things down
  #open IN, "$infile" or die "Can't read $infile\n";
  #read IN, $junk, $start;
  #read IN, $val,  $bytes;

  sysopen IN, "$infile","r" or die "Can't read $infile\n";
  sysseek IN,$start,0;
  sysread IN, $val,  $bytes or die "sysread didn't work: $!\n";
  close IN;

  unless ($num == 1){
    $val =~ s/\s*(\S+).*/$1/;
  }
  return ($val);
}


### Usage: trimWhite (var1, var2, var3 ...)
sub TrimWhite { foreach (@_) { s/^\s*(.*?)\s*$/$1/ if $_; } @_; }

### Usage: Prog_name $0
sub Prog_name {
  $name = $0;
  $name =~ s!.*\/!!g;
  return ($name);
}

### Usage: Message "message"
### prints message to standard error and file log1
sub Message {
  $name = Prog_name $0;
  open LOG1, ">>log1";
  print LOG1 "$name @_\n";
  print STDERR "+$name @_\n";
  close(LOG1);
}

### Usage: Status "command";
### dies if errors $? are true
sub Status {
  $name = Prog_name $0;
  $command = shift;
  if ($?){ Message "$command failed in $name"; exit 1;}
}
### Usage: IOcheck(\@Infiles, \@Outfiles)
### @Infiles and @Outfiles are arrays of file names
### Checks readability of infiles
### Checks age of outfiles against age of youngest infile
### Continues program if even one outfile is old or doesn't exist
sub IOcheck {
  $in  = shift @_;
  $out = shift @_;
  @in  = @$in          or warn "No infiles specified\n";
  @out = @$out         or warn "No outfiles specified\n";
  $age = -M $in[0];
  foreach (@in) {
    unless(-r $_){
      if ($_ =~/\.(slc|int|cor|unw|amp|hgt|msk|dem|byt)$/){
	print "checking $_\n";
	if ($_ =~/(.*)_(\d+)rlks(.*)/){
	  @filelist=split /\s+/, `ls ${1}*${3}`;
	  $foundfile='';
	  $origlooks=1;
	  $newlooks=$2;
	  foreach $file (@filelist){
	    if ($file eq "${1}${3}"){
	      $foundfile=$file;
	    }
	    elsif ($file =~/(.*)_(\d+)rlks(.*)/){
	      if ($2>$origlooks and $newlooks%$2 == 0){
		$origlooks=$2;
		$foundfile=$file;
	      }
	    }
	  }
	}
      }
      if ($foundfile){
	$looks=$newlooks/$origlooks;
	print "trying: $INT_SCR/look.pl $foundfile $looks\n";
	`$INT_SCR/look.pl $foundfile $looks`;
	Status "look.pl";
      }
      else {die "$_ does not exist or is not readable\n";}   
    }
    -z $_ and die "$_ has zero size\n";
    -M $_ < $age and $age = -M $_;  ### Get age of youngest infile
  }
  foreach (@out){
    if (-e $_){  ### if outfile exists
      -w $_ or warn "$_ is not writable\n";
      $age2 = -M $_;
      if ($age2 > $age){  ###checks relative ages
	print STDERR "Infiles newer than $_\n";
	$newfiles++;
      }
    }
    else{
      `touch $_`;
      -w $_ or die "Cannot write to this directory\n";
      print STDERR "Creating $_\n";
      $newfiles++;
    }
  }
  unless ($newfiles) {
    $name = Prog_name $0;
    print STDERR "$name already done\n";
    exit 0;
  }
}

### Usage: Log("commandname", @ARGV) 
### @ARGV contains commandline arguments, so Log must be called before
### removing variables from @ARGV

sub Log {
  open (LOG,">>log");
  $date = `date +%Y%m%d:%H%M%S`; ### Example date: 19980121:120505
  chomp $date;                   ### Remove carriage return at end of date
  print LOG "$date * @_\n";      ### Print date * command arguments
  close(LOG);
}

### Usage: Norm($var1, $var2...)
sub Norm {
# must initialize $sum EJF 98/11/4
  my $sum=0;
  foreach $var (@_){
    $sum += $var**2;
  }
  $sum = sqrt($sum);
  return $sum;
}

### Usage: Median(\@{sorted array})
sub Median {
  $array = shift @_;
  @array = @$array;
  $j=0;
  foreach (@array){ $j++; }
  $k = int($j/2);
  return($array[$k]);
}

### Usage Link_here "files"
### Links files to current directory
sub Link_here {
  foreach $file1 (@_) {
    if ($file1 =~ /\*/){
      @files = split /\s+/, `ls $file1`;
      foreach $file (@files){
	$name = $file;
	$name =~ s!.*\/!!g; #Remove pathname
	if (-l $name) { print "$name already exists, assuming ok\n";}
	else{`ln -f -s $file $name`;}
      }
    }
    else{  
      $name = $file1;
      $name =~ s!.*\/!!g; #Remove pathname
      if ( -l $name) { print "$name already exists, assuming ok\n";}
      else{`ln -f -s $file1 $name`;}
    }
  }
}


# Resource Documentation Generation
#

# Should - be using File:: portable filename interface

# Directory where resource keyword documentation files (.pod, .pm, .txt)
# will be written if not overriden by ROI_RSCDOC_DIR environment variable.

my $rsc_doc_dir_default="./RscDocDir";

if (defined $ENV{ROI_RSCDOC_DIR}){
  $rsc_doc_dir=$ENV{ROI_RSCDOC_DIR}
} else {
  $rsc_doc_dir=$rsc_doc_dir_default;
}

# Directory where resource transaction history logfile (.hst)
# will be written if not overriden by ROI_RSCHST_DIR environment variable.

my $rsc_hst_dir_default=".";

if (defined $ENV{ROI_RSCHST_DIR}){
  $rsc_hst_dir=$ENV{ROI_RSCHST_DIR}
} else {
  $rsc_hst_dir=$rsc_hst_dir_default;
}


# Verify directory to hold documentation exists
#   and if not, create it

sub make_rsc_doc_dir {
  # Intended to be called every time Doc_rsc is used,
  #   because if $rsc_doc_dir is a relative path
  #   and Current Working Directory changes in caller
  #   then $rsc_doc_dir does not necessarily exist.

  # Optimizations could be done to only do check if CWD changes
  #   and $rsc_doc_dir is a relative path

  if ( ! -d $rsc_doc_dir ){
    mkdir $rsc_doc_dir, 0777 or warn "$0: >mkdir $rsc_doc_dir, 0777< failed: $!\n";
    # Should - implement "mkdir -p" semantics 

    # Should - disable recording of documentation if mkdir fails

    # Should - verify can create files in $rsc_doc_dir
  }
}


sub make_rsc_dir {
    my $dir_path_name = shift(@_);
  # Intended to be called every time Doc_rsc or Use_rsc is used,
  #   because if $dir_path_name is a relative path
  #   and Current Working Directory changes in caller
  #   then $dir_path_name does not necessarily exist.

  # Could - add optimizations to do test only if CWD has changed
  #   since last call and $dir_path_name is a relative path

  if ( ! -d $dir_path_name ){
    mkdir $dir_path_name, 0777 or die ">mkdir $dir_path_name, 0777< failed: $!\nStopped";
    # Should - implement "mkdir -p" semantics 

    # Could - disable recording of documentation if mkdir fails

    # Should - verify can create files in $dir_path_name
  }
}


# Private hash variable accessed by Doc_rsc and Use_rsc routines

#  use_rsc_doc is hash of properties and values
#  from last call of Use_rsc.
#  It is source of information used by Doc_rsc

my %use_rsc_doc=();

sub clear_use_rsc_doc {
   %use_rsc_doc=();
}


# POD documentation for Doc_rsc 
#   Documentation for other Gerneric.pm functions
#   could be added as additional =item(s)
#   If that happens, then the start of the pod
#   should be moved to the top of this file,
#   so documentation could be interspersed
#   with function definitions.
#   This pod attempts to follow structure of Perl function documentation
#   located in perlfunc.pod
#
#   Note - I used the following command update and display this documentation
#     pod2html --infile=Generic.pm --outfile=Generic.html --title='ROI Generic.pm Documentation' && netscape -remote "openFile(`pwd`/Generic.html)"
#

=pod

=head1 NAME

Generic - ROI_PAC Perl library functions

=head2 Listing of (curently documented) ROI_PAC Generic Functions

C<Doc_rsc>

=over 8

=item Doc_rsc HASH

Provied documentation for the resource-keyword accessed by the immediately preceeding C<Use_rsc> function.

HASH is a set of keys, the values of which are strings
that provide the documentation.  Each of the keywords is optional.

=over 8

=item RSC_Tip

A short expansion/clarification of the keyword name.

=item RSC_Doc

Information about the keyword.

=item RSC_Derivation

Information about how the value is calculated.

=item RSC_Comment

Additional information discovered during analysis of
the keyword that may not be of general interest.

=item RSC_Type

Value type.

=item RSC_Unit

Value unit (dimensionality).

=item RSC_Format

Format of C<String> values.

=back

I<Technically, the HASH parameters is really a Perl LIST when this function is called because Perl does not directly support subroutines with named
optional parameters.  However, usage makes it look like a HASH.>

In the current implementation, C<Doc_rsc> writes resource documentation
out in three formats.

=over 8

=item * POD - Perl's "Plain Old Documentation" format

The POD formatted documentation can be
processed into an HTML document as follows:

Concatenate POD files.  Only the most recently written POD file for
a given rsc-keyword, source line combination is included.  I<Can't just cat
all POD files together, because will have duplicate entries for
documentation produced from processing occuring in different directories
(eg the two image formation related directories 930110 and 950523)>

 find your_path/TEST_DIR/ -name '*.pod' | xargs ls -l | sort -r +7 | awk '{print $9}' | sed 's,\(^.*/\)\(.*\),\2 \1\2,' | awk '{if(seen[$1]) ; else { print $0 ; seen[$1]=1} }' | sort -t: -k1,1 -k2,2n | awk '{print $2}' | xargs cat > poly.pod

Prepend C<introduction.pod>

 cat introduction.pod poly.pod >rsc_doc.pod

Process large POD file into an HTML formatted document.

 pod2html --infile=rsc_doc.pod --outfile=rsc_doc.html --title='Resource Keyword Documentation'

=item * Perl Code

The documentation information written in a format that
allows it to be easily loaded into a Perl hash variable.

The intent is to allow the documentation (eg .pod files)
to be reproduced/reformatted without having to rerun ROI_PAC processing.

I<Note: Perl Code files are currently being produced, but
loading the data into Perl has not been tested.>

=item * Text

A simple text format listing the documentation keys,
and their string values.

I<This format is used primarily for debugging the the C<Use_rsc>.>

=back

By default rsc-keyword POD documentation files are written in
directories named C<RscDocDir/> and have filenames formatted
as I<keyword_name>B<@>I<source_filename>B<:>I<source_line_number>B<.pod>.
Perl Code and Text filenames have B<.pm> and B<.txt> suffix respectively.

For example:

 ls -1 TEST_DIR/930110/RscDocDir/PRF*
 TEST_DIR/930110/RscDocDir/PRF@make_raw.pl:361.pm
 TEST_DIR/930110/RscDocDir/PRF@make_raw.pl:361.pod
 TEST_DIR/930110/RscDocDir/PRF@make_raw.pl:361.txt

The following keys are stored along with the RSC_* documentation keys
listed above.  These keys are set automatically set
whenever C<Use_rsc> is used.

=over 8

=item RSC_Filename

The filename of the resource file containing the keyword being accessed.

=item RSC_Task

The C<Use_rsc> operation.  (eg. read or write )

=item RSC_Keyword

The resource keyword name.

=item RSC_Timestamp

The date and time of the keyword access.  Format YYYYMMDD-HHMMSS.

=item RSC_Source_Filename

The Perl source filename containing the C<Use_rsc> that
is accessing the keyword.

=item RSC_Source_Line_Number

The line number of the C<Use_rsc> in the above Perl source filename.

=item RSC_Value

The value of the keyward that was read or written.

=back

=head3 Use_rsc transaction history file

The values of the C<Use_rsc> keys above are also appended to a
logfile each time the C<Use_rsc> Perl function is called
to access a keyword in a resource file.  This allows the
history of keyword/value accesses to be reviewed after
processing has completed.  The resource transaction history filename
is the same as the resource filename, but with a B<.hst> suffix.
For example:

 cat TEST_DIR/930110/roi.dop.rsc.hst
 20050317-112118 dopav.pl 82 write DOPPLER_RANGE0 0.24772
 20050317-112118 dopav.pl 83 write DOPPLER_RANGE1 -3.23355e-06
 20050317-112118 dopav.pl 84 write DOPPLER_RANGE2 1.0003e-10
 20050317-112118 dopav.pl 85 write DOPPLER_RANGE3 0
 20050317-112118 dopav.pl 87 write SL_AZIMUT_RESOL 5.05100521922406
 20050317-112118 dopav.pl 105 write SQUINT 0.285661271082006
 20050317-112118 roi_prep.pl 111 read DOPPLER_RANGE0 0.24772
 20050317-112118 roi_prep.pl 112 read DOPPLER_RANGE1 -3.23355e-06
 20050317-112118 roi_prep.pl 113 read DOPPLER_RANGE2 1.0003e-10
 20050317-112118 roi_prep.pl 114 read DOPPLER_RANGE3 0
 20050317-112118 roi_prep.pl 115 read SL_AZIMUT_RESOL 5.05100521922406
 20050317-112118 roi_prep.pl 116 read SQUINT 0.285661271082006

Post processing the logfiles can produce additional usefull information,
such as answering "On which line of which Perl script is
is the value of each keyword first written?"  This information
was used to direct the process of documenting the resource
keywords.  The theory being that the Perl script source location
where a keyword is first written will be near where the value
is first computed, and therefore will be a good place to
insert the documentation, if one hopes to have the documentation
maintained and enhanced in the future.

The list of resource keyword first write locations was produced
with the following line:

 find TEST_DIR/ -name '*rsc.hst' -type f | xargs cat | grep ' write ' | sort | awk '{if(seen[$5]) ; else { print $0 ; seen[$5]=1} }' >rsc-kw-pl-first-write


=head3 Environment Variables

These environment variables override the default locations
where rsc-keyword documentation and C<Use_rsc> transaction history log files
are written.

=over 8

=item ROI_RSCDOC_DIR

Directory where rsc-keyword documentation files will be written.
Defaults to C<./RscDocDir> when environment variable is not set.
Being a relative path, this causes
documentation to be written to multiple subdirectories under
the processing area (eg. C<TEST_DIR>).
If a full path is specified all documentation will be written
into the specified directory.

=item ROI_RSCHST_DIR

Directory where C<Use_rsc> transaction history files will be written.
Defaults to "C<.>" (current working directory) when environment variable is not set.
This causes transaction history files to be written in the same
directory as the as the resource files being accessed.
I<Note: if absolute path is specified, history file may contain transactions
from multiple resource files that have the same basename name, but exist in
different directories.>

=back


=back

=cut
# end of Doc_rsc documentation

# The standard keys used in Documentation
#   Currently this list is not used, but could be
#   to check that the doc keys are valid and warn
#   if they are not.
#   Could also be used to specify the order
#   in which they keys should be printed in the Text and Perl Code files

# If this was truly Literate Programming, the above documentation for
# these keys would be intermixed with the definition of this table.
# But doing that with perl/pod would produce a maintenance nightmare.

@doc_keys = ( # These are set via Use_rsc
	      RSC_Filename,
	      RSC_Task,
	      RSC_Keyword,
	      RSC_Timestamp,
	      RSC_Source_Filename,
	      RSC_Source_Line_Number,
	      RSC_Value,

              # These are set via Doc_rsc
	      RSC_Tip,
	      RSC_Doc,
	      RSC_Comment,
	      RSC_Derivation,
	      RSC_Type,
	      RSC_Unit,
	      RSC_Format,
	     );



# Doc_rsc

# Generates documentation for keyword used in last Use_rsc call
sub Doc_rsc {
    my %options = @_ ;

    
    # create documentation directory if needed

    make_rsc_dir $rsc_doc_dir;

    # Create basename of rsc documentation file
    #   This should be invariant on keyword documentation meaning.
    #   RSC_Keyword, RSC_Source_Filename, RSC_Source_Line_Number
    #   is minimum set of properties that uniquily identify
    #   a piece of documentation, because
    #     1. a RSC_Keyword could have different documentation
    #                   in different source files
    #     2. more than one RSC_Keyword could have documentation
    #        produced for a Source_Filename and _Line_Number
    #        combination, if the RSC_Keyword name is generated dynamically


    $rsc_doc_invariant="$use_rsc_doc{RSC_Keyword}\@$use_rsc_doc{RSC_Source_Filename}:$use_rsc_doc{RSC_Source_Line_Number}";

    $rsc_doc_txt_path="$rsc_doc_dir/$rsc_doc_invariant.txt";
    $rsc_doc_pm_path="$rsc_doc_dir/$rsc_doc_invariant.pm";
    $rsc_doc_pod_path="$rsc_doc_dir/$rsc_doc_invariant.pod";

    
    # Create txt file version of documentation
    #  format is just keys and values, unsorted (in hash keys order)

    $rscDocFile=$rsc_doc_txt_path;
    open RSCDOC, ">$rscDocFile" or die "Can't open $rscDocFile: $!\n";
    # open RSCDOC, ">&STDERR" or die "Can't open STDERR: $!\n";;

    # print documentation set by Use_rsc
    foreach $key (keys %use_rsc_doc) {
	print RSCDOC "$key --> $use_rsc_doc{$key}\n"
    }

    # print documentation passed into this routine
    foreach $key (keys %options) {
	print RSCDOC "$key -> $options{$key}\n"
    }

    close(RSCDOC) or warn "$0: error in closing file $!\n";


    # Write out the documentation in POD format

    open RSCDOCPOD, ">$rsc_doc_pod_path" or die "Can't open $rsc_doc_pod_path: $!\n";

    render_rsc_doc_as_pod(RSCDOCPOD,%options , %use_rsc_doc);

    close(RSCDOCPOD) or warn "$0: error in closing file $!\n";


    # Write out the documentation in perl code format

    open RSCDOCPM, ">$rsc_doc_pm_path" or die "Can't open $rsc_doc_pm_path: $!\n";
    render_rsc_doc_as_code(RSCDOCPM,%options , %use_rsc_doc);

    close(RSCDOCPM) or warn "$0: error in closing file $!\n";


}



sub render_rsc_doc_as_pod(*@){
    my $fh = shift(@_);
    my %d = @_ ;
    my %rsc_doc_hash = @_ ;

    ($package, $filename, $line, $subroutine_name ) = caller 0 ;

    # Could load keywords into variables with same names
    # as hash keys to eliminated 'd{}' part of reference.
    #   eg. $d{RSC_Tip} would become $RSC_Tip

    print $fh (
               "\n# Start of section created by $subroutine_name\n",

	       "\n# DO NOT EDIT THIS DOCUMENT - It is produced automatically\n",
	       "#   Content should be changed in\n",
               "#     $d{RSC_Source_Filename} after line $d{RSC_Source_Line_Number}\n",
	       "#   Formatting should be changed in\n",
               "#     $filename after line $line\n",

	       "\n=pod\n",

	       "\n=head1 $d{RSC_Keyword}",
                 $d{RSC_Tip} && " - $d{RSC_Tip}",
	       "\n",

	       "\n=head2 Properties\n",

	       "\n",
	         $d{RSC_Type} && "Type B<$d{RSC_Type}> ",
  	         $d{RSC_Unit} && "Unit B<$d{RSC_Unit}> ",
		 $d{RSC_Format} && "Format B<$d{RSC_Format}> ",
               "\n",

               "\nSource B<$d{RSC_Source_Filename}> line B<$d{RSC_Source_Line_Number}>",
               "\n",

               "\nLast operation B<$d{RSC_Task}> ",
	       "value B<$d{RSC_Value}> ",
	       "resource file B<".basename($d{RSC_Filename}).">",
               "\n",



	        $d{RSC_Doc} &&
	          "\n=head2 Documentation\n\n$d{RSC_Doc}\n",

	        $d{RSC_Derivation} &&
	          "\n=head2 Derivation\n\n$d{RSC_Derivation}\n",

	        $d{RSC_Comment} &&
	          "\n=head2 Commentary\n\n$d{RSC_Comment}\n",

	       "\n=cut\n",

               "\n# End of section created by $subroutine_name\n",

               "\n",
	       );

}


# would like to
#    use Data::Dumper;
#    print Dumper($use_rsc_doc);
# however, old perl on SGI's does not have Data::Dumper;

use ExtUtils::MakeMaker ();

sub render_rsc_doc_as_code(*@){
    my $fh = shift(@_);
    my %d = @_ ;
    my %rsc_doc_hash = @_ ;

    $subroutine_name=(caller 0)[3];

    $msg="# Start of section created by $subroutine_name\n";
    print $fh (qq[$msg\%rsc_doc_hash = \(\n]);
    foreach (sort keys %rsc_doc_hash) {
        print $fh (
                   "  '$_' => ",
                   ExtUtils::MakeMaker::neatvalue($rsc_doc_hash{$_}),
                   ",\n"
                  );
    }

    print $fh (");\n1;\n");
    print $fh "# End of section created by $subroutine_name\n";

}


#Usage: Use_rsc rsc_prefix read   keyword1 [keyword2] ...
#       Use_rsc rsc_prefix delete keyword1 [keyword2] ...
#       Use_rsc rsc_prefix write  keyword1 value1 [keyword2 value2] ...
#       Use_rsc rsc_prefix merge  rsc_prefix2
#
#Note: task=write will also replace an existing value.
#      task=delete will remove the entire line.
#      task=merge will form the union and dump into file1

# XXX - note the above comment is wrong (probably predates perl implementation)
# XXX   Use_rsc only works with one keyword
# XXX   and rsc_prefix is the resource filename.


sub Use_rsc{
  @args = split /\s+/, shift @_;
  $rscfile1 = shift @args;
  $task     = shift @args;


### Check tasks
  if ($task eq "merge"){
    $rscfile2 = shift @args;
  }
  elsif ($task =~ /^(read|delete|write)$/) {
    $keyword  = shift @args;
    $value    = shift @args;
    $rscfile2 = '';
  }
  else {die "Woops, unknown task <$task> in Use_rsc\n";}
  
  
##### check rscfile format #####
  $rscfile1 =~ /\.rsc$/ or $rscfile1 = "$rscfile1.rsc";
  $rscfile2 =~ /\.rsc$/ or $rscfile2 = "$rscfile2.rsc";

  # create transaction history log directory if needed

  make_rsc_dir $rsc_hst_dir;

  if ( $rsc_hst_dir eq "." ) {
    $rscHistoryFile="$rscfile1.hst";
  } else {
    # XXX - policy for mapping resource filename to 
    #   history filename when history files are not going into
    #   the same directory as resource file could be improved/different.
    #   Needs more thought, which probably isn't warranted.
    #   This should keep code from die-ing in few cases where the
    #   the path to the resource file is more than just a basename.

    $rscHistoryFile="$rsc_hst_dir/".basename($rscfile1).".hst";

    # Should possibly do equivelent of "mkdir -p `dirname $rscHistoryFile`"
  }


  open HIST, ">>$rscHistoryFile" or die ">open >>$rscHistoryFile< failed: $!\nStopped";

  # find out where called from,
  # climbs up stack frames until outside any 'eval' operations
  for ( $filename = '(eval)', $subroutine = '(eval)', my $i = 0 ;
	( $filename =~ /(eval.*)/ ||
	  $subroutine =~ /(eval.*)/ ) &&
	$i < 17 ; # prevent infinite loop
        $i++ )
  {
    ($package, $filename, $line, $subroutine ) = caller $i ;
  }

  my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)=localtime;
  my $timeStamp=sprintf '%d%02d%02d-%02d%02d%02d',
    $year+1900, 1+$mon, $mday, $hour, $min, $sec;
  my $logStamp=sprintf '%s %s %s', $timeStamp,basename($filename),$line;


  # initialize most of info needed for Doc_rsc
  clear_use_rsc_doc();
  $use_rsc_doc{RSC_Filename}=$rscfile1;
  $use_rsc_doc{RSC_Task}=$task;
  $use_rsc_doc{RSC_Keyword}=$keyword;
  $use_rsc_doc{RSC_Timestamp}=$timeStamp;
  $use_rsc_doc{RSC_Source_Filename}=basename($filename);
  $use_rsc_doc{RSC_Source_Line_Number}=$line;

  
##### read keyword value #####
  
  if ($task eq "read") {
    open RSC1, "$rscfile1" or die "Can't read $rscfile1\n";
    $found = 0;
    foreach $line (<RSC1>) {
      if ($line =~ /^$keyword\s+(\S+)/) {  
	$value  = "$1";
	$found  = 1;
	last; #match only first occurence
      }
    } 
    defined $value or warn "Keyword $keyword doesn't exist in $rscfile1, returning 0\n";
    # ROI BUG: is returning uninitialized value, not 0

    printf HIST "%s %s %s %s\n",$logStamp,$task,$keyword,$value;   
    close(HIST) or warn "$0: error in closing file $!\n";

    $use_rsc_doc{RSC_Keyword}=$keyword;
    $use_rsc_doc{RSC_Value}=$value;

      return($value);
    close(RSC1) or warn "$0: error in closing file $!\n";
  } 
  
##### delete keyword and value #####
  
  if ($task eq "delete") {
    open RSC1, "$rscfile1"  or die "Can't read $rscfile1\n";    
    open RSC2 , ">temp.rsc" or die "Can't write to temp.rsc\n"; 
    foreach $line (<RSC1>) {
      unless ($line=~/^$keyword(\s+)/) {
	print RSC2 "$line";   
      }
    }
    close(RSC1) or warn "$0: error in closing file $!\n";
    close(RSC2) or warn "$0: error in closing file $!\n";
    rename("temp.rsc",$rscfile1);    

    printf HIST "%s %s %s\n",$logStamp,$task,$keyword;
    close(HIST) or warn "$0: error in closing file $!\n";

    $use_rsc_doc{RSC_Keyword}=$keyword;

    return(0);
  } 
  
##### write/replace keyword value #####

  if ($task eq "write") {
    $value or $value = 0;
    `touch $rscfile1`;
    open RSC1, "$rscfile1" or die "Can't read $rscfile1\n";   
    open RSC2, ">temp.rsc" or die "Can't write to temp.rsc\n"; 
    $found = 0;
    foreach $line (<RSC1>) {
      $caught = 0;
      $line =~ /^$keyword(\s+)(\S*)/ and $caught = 1; 
      if ($caught){
	printf RSC2 "%-40s %-30s\n",$keyword,$value;   
	$found = 1;
      }
      else{
	print RSC2 $line;
      }
    }
    unless ($found) {
      printf RSC2 "%-40s %-30s\n",$keyword,$value;   
    }
    close(RSC1) or warn "$0: error in closing file $!\n";
    close(RSC2) or warn "$0: error in closing file $!\n";  
    rename("temp.rsc",$rscfile1);

    printf HIST "%s %s %s %s\n",$logStamp,$task,$keyword,$value;
    close(HIST) or warn "$0: error in closing file $!\n";

    $use_rsc_doc{RSC_Keyword}=$keyword;
    $use_rsc_doc{RSC_Value}=$value;

    return(0);
  }
  
##### merge rsc files, first file has precedence #####

  if ($task eq "merge") {
    open RSC1, "$rscfile1" or die "Can't read $rscfile1\n"; 
    open RSC2, "$rscfile2" or die "Can't read $rscfile2\n";
    @rsc1 = <RSC1>;
    @rsc2 = <RSC2>;
    close(RSC1) or warn "$0: error in closing file $!\n";
    open RSC1, ">>$rscfile1" or die "Can't write to $rscfile1\n";
    $found = 0;
    
    foreach $line2 (@rsc2) {
      ($keyword2,$value) = split(" ",$line2,2);
      # XXX ROI BADCODE above
      # Should Match like 'read'
      #   above leaves trailing blanks and newline in $value
      $line2 =~ /^$keyword2\s+(\S+)/;
      $value2  = "$1";

      $found = 0;
      
      foreach $line (@rsc1) {
	($keyword,$value) = split(" ",$line,2);
	if ($keyword eq $keyword2) { 
	  $found = 1;
	  last;
	}       
      } 
      unless ($found) {
	print RSC1 "$line2";   

        printf HIST "%s %s %s %s %s\n",$logStamp,$task,$keyword2,$value2,$rscfile2;

        # NOTE: only last keyword/value pair in merge is being recorded
        #   this is reason for Doc_rsc to be called before Use_rsc
        #   so all keywords that are part of a merge will get
        #   documentation.
        $use_rsc_doc{RSC_Keyword}=$keyword2;
        $use_rsc_doc{RSC_Value}=$value2;

      }
    }
    close(RSC1) or warn "$0: error in closing file $!\n";
    close(RSC2) or warn "$0: error in closing file $!\n";

    close(HIST) or warn "$0: error in closing file $!\n";

    return(0);
  }
}

sub IsBigEndianComputer{

	#This routine detects if it is running on a Big_Endian computer.
	#This information should be saved in the resource file of any binary output products.

	my $a = 23;
	return( 1 ) if unpack( "n", pack( "S", $a )) == $a;
	return( 0 );
}

1; # this is here prevent this error
   #   Generic.pm did not return a true value at ./Use_rsc-test.pl line 12.
   # no doubt "returning last evaluated expression business"
   # and "()" is false
#!/usr/bin/perl
### use_rsc.pl

$] >= 5.004 or die "Perl version must be >= 5.004 (Currently $]).\n";

use Env qw(INT_SCR);
#use lib ".";  #### Location of Generic.pm
use Generic;

##### Usage info/check and assignment of command line arguments

sub Usage{

`$INT_SCR/pod2man.pl  $INT_SCR/use_rsc.pl`;
exit 1;
}
@ARGV > 1 or Usage();

$rscfile1 = shift;
$task     = shift;



### Check tasks
if ($task eq "merge"){
  $rscfile2 = shift(@ARGV);
}
elsif ($task =~ /^(read|delete|write)$/) {
  for ($i=0; $keywords[$i] = shift(@ARGV); $i++) {
    if ($task eq "write"){
      $value = shift (@ARGV);
      $value or $value = 0;
      $values[$i] = $value;
    }
  }
}
else {
  print STDERR "Woops, unknown task <$task>\n";
  Usage ();
}


##### check rscfile format #####
$rscfile1 =~ /\.rsc$/ or $rscfile1 = "$rscfile1.rsc";
$rscfile2 =~ /\.rsc$/ or $rscfile2 = "$rscfile2.rsc";


##### read keyword value #####

if ($task eq "read") {
  open RSC1, "$rscfile1" or die "Can't read $rscfile1\n";
  foreach $keyword (@keywords){ 
    $keyword or next;
    $found = 0;
    seek RSC1, 0, 0;
    foreach $line (<RSC1>) {
      if ($line =~ /^$keyword\s+(\S+)/) {
	print "$1 ";
	$found = 1;   #match only first occurence
	last;  
      }
    } 
    $found or print "0 ";
  }
  close(RSC1) or warn "$0: error in closing file $!\n";
} 

##### delete keyword and value #####

if ($task eq "delete") {
  foreach $keyword (@keywords){
    $keyword or next;
    open RSC1, "$rscfile1"  or die "Can't read $rscfile1\n";    
    open RSC2 , ">temp.rsc" or die "Can't write to temp.rsc\n"; 
    foreach $line (<RSC1>) {
      unless ($line=~/^$keyword(\s+)/) {
	print RSC2 "$line";   
      }
    }
    close(RSC1) or warn "$0: error in closing file $!\n";
    close(RSC2) or warn "$0: error in closing file $!\n";
    rename("temp.rsc",$rscfile1);
  }
} 

##### write/replace keyword value #####

if ($task eq "write") {
  foreach $keyword (@keywords){ 
    $keyword or next; 
    $value = shift(@values);
    $value or $value = 0;
    `touch $rscfile1`;
    open RSC1, "$rscfile1" or die "Can't read $rscfile1\n";   
    open RSC2, ">temp.rsc" or die "Can't write to temp.rsc\n"; 
    $found = 0;
    foreach $line (<RSC1>) {
      $caught = 0;
      $line =~ /^$keyword(\s+)(\S*)/ and $caught = 1; 
      if ($caught){
	printf RSC2 "%-40s %-30s\n",$keyword,$value;   
	$found = 1;
      }
      else{
	print RSC2 $line;
      }
    }
    unless ($found) {
      printf RSC2 "%-40s %-30s\n",$keyword,$value;   
    }
    close(RSC1) or warn "$0: error in closing file $!\n";
    close(RSC2) or warn "$0: error in closing file $!\n";
    rename("temp.rsc",$rscfile1);
  }
} 
##### merge rsc files, first file has precedence #####

if ($task eq "merge") {
  open RSC1, "$rscfile1" or die "Can't read $rscfile1\n"; 
  open RSC2, "$rscfile2" or die "Can't read $rscfile2\n";
  @rsc1 = <RSC1>;
  @rsc2 = <RSC2>;
  close(RSC1) or warn "$0: error in closing file $!\n";
  open RSC1, ">>$rscfile1" or die "Can't write to $rscfile1\n";
  $found = 0;

  foreach $line2 (@rsc2) {
    ($keyword2,$value) = split(" ",$line2,2);
    $found = 0;

    foreach $line (@rsc1) {
      ($keyword,$value) = split(" ",$line,2);
      if ($keyword eq $keyword2) { 
        $found = 1;
        last;
      }       
    } 
    unless ($found) {
      print RSC1 "$line2";   
    }
  }
  close(RSC1) or warn "$0: error in closing file $!\n";
  close(RSC2) or warn "$0: error in closing file $!\n";
}

exit 0;

=pod

=head1 USAGE

B<use_rsc.pl> I<rscfile read   keyword1 [keyword2] ...>

       use_rsc.pl rsc delete keyword1 [keyword2] ...
       use_rsc.pl rsc write  keyword1 value1 [keyword2 value2] ...
       use_rsc.pl rsc merge  rsc_prefix2

 Note: task=write will also replace an existing value.
       task=delete will remove the entire line.
       task=merge will form the union and dump into file1
       rscfile can be full name or just prefix

=head1 FUNCTION

Manipulates the InSAR *.rsc (resource files)

=head1 ROUTINES CALLED

none

=head1 CALLED BY

none

=head1 FILES USED

I<rscfile>

=head1 FILES CREATED

none

=head1 HISTORY

Shell Script : Francois ROGEZ 96/98

Perl  Script : Rowena LOHMAN 04/18/98

=head1 LAST UPDATE

Rowena Lohman, Jun 10, 1998

=cut
