#!/usr/bin/env perl
#
# orig_name.pl [--verbose] file1 [file2 ... fileN]
#
# Renames a list of 'uncompressed' FITS files based on the header keyword DTACQNAM or, 
# if not present, FILENAME.
#
# If multiple source files map onto the same destination filename, successive
# files will have an "_XXXX" counter value appended to the destination
# filename.
#
# Requires:
#    WCSTOOLS: Image Header Utilities from:
#        http://tdc-www.harvard.edu/software/wcstools/
#    Perl v5.8 or greater:
#        http://www.perl.org/get.html
#
# OPTIONS:
#    --verbose
#          Prints out a log of the renaming activity, source file to
#          destination filename.
# 
# Change log:
#    2008-03-27 dscott@noao.edu
#        Initial version...
#    2008-05-05 dscott@noao.edu
#        Requires gethead to be found in the PATH somewhere.
#
#        BASH shell:
#          WCSTOOLS=/<yourinstalldir>/wcstools
#          export WCSTOOLS
#          PATH=/<yourinstalldir>/wcstools/bin:$PATH
#          export PATH
#
#        TCSH shell:
#          setenv WCSTOOLS /<yourinstalldir>/wcstools
#          setenv PATH /<yourinstalldir>/wcstools/bin:$PATH

use File::Basename;
use Getopt::Long;

@args = ("which gethead >/dev/null 2>&1");
system (@args) == 0
  or die "Can't find wcstools, please set your PATH environment and try again.";

my $verbose;

GetOptions ("verbose" => \$verbose);

my $usage = "Usage: orig_name.pl [--verbose] file [file ...]";
die "$usage\n" if $#ARGV < 0;

sub rename_file ($$) {
  my ($old, $new) = @_;
  if (rename ($old, $new)) {
    print "Renamed $old to $new\n" if ($verbose);
  } else {
    warn "Unable to rename $old to $new\n";
  }
}

foreach my $o_name (@ARGV) {
  if ( -e $o_name ) {
    my ($o_base, $o_dir, $o_ext) = fileparse ($o_name, '\\.[^.]*');
    my $extend    = `gethead EXTEND $o_name,0`;
    my $file      = "$o_name";
       $file      = "$o_name,0" if ($extend =~ /T/);
    
    my $hdr_fname = `gethead DTACQNAM $file`;
    chomp ($hdr_fname);
    
    unless ($hdr_fname) {
      $hdr_fname = `gethead FILENAME $file`;
      chomp ($hdr_fname);
    }
    
    unless ($hdr_fname) {
      warn "Unable to get the original filename for $o_name\n";
    } else {
      my ($n_base, $n_dir, $n_ext) = fileparse ($hdr_fname, '\\.[^.]*');
      my $n_name = "$n_base$o_ext";
      
      if ( -e $n_name ) {
	# Produce unique filename...
	my ($base, $dir, $ext) = fileparse ($n_name, '\\.[^.]*');
	my $num = 1;
	my $n_name = sprintf ("%s_%04d%s", $base, $num, $ext);
	while ( -e $n_name and ++$num < 10000 ) {
	  $n_name = sprintf ("%s_%04d%s", $base, $num, $ext);
	}
	if ( -e $n_name ) {
	  warn "Unable to rename $o_name to $base$ext, file exists\n";
	} else {
	  rename_file ($o_name, $n_name);
	}
      } else {
	rename_file ($o_name, $n_name);
      }
    }
  }
}