#!/usr/bin/perl

# Routine to remove a gratuitout digit from the file names.  Renames the
# label and data files and updates the label pointers.  Recurses down 
# through all directories looking for file names of the appropriate form.
#
# Format:  fix4digits
#
# Runs on the current directory.
#
#============================================================

use File::Find;

find({wanted => \& fixit, $no_chdir=>0}, ".");

# That's it for the main routine.

#-----------------------------------------------------------------------

sub fixit

  # Routine to test the current file name, and change the name if 
  # appropriate.

{ my ($filename,$line);
  my ($newname);
  my ($suffix,$prefix,$newprefix);

  # We only need to worry about files with names like "kp0505nn_0nnn.*",
  # and for data files we just need to rename the file. So check for the 
  # easy cases first:

  $filename = $_;    # just the file name

  return if ($filename !~ /^(kp0505[0-9]{2}_)0([0-9]{3})\.([a-z]{3})/);

  $suffix = $3;
  $newname = "$1$2.$3";
  $newprefix = "$1$2";
  $prefix = $filename;
  $prefix =~ s/\.[a-z]+$//;

  # If we're looking at a FITS file, we just need to rename it and we're
  # done:

  if ($suffix eq "fit")
    { rename $filename, $newname; 
      return;
    }

  # At this point we're looking at a label file.  We'll need to open it,
  # find file name references, and update accordingly.  We'll make use of 
  # the local tools for stripping and padding, and adjusting carriage 
  # control while we're at it.

  open (LBL, "varlen -rmcr $filename | ") ||
    die "Could not open $File::Find::name pipe for reading ($!).";

  open (NEW, "| fixlen -c > $newname") ||
    die "Could not open $File::Find::dir/$newname pipe for writing ($!).";

  # We'll need uppercase versions of the prefix changes for correcting
  # the PRODUCT_ID: 

  $PREFIX = $prefix;
  $PREFIX =~ tr/a-z/A-Z/;
  $NEWPREFIX = $newprefix;
  $NEWPREFIX =~ tr/a-z/A-Z/;

  while ($line=<LBL>)
    { $line =~ s/$prefix/$newprefix/;
      $line =~ s/$PREFIX/$NEWPREFIX/;
      printf NEW $line;
    }

  close(NEW);
  close(LBL);
  unlink $filename;

  return;
}