#!/usr/bin/perl
#!/opt/local/bin/perl
use Getopt::Long;
#
# Search given file(s) for calls to sub addfld (put a field on secondary
# histories). The following actions are taken, according to options set:
#   -comment   -> Comment the addfld calls with '!' in column one.  Also 
#                 comment a continuation line, if it exists after the call line
#   -uncomment -> Uncomment the calls by removing any existing comment char.
#
&GetOptions(
   "comment"    => \$comment,    # comment addfld calls
   "uncomment"  => \$uncomment,  # uncomment addfld calls
   "secflds"    => \$secflds,    # print list of SECFLDS field names
   "h|help"     => \$help
) or usage();
if ($help) { usage(); } # provide usage if help was requested
#
# Cannot set both comment and uncomment:
#
if ($comment and $uncomment) { 
  die "Please set either comment or uncomment, not both.\n"; }
if ($comment)   { print "\nWill comment out addfld calls\n"; }
if ($uncomment) { print "\nWill uncomment addfld calls\n"; }
if (not $comment and not $uncomment and not $secflds) {
  $secflds = 1; }
#
# Remaining args are input files:
#
while (@ARGV) {
  $file_in = shift;
  push(@files_in,$file_in);
}
$nfiles = $#files_in + 1;
if ($nfiles <= 0) {
  print "\n>>> No input files!\n\n";
  usage();
}
#
# Loop over input files:
#
foreach $file_in (@files_in) {
#
# Open input and output files:
  open(FILE_IN ,"< $file_in") || die "Error opening input file $file_in\n";
  $file_out = '';
  if ($comment)   { $file_out = $file_in . '.comm'; }
  if ($uncomment) { $file_out = $file_in . '.uncomm'; }
  if ($file_out) {
    open(FILE_OUT,"> $file_out") || die "Error opening output file $file_out\n";
  }
  if ($file_out) {
    print "\n------- File in: $file_in  File out: $file_out -------\n"; 
  } else {
    print "\n------------ File in: $file_in ------------\n"; 
  }
#
# Read current input file:
  while (<FILE_IN>) {
#
# Continuation line (previous line must have been a call line):
    $cont = '';
    if ( /^\s{5}(\S{1})(\s*)(.*)/ and $prevcall) {  # an uncommented continuation
#                cont  code
      $cont = "$_";
      if ($comment) { $cont = "!    $1$2$3\n"; }    # comment a continuation
      if ($file_out) { 
        print FILE_OUT "$cont"; 
        print "$cont";
      }

    } elsif ( /^\S{1}\s{4}(\S{1})(\s*)(.*)/ and $prevcall) { # a commented contin
#               comm       cont  white code
      $cont = "$_";
      if ($uncomment) { $cont = "     $1$2$3\n"; }  # uncomment a continuation
      if ($file_out) { 
        print FILE_OUT "$cont"; 
        print "$cont";
      }
    }
#
# Call line:
    $prevcall = 0;
    if (/call addfld(.*)/) {
      $call = $_;
      if ( /^(\s{6,})(.*)/ and $comment) {      # an uncommented call
#            whitesp call
        $comm = $1; $callpart = $2;
        $comm =~ s/\s{1}/!/;
        $call = "$comm$callpart\n";             # comment a call
      } elsif ($call =~ /^\S{1}(\s{5,})(.*)/ and $uncomment) {  # a commented call
#                          comm white  call
        $call = " $1$2\n";                                      # uncomment a call
      }
      if ($file_out) { 
        print FILE_OUT "$call"; 
        print "$call";
      }
      $prevcall = 1;
    } # addfld call line
#
# Add field name from first arg to list:
    if ($prevcall and $secflds) {
      $fname = &getname($call);
#     print "fname=$fname\n";
      push @fnames,$fname;
    }
#
# If line is neither call nor continuation, echo to output:
    if (not $prevcall and not $cont and $file_out) { print FILE_OUT; }

  } # while file_in
   if ($file_out) { print "Wrote file $file_out\n"; }
   if ($secflds) {
     @fnames= &deredund($file_in,@fnames);
     &printnames($file_in,@fnames);
     push @fnames_all,@fnames;
     @fnames_all = &deredund('all',@fnames_all);
   }
   undef(@fnames); # for next file
} # foreach file_in
#
# Print all fields from all files:
if ($secflds and $nfiles > 1) { &printnames('all',@fnames_all); }
#
#-----------------------------------------------------------------------
sub getname {
  my ($call) = @_; # known to be 1st line of an addfsech call
  $fname = '';
  if ( $call =~ /call addfld\('(\w+)'/ ) { $fname = $1; }
  return $fname 
} # sub getname
#-----------------------------------------------------------------------
sub deredund {
  my ($file,@fnames) = @_;
  my $name; my $found; my $nnew; my $i; 
  undef(@fnames_new);
  foreach $name (@fnames) {
    $found = 0;
    $nnew = $#fnames_new;
    for ($i = 0; $i <= $nnew; $i++) { 
      if ($fnames_new[$i] eq $name ) { $found = 1; } 
    }
    if (not $found) { 
      push @fnames_new,$name; 
#     print "deredund: added $name to fnames_new\n";
    } else {
      if ($file ne 'all') {
        print ">>> WARNING: Redundant name in file $file: $name\n";
      } else {
        print ">>> WARNING: Redundant name in total fields: $name\n";
      }
    }
#   print "nnew=$nnew fnames_new=@fnames_new\n";
  }
# print "exit deredund: fnames_new=@fnames_new\n";
  return @fnames_new;
}
#-----------------------------------------------------------------------
sub printnames {
  my ($file,@fnames) = @_;
#
# Construct quoted list of field names from @fnames, suitable for
# namelist read. This works best if field names are <= 8 chars.
# 
  my $nnamesinp = $#fnames + 1;
  my $name;
  my @fnames_new;
  foreach $name (@fnames) {
    $name =~ s/ //g;         # remove blanks
    $name = "'" . $name . "'";
    my $len = length($name);
# Append blanks to the end up to 10 chars (8-char name + 2 quotes + 1 comma)
    if ($len < 10) {        
      for ($i=$len+1; $i <= 10; $i++) { $name = $name . ' '; }
    }
    $name = $name . ',';     # add trailing comma
    $len = length($name);
    push @fnames_new,$name;
  } 
  @fnames = @fnames_new;
#
  my $npergroup = 5;
  my $nnames = $#fnames + 1;
  my $ngroups = int($nnames / $npergroup);
  my $nextra = $nnames % $npergroup;
# print "nnames=$nnames npergroup=$npergroup ngroups=$ngroups nextra=$nextra\n";
  if ($file ne 'all') {
    print "\n; $nnames fields from file $file\n";
  } else {
    print "\n------------- All fields from $nfiles files -------------------\n";
    print "; Total of $nnames fields from $nfiles files:\n";
  }
  for (my $ig=0; $ig<=$ngroups-1; $ig++) {
    if ($ig==0) { 
      print " SECFLDS = "; 
    } else {
      print "           ";
    } 
    for (my $i=0; $i<=$npergroup-1; $i++) {
      $ii = $ig * $npergroup + $i;
      print "$fnames[$ii]";
    }
    print "\n";
  }
  if ($nextra > 0) {
    for (my $i=1; $i<=$nextra; $i++) { 
      if ($i==1) {print "           ";}
      print "$fnames[$nnames - $nextra + $i - 1]";
    }
    print "\n";
  }
}
#-------------------------------------------------------------------------
sub usage {
  die <<EOF;
 
DESCIPTION
  $0 Manipulate addfld calls found in input file(s) 
 
SYNOPSIS
  $0 [options] [file1,file2,...]
 
OPTIONS
  -comment     Comment out any uncommented addfld calls (write to output file)
               (Output file name is input file name plus ".comm" suffix)

  -uncomment   Uncomment any commented addfld calls (write to output file)
               (Output file name is input file name plus ".uncomm" suffix)

  -secflds     Print field names from addfld calls to stdout in a format 
               suitable for use in a namelist read input file.

  -help        Print usage message and quit.

ARGUMENTS
  List of input files
 
NOTES
  You cannot set both comment and uncomment options.
  Input files are assumed to be fixed-format fortran source code.
  If no options are set, secflds is turned on.
  This program checks for a single continuation line to addfld calls,
    and if found, comments or uncomments it accordingly.
  Output files should always be checked for accuracy before copying 
    back to original source file.

EXAMPLES:
  Add comments to addfld calls in 2 files:
    addfld -comment file1.F file2.F

  Uncomment addfld calls in all fortran files beginning with "comp":
    addfld -uncomment comp*F

  Get list of fields from 1st arg of addfld calls, in namelist format:
    addfld -secflds comp*F
 
EOF
}
#-------------------------------------------------------------------------