package      DRAORed;
require      Exporter;
@ISA       = qw(Exporter);
@EXPORT    = qw(convreals get_first_slot survey visfilenames latestviscode latestimageindex latestfile fileindex rfileindex readdef altreaddef writedef remove_file get_phase_center cookiecutter cookiemonster madrrget lnrget makeimage mclatim getextrema leapyear decy2ymd getbeam get_stokesandbandfromdir freq_out finalviscode madrrename hreffn addmisclogtologs add_remove_confsrc_entry checklogd mvlogww mprint liprint manip scitodec printhash superrename symlinkmf);
#@EXPORT_OK = qw();

=head1 NAME

DRAORed.pm - a perl module of useful subroutines for handling DRAO data.

=head1 USE

Put this file in your perl's @INC path, and in your perl program put

use DRAORed.pm

or

use DRAORed.pm qw(desired functions)

near the top.

=head1 RECENT CHANGES

July 27, 2005: cookiecutter() and lnrget() now return the madr index # of their
               results, or hopefully 0 on failure.
July 12, 2005: lnrget() now supports cubes.
June  8, 2005: survey() now works with the Planck Deep Field and Perseus region.
Nov. 25, 2004: latestimageindex() should now work for either 21 or 74 cm maps.
Nov. 22, 2004: survey() now works with the Cas A (xQ) fields.
June 2004: Finds old logs and reorganizes them (possibly gzipped) into an HTML
           directory.

=head1 CONTENTS

=cut

use Astangles;
use Time::Local;
#use Fcntl qw(:flock);  # import LOCK_* constants
use strict;

=item B<survey([filename])>

Get survey (field) code.

With no argument:
Looks for a valid .TBL file in the current directory. Returns -1 if none is
found, and dies if more than 1 is found.

With argument: If the above fails, guesses the pointing code from the
initial characters of $filename.

=cut
sub survey {
  return unless defined wantarray;               # Do nothing in void context.
  my @fna  = @_;
  my @tbls = <*.TBL>;

  # Watch for the multiple return points!

  # Survey codes have to be 1 to 4 characters, and most importantly this weeds
  # out TRANS.TBL and YMTRANS.TBL from CD writing software.
  my @goodtbls = grep { /^[A-Z0-9]{1,4}\.TBL/ } @tbls;

  unless(@goodtbls == 1){
    if(@fna){              # Guess from the supplied filename.
      for($fna[0]){        # Really a C-ish switch.
	/^([A-Z]\d)/     && do { return $1; };
	/^([C-I][AB]\d)/ && do { return $1; };
	/^(E[H-Z]\d)/    && do { return $1; };
	/^(L[GHI])/      && do { return $1; };
	/^(1A)/          && do { return $1; };
	/^(\dQ)/         && do { return $1; };
	/^(DF\d\d)/      && do { return $1; };
	/^(PM\d\d)/      && do { return $1; };
      }
      warn "$fna[0] is an unhelpful filename";
    }
    if (@goodtbls > 1) {
      if(wantarray){
	return @goodtbls;
      }
      die "survey() expects at most one survey in a directory.";
    }

    if (@goodtbls == 0) {
      return "-1";
    }
  }

  $goodtbls[0] =~ s/\.TBL//;
  return $goodtbls[0];
}

=item B<visfilenames($stokes, $band)>

Get visibility filenames for $stokes and $band.

=cut
sub visfilenames {
  return unless defined wantarray;               # Do nothing in void context.
  my ($stokes, $band) = @_;

  $_ = substr($stokes, 0, 1);  # Just in case there is more than one letter.
  s/./$& x 2/e;                # Double it, i.e. QQ, UU, II, VV

  # substr is a rarely needed hack so that making an ABCD map can use separate
  # A, B, C, and D visibility files.
  my $vispat   = $_ . substr($band, 0, 1) . ".V21[A-Z][A-Z]";
  $vispat =~ tr/a-z/A-Z/;
  my @visfiles = <*$vispat>;
  return wantarray ? @visfiles : "@visfiles";
}

=item B<latestviscode($stokes, $band)>

Get latest visibility code.  Subroutinized by RR from polproc.step2 (by RK).

=cut
sub latestviscode {
  return unless defined wantarray;               # Do nothing in void context.
#   system("touch latestviscode.madrout");
#   open(MADR, "|madr >> latestviscode.madrout 2>&1");
#   print MADR "name\n";
#   print MADR ".\n";
#   print MADR "\n";
#   print MADR "exit\n";
#   close(MADR);

#   open(MADROUT, "latestviscode.madrout") or
#     die "Could not open latestviscode.madrout\n";
#   $search_string="RLD.V21";
#   while (<MADROUT>) {
#     if (/$search_string(.{2})\D+(.{3})/) {
#       $visibs=$1; $visibs_nr=$2;
#       print "$visibs, $visibs_nr\n";
#     }
#   }
#   return ($visibs, $visibs_nr);
#  my ($stokes, $band) = @_;

  my @sortedcodes = split /\s+/, `ls -t *.V21??`;
  foreach (@sortedcodes) {
    s/.*\.V21//;
  }

  unless(length($sortedcodes[0]) == 2){
    die "\"$sortedcodes[0]\" does not appear to be a valid visibility code.";
  }
  return ($sortedcodes[0], $#sortedcodes + 1);
}

# =item B<latestfile($pattern)>

# Returns the name of the most recently modified file matching $pattern in the
# current directory.

# =cut
# sub latestfile {
#   my @fins = <$_[0]>;
#   my $nwfile, $nwtime;  # Autoinitialized to "" and 0, respectively.

#   foreach $_ (@fins) {
#     if (-r $_) {
#       $curtime = (stat($_))[9];
#       if ($curtime > $nwtime) {
# 	$nwtime = $curtime;
# 	$nwfile = $_;
#       }
#     }
#   }
#   return $nwfile;
# }

=item B<finalviscode()>

Get visibility code used to make the latest CLEANed image in a
directory, by reading the clean log, or die!

=cut
sub finalviscode {
  return unless defined wantarray;               # Do nothing in void context.
  my $cleanlog = latestfile("logs/clean*\.LOG logs/clean*\.LOG.gz clean*\.LOG");
  my $viscode = `zgrep ' Map   1 CLEANed!  Dirty map ' $cleanlog`;
  chomp $viscode;
  if($viscode =~
     / Map   1 CLEANed!  Dirty map .*([A-Z][A-Z])\.M[IQUV][27][14]/){
    return $1;
  }
  else{
    die "Visibility code not found in $cleanlog";
  }
}

=item B<fileindex(madr_pattern)>

madr index of files matching argument.

=cut
sub fileindex {
  return unless defined wantarray;               # Do nothing in void context.
  my $fnpattern = $_[0];
  my @findex = ();

  open(MADR, "|madr > index.madrout 2> /dev/null");
  print MADR "name\n";
  print MADR "$fnpattern\n";
  print MADR "\n";
  print MADR "exit\n";
  close(MADR);

  open(MADROUT, "index.madrout") or warn "Could not open index.madrout\n";
  while (<MADROUT>) {
    if (/entry: (\d+)/) {
      push(@findex, $1);
    }
  }
  close(MADROUT);
#  print "Last index found: $findex[-1]\n";

  return scalar(@findex) > 0 ? (wantarray ? @findex : $findex[-1]) : 0;
}

=item B<rfileindex(madr_pattern, rdir[, exactmatch])>

madr index of files in remote directory rdir matching madr_pattern.

=cut
sub rfileindex {
  return unless defined wantarray;               # Do nothing in void context.
  my $fnpattern = $_[0];
  my $rdir      = $_[1];
  $_[2] ||= 0;
  my $exactmatch = $_[2];
  my @findex = ();
  my $matcher = "entry: (\\d+)";

  open(MADR, "|madr > rindex.madrout 2>&1");
  print MADR "rdir\n";
  print MADR "$rdir\n";
  print MADR "rna\n";
  print MADR "$fnpattern\n";
  print MADR "\n";
  print MADR "exit\n";
  close(MADR);

  open(MADROUT, "rindex.madrout") || die "Could not open rindex.madrout\n";
  if($exactmatch){
    $matcher = "\\s+$fnpattern\\s+, $matcher";
  }
  while (<MADROUT>) {
    if (/$matcher/) {
      push(@findex, $1);
    }
  }
  close(MADROUT);
#  print "Last index found: $findex[-1]\n";

#  print "findex of $fnpattern\tin $rdir: @findex\n";
  return wantarray ? @findex : $findex[-1];
}

=item B<printhash(%hash)>

Prints the contents of %hash.

=cut
sub printhash{
  my %h = @_;

  foreach my $k (sort keys %h){
    print "${k}:\t$h{$k}\n";
  }
}

=item B<readdef($madr_index)>

Returns a description of a madr definition.

=cut
sub readdef {
  my $mind = $_[0];

  die "|mind| = |$mind|" unless(defined($mind) && $mind > 0);

  open(MADR, "|madr > readdef.madrout 2>&1")
    or die "Could not |madr > readdef.madrout 2>&1";
  print MADR "s f$mind\n";
  print MADR "exit\n";
  close(MADR) or die "Error closing |madr > readdef.madrout 2>&1";

  my %madrdef = ();

  open(MADROUT, "readdef.madrout") || die "Could not open readdef.madrout\n";
  while (<MADROUT>) {
    if(/^\s*File name:\s+(.*)/){
      $madrdef{FILENAME} = $1;
      $madrdef{FILENAME} =~ s/\s+$//;
    }
    elsif(/^\s*Data type:\s+(.)/){
      $madrdef{DATATYPE} = $1;
    }
    elsif (/^\s*Sizes:\s+(.*)/) {
      #   Sizes: E = 1024( 1, 1024, 1); R = 1024( 1, 1024, 1)
      #   Sizes: E = 721( 1, 721, 1); R = 361( 1, 361, 1); F = 269( 1, 269, 1)
      # Convert the sizes to what would actually be typed when writing a def.
      my $stemp = $1;
      $stemp =~ s/[A-Z]+ = //gi;
      $stemp =~ s/\([^)]+\)//g;  # Remove the stuff in brackets for now.
      $stemp =~ s/;/,/g;
      $madrdef{DIMENSIONS} = $stemp;
    }
#   Effective sizes:    E 1024   R 1024
    elsif(/^\s*No-data value:\s+([-+0-9.EeGgFf]+)/){
      $madrdef{NODATA} = $1;
    }
    elsif(/^\s*Units:\s+([0-9.]+) (.+)/){   # Order
      $madrdef{SCALFACT} = $1;
      $madrdef{UNIT}     = $2;
    }                                                 # matters
    elsif(/   Units:              (.+)/){             # here!
      $madrdef{UNIT} = $1;
    }
    elsif(/   File type: *([^ ]+) *Sky projection:\s+([SEGTVACF]) ?\(?(\d+)/){
      $madrdef{FILETYPE} = $1;
      $madrdef{SKYPROJ}  = $2;
      $madrdef{CEPOCH}   = $3;
    }
    elsif(/   File type: *([^ ]+) *Sky projection:\s+([EGTVACF])/){
      $madrdef{FILETYPE} = $1;
      $madrdef{SKYPROJ}  = $2;
    }
    elsif(/   File type: *([^ ]+) *Coordinate epoch:  \(([0-9]+)\)/){
      $madrdef{FILETYPE} = $1;    # Most likely UV.
      $madrdef{CEPOCH}   = $2;
    }
    elsif(/^\s*UV data type:\s+(.+)/){
      $madrdef{UVTYPE} = $1;
    }
    elsif(/   Reference coord.:   x: (.+) * y: (.+)/){   # Order
      $madrdef{REFCX} = $1;
      $madrdef{REFCY} = $2;
    }                                                    # matters
    elsif(/   Reference coord.:   x: (.+)/){             # here!
      $madrdef{HAREF} = $1;
    }
    elsif(/   Phase centre:       x: (.+) * y: (.+)/){
      $madrdef{REFCX} = $1;
      $madrdef{REFCY} = $2;
    }
    elsif(/   UV freq.:           ([0-9.]+) MHz/){
      $madrdef{UVFREQ} = $1;
    }
    elsif(/   Reference pixel:    x: (.+) \(pix\) * y: (.+) \(pix\)/){
      $madrdef{REFPX} = $1;                              # Order
      $madrdef{REFPY} = $2;
    }                                                    # matters
    elsif(/   Reference pixel:    x: (.+) \(pix\)/){     # here!
      $madrdef{REFHA} = $1;
    }
    elsif(/   Delta coord.:       x: (.+) * y: (.+)/){   # Order
      $madrdef{DELX} = $1;
      $madrdef{DELY} = $2;
    }                                                    # matters
    elsif(/   Delta coord.:       x: (.+)/){             # here!
      $madrdef{DELHA} = $1;
    }
    elsif(/   Spatial res.:       (.+) * x (.+) * at ([-0-9.]+D)/){
      $madrdef{BMAJ} = $1;
      $madrdef{BMIN} = $2;
      $madrdef{BPA}  = $3;
    }
    elsif(/\s*Frequency res.:\s*([0-9.]+)\s*MHz/){
      $madrdef{FRES} = $1;
    }
    elsif(/\s*Central Hel. Freq.: ([-0-9.E+]+) +MHz +[^:]+: +(.+)/){
      $madrdef{CHF}          = $1;
      $madrdef{POLARIZATION} = $2;
    }
    elsif(/\s*Data-set Bandwidth: ([0-9.]+) +MHz +Observation epoch: ([0-9.]+)/){
      $madrdef{BANDWIDTH} = $1;
      $madrdef{OBSEPOCH}  = $2;
    }
    elsif(/^\s*Last changed by:\s+(.+) on +(\d+-[A-Z][A-Z][A-Z]-\d+)/){
      $madrdef{LASTCHANGEDBY} = $1;
      $madrdef{LASTCHANGEDBY} =~ s/ +$//;
      $madrdef{LASTCHANGEDON} = $2;
    }
  }
  close(MADROUT);

  return %madrdef;
}

=item B<altreaddef($madr_index)>

Returns a description of a madr definition.  Instead of doing the obvious thing
like readdef() and using s f$madr_index, this does def f$madr_index with a long
string of newlines, and reads the definition from the defaults.  This detects
the kind of velocity coordinate, which unfortunately does not always show up in
the output of s, even though anything writing a definition needs to know.

=cut
sub altreaddef {
  open(MADR, "|madr > altreaddef.madrout 2>/dev/null")
    or die "Could not |madr > altreaddef.madrout 2>/dev/null";
  print MADR "def f$_[0]\n";
  for(my $i = 0; $i < 50; ++$i){
      print MADR "\n";
  }
  print MADR "exit\n";
  close(MADR) or die "Error closing |madr > altreaddef.madrout 2>&1";

  my %madrdef = ();

  open(MADROUT, "altreaddef.madrout") ||
      die "Could not open altreaddef.madrout\n";
  local $/ = ":";                 # MADR output is hard to read otherwise.
  while (<MADROUT>) {
#    print "|$_|: ";
    if(/\s*File name[^[]*\[([^]]+)/){
      $madrdef{FILENAME} = $1;
    }
    elsif(/^\s*Data type[^[]*\[([^]]+)/){
      $madrdef{DATATYPE} = $1;
    }
    elsif (/^\s*Current size/) {
      #   Sizes: E = 1024( 1, 1024, 1); R = 1024( 1, 1024, 1)
      #   Sizes: E = 721( 1, 721, 1); R = 361( 1, 361, 1); F = 269( 1, 269, 1)
      # Convert the sizes to what would actually be typed when writing a def.
      my $stemp = <MADROUT>;     # Not fully tested!
      $stemp =~ s/\s*Dimensions:.*//;  # Remember that $/ = :
      $stemp =~ s/\s*[A-Z]\s*//g;
      $stemp =~ s/\([^)]+\)//g;  # Remove the stuff in brackets for now.
      $stemp =~ s/;/,/g;
      chomp $stemp;
      $madrdef{DIMENSIONS} = $stemp;
    }
#   Effective sizes:    E 1024   R 1024
    elsif(/^\s*Value to indicate "undefined" data \[([^]]+)/){
      $madrdef{NODATA} = $1;
    }
    elsif(/Data-unit type\s*\[(\d+)/){ # This may LOOK like it is at the
      $madrdef{UNIT}     = $1;         # start of a line, but it is NOT
    }                                  # necessarily so!
    elsif(/^\s*Scaling factor \[([^]]+)/){
      $madrdef{SCALFACT} = scitodec($1);
    }
    elsif(/^\s*Type of file[^[]*\[([^]]+)/){
      $madrdef{FILETYPE} = $1;
    }
    elsif(/^\s*Sky projection[^[]*\[([^]]+)/){
      $madrdef{SKYPROJ}  = $1;
    }
    elsif(/^\s*Epoch for projection[^[]*\[([^]]+)/){
      $madrdef{CEPOCH}   = $1;
    }
    elsif(/^\s*Epoch for phase-center coordinates[^[]*\[([^]]+)/){
      $madrdef{CEPOCH}   = $1;
    }
    elsif(/^\s*Select velocity-like coordinate[^[]*\[([^]]+)/){
      $madrdef{VELLIKECOORD}   = $1;
    }
    elsif(/^\s*Velocity reference[^[]*\[([^]]+)/){
      $madrdef{VELREF}   = $1;
    }
    elsif(/^\s*UV type[^[]*\[([^]]+)/){
      $madrdef{UVTYPE} = $1;
    }
    elsif(/^\s*\w+ of reference element \[([^]]+)/){
      $madrdef{REFCX} = $1;
    }
    elsif(/^\s*\w+ of reference record \[([^]]+)/){
      $madrdef{REFCY} = $1;
    }
    elsif(/^\s*RA of UV phase center \[([^]]+)/){
      $madrdef{REFCX} = $1;
    }
    elsif(/^\s*DEC of UV phase center \[([^]]+)/){
      $madrdef{REFCY} = $1;
    }
    elsif(/^\s*Frequency \(MHz\) for UV data[^[]*\[([^]]+)/){
      $madrdef{UVFREQ} = $1;
    }
    elsif(/^\s*Reference ELEMENT for [^[]*\[([^]]+)/i){
      $madrdef{REFPX} = $1;
    }
    elsif(/^\s*Reference RECORD for [^[]*\[([^]]+)/i){
      $madrdef{REFPY} = $1;
    }
    elsif(/^\s*HA of reference element[^[]*\[([^]]+)/){
      $madrdef{HAREF} = $1;
    }
    elsif(/^\s*Reference ELEMENT for HA[^[]*\[([^]]+)/){
      $madrdef{REFHA} = $1;
    }
    elsif(/^\s*DELTA \"?\w+\"? per element[^[]*\[([^]]+)/){
      $madrdef{DELX} = $1;
    }
    elsif(/^\s*DELTA \"?\w+\"? per record[^[]*\[([^]]+)/){
      $madrdef{DELY} = $1;
    }
    elsif(/^\s*DELTA HA per element[^[]*\[([^]]+)/){
      $madrdef{DELHA} = $1;
    }
    elsif(/^\s*Major width[^[]*\[([^]]+)/){
      $madrdef{BMAJ} = $1;
    }
    elsif(/^\s*Minor width[^[]*\[([^]]+)/){
      $madrdef{BMIN} = $1;
    }
    elsif(/^\s*Orientation angle \(CCW from longitude axis\)[^[]*\[([^]]+)/){
      $madrdef{BPA}  = $1;
    }
    elsif(/\s*Frequency \(MHz\) resolution[^[]*\[([^]]+)/){
      $madrdef{FRES} = $1;
    }
    elsif(/\s*Central heliocentric frequency \(MHz\)[^[]*\[([^]]+)/){
      $madrdef{CHF}          = $1;
    }
    elsif(/\s*Stokes parameter[^[]*\[([^]]+)/){     # Order
      $madrdef{POLARIZATION} = $1;
    }                                               # matters
    elsif(/\s*Combination \(max 16 chars\) \[([^]]+)/){
      $madrdef{POLARIZATION} = $1;                  # here!
    }
    elsif(/\s*Data-set [Bb]andwidth \(MHz\)[^[]*\[([^]]+)/){
      $madrdef{BANDWIDTH} = $1;
    }
    elsif(/\s*Observation epoch[^[]*\[([^]]+)/){
      $madrdef{OBSEPOCH}  = $1;
    }
    elsif(/\s*Do you want a comment\?/){   # Comments can have messy :s
      last;
    }
#    if(defined $1){
#      print "|$1|\n";
#    }
#    else{
#      print "\n";
#    }
  }
  $/ = "\n";          # paranoia
  close(MADROUT);

  return %madrdef;
}

=item B<writedef($templateind, $ind, %mdef)>

Write madr definition %mdef to madr index $ind in the current directory.
$ind may or may not be already defined.

Returns 0 on success, 1 on failure.

=cut
sub writedef{
  my ($templateind, $ind, %mdef) = @_;

  open(MADR, "|madr > ${ind}.madrdef.log 2>&1")
    or die "Could not |madr > ${ind}.madrdef.log 2>&1";
  open(LOG, ">${ind}.writedef.log")
    or die "Could not >${ind}.writedef.log";
  if($ind != $templateind){
    mprint("copy f$templateind $ind\n", \*MADR, \*LOG);
  }
  mprint("def f$ind\n", \*MADR, \*LOG);
  mprint("$mdef{FILENAME}\n", \*MADR, \*LOG);	# File name
  mprint("$mdef{DATATYPE}\n", \*MADR, \*LOG);	# Data type (IRD) [R]:

  # Handle dimensions.
  if ($mdef{DIMENSIONS}) {
    mprint($mdef{DIMENSIONS}, \*MADR, \*LOG);
  }                                             # Carries through...
  mprint("\n", \*MADR, \*LOG);	                # Dimensions:

  # Not actually defined in readdef(), and AFAIK not needed.
  #print MADR "$mdef{SUBSET}\n";	# Subset [NONE]:
  mprint("\n", \*MADR, \*LOG);		# Subset [NONE]:

  if($mdef{NODATA}){
    mprint("Y\n", \*MADR, \*LOG);	# Are "undefined" data allowed? [N]:
    mprint("$mdef{NODATA}\n", \*MADR, \*LOG);
  }
  else{
    mprint("N\n", \*MADR, \*LOG);        # Are "undefined" data allowed? [N]:
  }

  # Data-unit type [1]: AARGH!  It expects an integer here instead of
  # the actual unit!
  my $unitnum = '';
  if(defined($mdef{UNIT})){
    if($mdef{UNIT} =~ /\d+/){
      $unitnum = $mdef{UNIT};
    }
    else{
      for($mdef{UNIT}){
	  /Jy\/b/i     && do { $unitnum = 1; last; };
	  /Jy\/p/i     && do { $unitnum = 2; last; };
	  /Jy \(UV\)/i && do { $unitnum = 3; last; };
	  /K/          && do { $unitnum = 4; last; };
	  /Radians/i   && do { $unitnum = 5; last; };
	  /Degrees/i   && do { $unitnum = 6; last; };
      }
    }
  }
  print MADR "$unitnum\n";                # Defaults to '\n';
  print LOG  "$unitnum";
  if(defined($mdef{UNIT})){
    print LOG " ($mdef{UNIT})";
  }
  print LOG "\n";

  if($mdef{SCALFACT}){
    mprint("$mdef{SCALFACT}\n", \*MADR, \*LOG);	# Scaling factor [10.000 E-4]:
  }
  mprint("y\n", \*MADR, \*LOG);		      # Are the parameters that
  mprint("y\n", \*MADR, \*LOG);		      # Define coordinates
  mprint("$mdef{FILETYPE}\n", \*MADR, \*LOG); # File type (RD,RV,VD,UV,XY) [RD]
  if($mdef{FILETYPE} eq "UV"){
    my $uvtypnum = "";

    for($mdef{UVTYPE}){                 # Really a switch.
      /Ungridded/              && do { $uvtypnum = 4; last; }; # Most common
      /Gridded, AP format/     && do { $uvtypnum = 1; last; };
      /Gridded, non-AP format/ && do { $uvtypnum = 2; last; };
      /Gridded, amp\/phase/    && do { $uvtypnum = 3; last; };
    }
    print MADR "$uvtypnum\n";
    print LOG  "$uvtypnum ($mdef{UVTYPE})\n";
  }
  else{                                 # Assume it is an image.
    unless($mdef{FILETYPE} eq "RD"){    # not much experience with these...
      print "Filetype: $mdef{FILETYPE}.  Check ${ind}.writedef.log!\n";
    }
    mprint("$mdef{SKYPROJ}\n", \*MADR, \*LOG);	# Sky projection (SEGTVACF) [S]:
    unless($mdef{SKYPROJ} eq "G"){              # This is a BOLD assumption!
      mprint("$mdef{CEPOCH}\n", \*MADR, \*LOG);	# Epoch (1950 or 2000):
    }
  }
  if(defined($mdef{VELLIKECOORD})){
    mprint("$mdef{VELLIKECOORD}\n", \*MADR, \*LOG); # velocity-like coordinate
  }
  else{
    mprint("\n", \*MADR, \*LOG);	  # Select velocity-like coordinate
  }
  if(defined($mdef{VELREF}) || $mdef{FILETYPE} eq "UV"){ # UV part is a FUDGE!
    mprint("\n", \*MADR, \*LOG);        # Velocity reference (LSR,SUN) [L]:
  }
  mprint("$mdef{REFCX}\n", \*MADR, \*LOG);	# RA of reference element
  mprint("$mdef{REFCY}\n", \*MADR, \*LOG);	# DEC of reference record
  if($mdef{FILETYPE} eq "UV"){
    mprint("$mdef{CEPOCH}\n", \*MADR, \*LOG);	# Epoch (1950 or 2000):
    mprint("$mdef{UVFREQ}\n", \*MADR, \*LOG);   # Not the same as CHF!
    mprint("$mdef{HAREF}\n", \*MADR, \*LOG); # HA of ref. elem. [-6H 0M 0.00S]:
    mprint("$mdef{REFHA}\n", \*MADR, \*LOG); # Ref. ELEMENT for HA [1.000]:
    mprint("$mdef{DELHA}\n", \*MADR, \*LOG); # D. HA per elem. (unsgn) [1M30S]:
  }
  else{
    mprint("$mdef{REFPX}\n", \*MADR, \*LOG); # Ref. ELEMENT for RA [513.000]:
    mprint("$mdef{REFPY}\n", \*MADR, \*LOG); # Ref. RECORD for DEC [513.000]:
    mprint("$mdef{DELX}\n", \*MADR, \*LOG);  # DELTA RA per elem. [0' 20.000"]:
    mprint("$mdef{DELY}\n", \*MADR, \*LOG);  # DELTA DEC per rec. [0' 20.000"]:
  }
  mprint("N\n", \*MADR, \*LOG);		  # Define file (3rd dimension) coord?
  if ($mdef{BPA}) {
    mprint("Y\n", \*MADR, \*LOG);     # Define resolution (beam and velocity)
    mprint("$mdef{BMAJ}\n", \*MADR, \*LOG);  # Major width [1' 12.84"]:
    mprint("$mdef{BMIN}\n", \*MADR, \*LOG);  # Minor width [1' 12.84"]:
    mprint("$mdef{BPA}\n", \*MADR, \*LOG);   # Orientation angle [-91.541D]:
    $mdef{FRES} ||= 0.0;
    mprint("$mdef{FRES}\n", \*MADR, \*LOG);  # Freq. (MHz) resolution [0.000]:
  }
  else{
    mprint("N\n", \*MADR, \*LOG);
  }
  if($mdef{CHF} or $mdef{POLARIZATION} or $mdef{BANDWIDTH} or $mdef{OBSEPOCH}){
    mprint("Y\n", \*MADR, \*LOG);     # Define aux. ast. parameters?[Y]:
    mprint("$mdef{CHF}\n", \*MADR, \*LOG);  # Central hel. frequency (MHz)
    unless($mdef{POLARIZATION} =~ /^([LR][RL]|[IV]|[QU](sst|gal)?|None)$/){
      mprint("Other\n", \*MADR, \*LOG);
    }
    mprint("$mdef{POLARIZATION}\n", \*MADR, \*LOG);   # Stokes parameter
    mprint("$mdef{BANDWIDTH}\n", \*MADR, \*LOG);    # Bandwidth (MHz) [7.500]:
    mprint("$mdef{OBSEPOCH}\n", \*MADR, \*LOG);	    # Obs. epoch (e.g. 1984.6)
  }
  else{
    mprint("N\n", \*MADR, \*LOG);     # Define aux. ast. parameters?[Y]:
  }
  mprint("Y\n", \*MADR, \*LOG);		     # Are the entered ast. parameters
  mprint("\n", \*MADR, \*LOG);		     # Do you want a comment? [N]:
  mprint("\n", \*MADR, \*LOG);               # Just in case there is a comment.
  mprint("\n", \*MADR, \*LOG);               # Usually these are unnecessary
  mprint("\n", \*MADR, \*LOG);               # but harmless.
  mprint("exit\n", \*MADR, \*LOG);

  close(LOG) or warn "writedef: error closing log";
  #local $errco = 0;
  my $errco = 0;
  eval { close(MADR) or die "writedef: error writing definition to $ind"; };
  if($@){
    $errco = 1;
  }

  # Clean up those logs.
  eval {
    open(WDL, ">${ind}.wd.rmable") or die "Could not >${ind}.wd.rmable";
    open(MADROUT, "${ind}.madrdef.log")
      or die "Could not open${ind}.madrdef.log";
    open(LOG, "${ind}.writedef.log")
      or die "Could not open ${ind}.writedef.log";
  };
  if($@){
    warn "Could not merge ${ind}.madrdef.log and ${ind}.writedef.log into wd${ind}.rmable";
    return $errco;
  }

  my $dummy = <MADROUT>;                  # Skip "FORTRAN STOP" line.
#  $dummy = <MADROUT>;
#  print STDERR $dummy;
#  print WDL $dummy;                    # DRAO Export version
#  print WDL <MADROUT>;    # Does not work for some reason.
#  $dummy = <MADROUT>;
#  print STDERR $dummy;
#  print WDL $dummy;                    # madr version
#  print WDL <MADROUT>;    # Does not work for some reason.
  while(my $mline = <MADROUT>){
#    print STDERR "DEBUG:\n";
#    print STDERR $mline;
    chomp $mline;
#    print STDERR $mline;
#    print STDERR ":DEBUG\n";
    if($mline =~ / \?> /){
      my @molines = split / \?> /, $mline;
      pop @molines;                        # split makes n + 1; want n.
      foreach $_ (@molines){
	$dummy = <LOG>;
	print WDL "${_}?> $dummy";        # Split MADROUT line on ?>
      }
    }
    elsif($mline =~ /:/){
      $mline =~ s/(\bsize|\bare):/${1}X/g; # and most colons,
      my @molines = split /:/, $mline;
      pop @molines;
      foreach $_ (@molines){
	s/(\bsize|\bare)X/$1:/g;
        $dummy = <LOG>;
	print WDL "${_}: $dummy";          # and insert <LOG>
      }
    }
    else{
      print WDL "$mline\n";
    }
  }
  while(<LOG>){        # Finish off with any remaining <LOG>.
    print WDL $_;
  }
  close(MADROUT) or warn "Error closing ${ind}.madrdef.log";
  close(LOG) or warn "Error closing ${ind}.writedef.log";
  eval {
    close(WDL) or die "Error closing >${ind}.wd.rmable";
    unlink("${ind}.madrdef.log") or warn "Error unlinking ${ind}.madrdef.log";
  };
  if($@){
    warn "Did not unlink ${ind}.madrdef.log";
  }

  # Check that log for obvious errors.
  open(WDL, "<${ind}.wd.rmable") or die "Could not <${ind}.wd.rmable";
  my %dupcheck;
  while(<WDL>){
    if(/^\s*([^:]{3,}):/){
      my $defline = $1;
      if($dupcheck{$defline}){
	die "Repeated question \"$defline\" found in ${ind}.wd.rmable";
      }
      else{
	$dupcheck{$defline} = 1;
      }
    }
  }
  close(WDL);

  return $errco;
}

=item B<madrrget($rdir, $madr_index_in_rdir[, $docopy])>

Use madr to rget a file from another directory.  Returns success of opening and
closing madr, optionally multiplied by the success of the verification.

=cut
sub madrrget {
  my $rdir = $_[0];
  my $rind = $_[1];
  my $docopy = "y";      # Default to copying file as well as definition.

  if(!defined($rind)){
    warn "rind not defined in madrrget($rdir)";
    return 1;
  }

  if(defined($_[2]) && $_[2] =~ /^[n0]/i){
    $docopy = "n";
  }

  # Another reason why I do not like bash.  The 2>&1 has to come after the |
  # grep to be applied before the | grep.  Put it *before* the | grep and it is
  # applied *after*!
#  open(MADR, "|madr 2>&1 | grep Definition");
  if(open(MADR,
     "|madr 2>/dev/null | grep Definition | sed s/.*Definition/Definition/")){
#  open(MADR, "|madr > /dev/null");
    print MADR "rdir\n";
    print MADR "$rdir\n";
    print MADR "rget f$rind\n";
    print MADR "$docopy\n";
    print MADR "exit\n";
    close(MADR) or warn "Error closing madr in madrrget";
  }
  else{
    warn "Could not |madr 2>/dev/null | grep Definition | sed s/.*Definition/Definition/";
  }
  return $?;
}

=item B<superrename($op, \@flist)>

Basically Larry Wall's rename (script, not the function) as a function.
Renames the filenames in \@flist according to $op, which is usually a s/x/y/ type pattern.

=cut
sub superrename{
  my ($op, $flr) = @_;

  for (@$flr) {
      my $was = $_;
      eval $op;
      warn $@ if $@;
      rename($was, $_) unless $was eq $_;
  }
}

=item B<symlinkmf($src, $dest)>

symlink does not support the -f option of ln.  This function assumes it.
Returns 1 on success, 0 on failure.

=cut
sub symlinkmf {
  my ($src, $dest) = @_;

  unlink($dest); # Ignore the result!
  unless(symlink($src, $dest)){
    print "Could not symlinkmf $src $dest!  Returning 0.\n";
    return 0;
  };
  return 1;
}

=item B<lnrget($rd, $madr_ind_in_rd, $pathless_filnam, [$newnam], [$doundef])>

Like madrrget, but links to the file in the remote directory rd instead of
copying it, AND uses the name of the file as well as its index.  Known to work
for clean.  Optionally renames the link to $newnam and specifies whether or not
undefined data is allowed.

Now returns the resulting local madr index on success, and 0 on failure.  This
should be compatible with existing calls.

=cut
sub lnrget {
  my ($remodir, $remoind, $filnam, $newname, $doundef) = @_;

  $newname ||= $filnam;
  $doundef ||= "";

  madrrget($remodir, $remoind, "n");  # link in madr to copy the definition.
  # Bah!  madr doesn't seem to return anything meaningful on success or failure.
#   if (!$?) {                    # if(@!#$%!!!&^*$#!){   ;-)
#     print "rget f$remoind in $remodir failed in lnrget()\n";
#     return $?;
#   };

  # ln -s the file(s).
  if($filnam =~ /@/){  # It's a cube.
    my $fpat = $filnam;
    my $oldnamestart = $fpat;
    my $oldnameend   = $fpat;
    my $newnamestart = $newname;
    my $newnameend   = $newname;

    $oldnamestart =~ s/@.*//;
    $oldnameend   =~ s/.*@//;
    $newnamestart =~ s/@.*//;
    $newnameend   =~ s/.*@//;

    $fpat =~ s/@/?/g;
    my @rfilns = <$remodir/$fpat>;

    foreach my $rfiln (@rfilns){
      my $num = $rfiln;
      $num =~ s/.*$oldnamestart//;
      $num =~ s/$oldnameend//;

      unless(symlinkmf($rfiln, "$newnamestart$num$newnameend")){
	return 0;
      };
    }
  }
  else{
    unless(symlinkmf("$remodir/$filnam", "$newname")){
      return 0;
    };
  };

  # in madr, def the file to give it the local filename and keep
  # everything else the same.
  my $localind = fileindex($filnam);
  if($localind == 0){                                    # Failure value.
    warn "lnrget() did not find $filnam in deffil.mad!";
    return 0;                                            # Failure value.
  }

#  print "$newname = $localind\n";
  open(MADR, "|madr > /dev/null 2>/dev/null");
  print MADR "def f${localind}\n";
  print MADR "${newname}\n";	# File name
  print MADR "\n";		# Data type (IRD) [R]:
  print MADR "\n";		# Dimensions:
  print MADR "\n";		# Subset [NONE]:

  # This seems to usually be Y for visbilities and N for images.
  print MADR "$doundef\n";	# Are "undefined" data allowed? [N]:
  if ($doundef =~ /y/i) {        # then we have an extra question.
    print MADR "\n";            # Take the default.
  }

  print MADR "\n";		# 0 = undefined/dimensionless     4
  print MADR "\n";		# Scaling factor [10.000 E-4]:
  print MADR "\n";		# Are the parameters that you entere
  print MADR "\n";		# Define coordinates (astronomical p
  print MADR "\n";		# Type of file (RD,RV,VD,UV,XY) [RD]
  print MADR "\n";		# Sky projection (SEGTVACF) [S]:
  print MADR "\n";		# Epoch for projection (1950 or 2000
  print MADR "\n";		# Select velocity-like coordinate (V
  print MADR "\n";		# RA of reference element [19H 59M 2
  print MADR "\n";		# DEC of reference record [40D 44' 2
  print MADR "\n";	        # Reference ELEMENT for RA [129.000]
  print MADR "\n";	        # Reference RECORD for DEC [129.000]
  print MADR "\n";		# DELTA "RA" per element (unsigned)
  print MADR "\n";		# DELTA "DEC" per record (unsigned)
  print MADR "\n";		# Define file (3rd dimension) coordi
  print MADR "\n";		# Define resolution (beam and veloci
  print MADR "\n";		# Define auxiliary astronomical para
  print MADR "\n";		# Central heliocentric frequency (MH
  print MADR "\n";		# LR, RL, LL, RR, I, Q, U, V, None,
  print MADR "\n";		# Data-set bandwidth (MHz) [7.500]:
  print MADR "\n";		# Observation epoch (e.g. 1984.6) [1
  print MADR "\n";		# Are the entered astrophysical para
  print MADR "\n";		# Do you want a comment? [N]:
  print MADR "\n";
  print MADR "\n";
  print MADR "\n";
  print MADR "\n";
  print MADR "\n";              # Cheat and handle visibility files
  print MADR "\n";              # by giving a few more \n's.
  print MADR "\n";
  print MADR "\n";
  print MADR "\n";
  print MADR "exit\n";
  close(MADR);

#  return $?; # Return success of opening and closing madr.
  return $localind;
}

=item B<madrrename($oldname, $newname)>

Rename $oldname to $newname in the current directory both on the filesystem and
in madr.

=cut
sub madrrename{
  my ($oldname, $newname) = @_;

  my $mnum = fileindex($oldname);

  unless(defined($mnum) && $mnum > 0){
    die "|mnum| = |$mnum|, |oldname| = |$oldname|, |newname| = |$newname|";
  }

  rename($oldname, $newname) or die "Could not rename $oldname to $newname";

  # to_stokes writes the observation epoch as 0.0, which madr does not accept.
  # Subsequent files do have the correct observation epoch, though.
  my %mdef = readdef($mnum);
  if($mdef{OBSEPOCH} < 0.01){
    my @findices = fileindex(survey());

    my $altnum = $findices[0];

    unless($altnum != $mnum){
      $altnum = $findices[1];
    }
    unless(defined($altnum) && $altnum > 0){
      @findices = fileindex("V21");
      $altnum = $findices[1];
    }

    my %altdef = readdef($altnum);
    $mdef{OBSEPOCH} = $altdef{OBSEPOCH};
    $mdef{FILENAME} = $newname;
    writedef($mnum, $mnum, %mdef);
  }
  else {                                   # Phew, we can do it the fast way.
    open(MADR, "|madr > /dev/null 2>&1");
    print MADR "def f${mnum}\n";
    print MADR "${newname}\n";	# File name
    for (my $i = 0; $i < 60; ++$i) {
      print MADR "\n";		# Cheat by giving lots of \n's.
    }
    print MADR "exit\n";
    close(MADR);
  }
}

=item B<latestfile($ls_pattern)>

Return the name of the most recently modified file matching the given pattern.

=cut
sub latestfile {
  return unless defined wantarray;               # Do nothing in void context.
#  my @filenames = split('\n', `ls -1rt $_[0]`);
  my $fpat = $_[0];
  my $lfn = `ls -1t $fpat 2> /dev/null | head -1`;
  chomp $lfn;
  return $lfn;
#   my $numfiles = 0;
#   open(LSOUT, "ls -1rt $fpat |");
#   while(<LSOUT>){
#     chomp $_;
#     $numfiles = push(@filenames, $_);
#   }
#   close(LSOUT);
#   if($? || !$numfiles){
#     print "The files are:\n";
#     print join("\n", @filenames), "\n";
#     print "That\'s all the files being considered!\n";
#     die "latestfile: pattern $fpat, $numfiles files found.\n";
#   }

#   return $filenames[-1];
}

=item B<latestimageindex()>

madr index of most recently produced image.

=cut
sub latestimageindex {
  return unless defined wantarray;               # Do nothing in void context.

  my @images = latestfile("*.M*[27][14]");
  print "latest image: $images[-1]\n";

  my @findex = fileindex($images[-1]);
  return $findex[-1];
}

=item B<remove_file($filename)>

Delete a file from both the directory and madr.

=cut
sub remove_file {
  my $fn = $_[0];
  if (-f $fn) {
    my $id = fileindex($fn);

    open(MADR, "|madr >> deletions.madrout 2>&1");
    print MADR "neg f$id\n";
    print MADR "y\n";
    print MADR "y\n";
    print MADR "exit\n";
    close(MADR);
  }
}

=item B<get_first_slot()>

Returns lowest available madr index.
From Dave Del Rizzo, logfile behavior modified by RR.
5/16/2004: RR made regex more specific.

=cut
sub get_first_slot {
  return unless defined wantarray;               # Do nothing in void context.

  # Get madr to locate the empty slot info
  open (MADR, "|madr > slotnum.madrout 2>/dev/null");
  print MADR "na\n";
  print MADR ".\n";
  print MADR "\n";
  close(MADR);

  # Now read slotnum.madrout to get the open slot number
  open(MADROUT, "slotnum.madrout") or die "Could not open slotnum.madrout\n";
  my $first_slot;
  while (<MADROUT>) {
    if(/empty slots,\s+(\d+)\s+is first one/) {
      $first_slot = $1;
      last;                  # Do not read the rest.
    }
  }
  close(MADROUT);
  return $first_slot;
}

=item B<get_phase_center($stokes, $band)>

Returns the R.A. and declination (as strings) of the phase tracking center of
the latest visibility file for $stokes and $band.

=cut
sub get_phase_center {
  return unless defined wantarray;               # Do nothing in void context.

  my @visfiles = visfilenames(@_);
  my @visinds = fileindex($visfiles[-1]); # 0 often bad.

  unless(-r "phasecenter.madrout"){
    open(MADR, "|madr > phasecenter.madrout 2>&1");
    print MADR "sho f$visinds[-1]\n";
    print MADR "exit\n";
    close(MADR);
  }

  # Search madr.output for RA
  open(MADROUT, "phasecenter.madrout") or
    die "Could not read phasecenter.madrout\n";

  while (<MADROUT>) {
    if(/Phase centre:\s+x:([^y]+)y:(.*)/) {
      # $rahms = $1; $decdms = $2;
      return wantarray ? ($1, $2) : "$1, $2";
    }
  }
  close(MADROUT);
}

=item B<freq_out($imagefilename)>

Returns the frequency of the given image.

=cut
sub freq_out {
  return unless defined wantarray;               # Do nothing in void context.
  my $filind = fileindex(@_);

  open(MADR, "|madr > freq.madrout 2>&1");
  print MADR "sho f$filind\n";
  print MADR "exit\n";
  close(MADR);

  # Search madr.output for RA
  open(MADROUT, "freq.madrout") or die "Could not read freq.madrout\n";

  my $freq = -1.0;    # This seems unlikely enough.
  while (<MADROUT>) {
    if(/Central Hel\. Freq\.:\s+([0-9]+\.?[0-9]*)/) {
      $freq = $1;
    }
  }
  close(MADROUT);

  if($freq < 0.0){
    die "${freq}: frequency not found in f${filind}.";
  }
  return $freq;
}

# Dave Del Rizzo's check on ph2's success
# while (<OUT_PH2>) {
#     if (/FATAL/) {
#        die "error in ph2/n";}
#     elsif (/starting to make map/) {
#        $mapname = $';
#        chomp $mapname;
#        print "Finished ph2, map output is $mapname\n";

#         }
# }

# Dave Del Rizzo's subdirectory maker
# print "Will now move/copy continuum files to a lower directory\n";
# $contdir = $low_srv_code."cont";
# if (!(-e $contdir)) {   #make the directory
#    mkdir($contdir, 0777) || die "unable to mkdir $contdir: $!";
# }

# foreach $file (<*.C21 *.V21* *.M*21 *.P*21*>) {
#     system "mv $file $contdir";}
# print "moved files to $contdir\n";

# print "copying *.TBL *.O21 *.E21 *.mad *.HISTORY";
# foreach $file(<*.TBL *.O21 *.E21 *.mad *.HISTORY>) {
#     system "cp $file $contdir";
# }
# print "copied files\n";
# #check they actually arrived

# /rigel2/delrizzo/lang/perl/runstile looks interesting.
# as does /rigel2/delrizzo/bin/var

# Wishlist:
# - NVSS Q/U/(leaked)I catalog to ptsrcs list converter, cutting on brightness
# in primary beam and possibly position of synthesized beam ring.  Needs:
# - separation calculator (use C(++) program?)
# - field code <-> position converter.

# Probably only useful to me: findsrc on I or use CGPS catalog instead of NVSS.

=item B<get_stokesandbandfromdir()>

Guesses the Stokes parameter and band from the path of the current directory.
It assumes your path is something like

  field/Stokes/band/

i.e.

  y5/q/a

Case does not matter, but both stokes and more importantly band must be single
letters.

=cut
sub get_stokesandbandfromdir {
  return unless defined wantarray;               # Do nothing in void context.
  my @dirs = split('/', $ENV{PWD});

  if($dirs[-2] !~ /[iquv]/i || $dirs[-1] !~ /[abcd]/i){
    $dirs[-2] = "I";
    $dirs[-1] = "ABCD";
    warn "Stokes and band not found in path!  Defaulting to I, ABCD!";
  }

  return wantarray ? ($dirs[-2], $dirs[-1]) : "$dirs[-2], $dirs[-1]";
}

=item B<convreals($ind)>

Flip the endianness of the floats in the file referred to by madr index $ind.

=cut
sub convreals {
  my $ind = $_[0];

  open(CR, "|convreals 2>/dev/null >/dev/null") or
    warn "Error opening |convreals 2>/dev/null >/dev/null";
  print CR "\n";       # Do you wish to run in batch mode? [N]:
  print CR "\n";       # Do you want to create a log? [Y]:
  print CR "\n";       # Is log file to be printed on exit? [N]:
  print CR "\n";       # Is file definition not wanted? [N]:
  print CR "n\n";      # Is data to be conv btw IEEE and VAX formats [Y]?
  print CR "y\n";       # Is byte-flipping to be done [N]?
  print CR "$ind\n";   # File definition number [DEFINE FILE]:
  close(CR) or warn "Error closing |convreals 2>/dev/null >/dev/null";
}

=item B<cookiecutter($size, $destfile)>

Cuts the latest image down to a central square $size pixels on a side, and
renames it to $destfile.

=cut
sub cookiecutter {
  my ($size, $destfile) = @_;
  my $cenpix = $size / 2 + 1;
  my $indnum = DRAORed::latestimageindex();
  my $destnum = DRAORed::get_first_slot();

  open(MADR, "|madr > /dev/null 2>&1") or
    die "Could not |madr > /dev/null 2>&1";
  print MADR "sub $indnum \(cen $size\)\n";
  close(MADR) or
    die "Error closing |madr > /dev/null 2>&1 for sub";

  my %destdefn = readdef($indnum);

  $destdefn{FILENAME}   = $destfile;
  $destdefn{DIMENSIONS} = $size;
  $destdefn{REFPX}      = $cenpix;
  $destdefn{REFPY}      = $cenpix;
  unless(writedef($indnum, $destnum, %destdefn)){         # Write the def'n,
    unlink("${destnum}.writedef.log")                     # and clean up if
      or warn "Could not unlink ${destnum}.writedef.log"; # all went well.
    unlink("${destnum}.wd.rmable")
      or warn "Could not unlink ${destnum}.wd.rmable";
  }

  open(MADR, "|madr > /dev/null 2>&1")
    or die "Could not |madr > /dev/null 2>&1";
  print MADR "m\n";		# Start manip
  print MADR "f${destnum} = f${indnum}\n"; # Actually copy the file.
  print MADR "exit\n";		# Exit manip
  print MADR "neg f${indnum}\n";
  print MADR "y\n";             # Yes, delete the file please.
  print MADR "y\n";             # Yes delete the file!
  print MADR "exit\n";
  close(MADR) or
    die "Error closing |madr > /dev/null 2>&1 for m and neg";
  return $destnum;
}

=item B<cookiemonster($size, $file)>

Like cookiecutter(), but cuts $file down to $size in place (using a
temporary copy).

Technically this function should somehow lock madr to ensure it has exclusive
access until it is done.  Of course, flock does not work on processes, and what
I really want is to prevent any other (madr) processes from altering $indnum or
$destnum.

=cut
sub cookiemonster {
  my ($size, $file) = @_;
  my $cenpix = $size / 2 + 1;
  my $indnum = DRAORed::fileindex($file);

  open(MADR, "|madr > /dev/null 2>&1") or
    die "Could not |madr > /dev/null 2>&1";

  print MADR "sub $indnum \(";
  if($file =~ m/^CC/){
    my $le = $size + $cenpix - 1;
    print "le: $le\n";
    my $lr = $le + 1;
    print "lr: $lr\n";
    print MADR "fe $cenpix le $le fr $cenpix lr $lr\)\n";
    my $sizep1 = $size + 1;  # It has to be done this way or
    $size .= ", " . $sizep1; # perl gets confused.
    print "size: $size\n";
  }
  else{
    print MADR "cen $size\)\n";
  }
  close(MADR) or
    die "Error closing |madr > /dev/null 2>&1 for sub";

  my %destdefn = altreaddef($indnum);
  $destdefn{FILENAME}   = "COOKIEMONSTER.YUMYUMYUM";
  $destdefn{DIMENSIONS} = $size;
  $destdefn{REFPX}      = $cenpix;
  $destdefn{REFPY}      = $cenpix;
  my $destnum = DRAORed::get_first_slot();
  writedef($indnum, $destnum, %destdefn);

  open(MADR, "|madr > /dev/null 2>&1") or
    die "Could not |madr > /dev/null 2>&1";
  print MADR "m\n";		# Start manip
  print MADR "f${destnum} = f${indnum}\n"; # Actually copy the file.
  print MADR "exit\n";		# Exit manip
  print MADR "neg f${indnum}\n";
  print MADR "y\n";             # Yes, delete the file please.
  print MADR "y\n";             # Yes delete the file!
  print MADR "exit\n";
  close(MADR) or
    die "Error closing |madr > /dev/null 2>&1 for m and neg";

  my $mvresult = system("mv COOKIEMONSTER.YUMYUMYUM $file");
  if($mvresult != 0){
    warn "Could not mv COOKIEMONSTER.YUMYUMYUM $file, not negging $destnum";
  }

  $destdefn{FILENAME} = $file;
  if(writedef($destnum, $indnum, %destdefn)){
    warn "Could not writedef $destnum to $indnum, so not negging $destnum";
  }
  elsif($mvresult == 0){
    open(MADR, "|madr > /dev/null 2>&1") or
      warn "Could not |madr > /dev/null 2>&1 for negging $destnum";
    print MADR "neg f${destnum}\n";
    print MADR "exit\n";
    close(MADR) or
      die "Error closing |madr > /dev/null 2>&1 for negging $destnum";
  }
}

=item B<makeimage>

Makes an image.

Default arguments:
  STOKES  => "I",
  BAND    => "ABCD",
  XSIZE   => 1024,
  YSIZE   => 1024,
  MINSPAC => 3,
  MAXSPAC => 144,
  PIXXS   => 0.3333333,
  PIXYS   => 0.3333333

  Override any of the above with makeimage(BAND => "BC", YSIZE => 512), etc..

Returns the names of the logfile produced by ph2, and the resulting image.

=cut
sub makeimage {
  my %args = (STOKES  => "I",
	      BAND    => "ABCD",
	      XSIZE   => 1024,
	      YSIZE   => 1024,
	      MINSPAC => 3,
	      MAXSPAC => 144,
	      PIXXS   => 0.3333333,
	      PIXYS   => 0.3333333,
	      #	      DOBEAM, SHIFTPOS, SURVEY, VISCODE
	      @_,);		# Actual arguments; overrides defaults.
  my $visnr;

  if (!$args{SURVEY}) {
    $args{SURVEY} = &survey();
  }
  #print "Survey says: $sur\n";

  if (!$args{VISCODE}) {
    ($args{VISCODE}, $visnr) = latestviscode($args{STOKES}, $args{BAND});
  }

  #print "Making a 256 x 256 \u$args{STOKES} image of Cass-A in band\n";
  #print "\U$args{BAND}\E using visibilities $vis.\n";

  open(PH2, "|~/bin/lph2 > /dev/null 2>&1");
  print PH2 "\n";		# Batch mode?
  print PH2 "\n";		# Log file?
  print PH2 "n\n";		# print it out?
  print PH2 "\n";		# Batch?
  print PH2 "$args{SURVEY}\n";	# Survey
  print PH2 "21\n";		# Wavelength
  print PH2 "$args{VISCODE}\n";	# UV plane
  print PH2 "n\n";		# Line maps?
  print PH2 "y\n";		# Select by Stokes?
  print PH2 "$args{STOKES}\n";	# Stokes type?
  print PH2 "n\n";		# From RR and LL
  print PH2 "$args{BAND}\n";	# Bands to be included
  print PH2 "n\n";		# Flag files for no-data
  if($args{DAYNUM}){
    print PH2 "n\n";		# Use all days
    print PH2 "$args{DAYNUM}\n";
  }
  else{
    print PH2 "y\n";		# Use all days
  }
  print PH2 "n\n";		# Add zero spacing
  print PH2 "\n";		# Antennas to select (DEF=all)
  print PH2 "n\n";		# Use existing spec
  print PH2 "n\n";		# OK?
  print PH2 "1\n";
  print PH2 "$args{MINSPAC}\n";
  print PH2 "2\n";
  print PH2 "$args{MAXSPAC}\n";
  print PH2 "5\n";
  print PH2 "$args{PIXXS}\n";
  print PH2 "6\n";
  print PH2 "$args{PIXYS}\n";
  print PH2 "20\n";		# Grid function
  print PH2 "2\n";		# Kaiser-Bessel*Gaussian
  print PH2 "4\n";		# Taper
  print PH2 "144\n";
  print PH2 "17\n";
  print PH2 "$args{XSIZE}\n";
  print PH2 "18\n";
  print PH2 "$args{YSIZE}\n";
  if($args{SHIFTPOS}){
    my ($hmsstr, $dmsstr) = split(',', $args{SHIFTPOS});
    print PH2 "7\n";		# SHIFT to
    print PH2 "9\n";
    print PH2 "$hmsstr\n";      # new center R.A.
    print PH2 "10\n";
    print PH2 "$dmsstr\n";      # new center Dec.
  }
#   else{
#     my ($hmsstr, $dmsstr) = split(',', $args{SHIFTPOS});
#     print "$hmsstr\n";      # new center R.A.
#     print "$dmsstr\n";      # new center R.A.
#     die "You did not give a shift position.";
#   }
  print PH2 "0\n";		# Quit out of selections
  print PH2 "y\n";		# OK?
  unless($args{DOBEAM}){         # Beam? (Polar diagram)
    print PH2 "n";
  }
  print PH2 "\n";
  close(PH2);

  return (latestfile("ph2*.LOG"),
	  latestfile("\U$args{SURVEY}\E" . '[A-Z][A-Z]' .
   "\U$args{STOKES}?$args{BAND}$args{VISCODE}\.M$args{STOKES}\E21"));
}

=item B<mclatim($survey, $visibs, $map, $band, $minspacing, $maxspacing)>

Remove latest image from latest visibilities in a directory.
ptsrcs script from xxx_modcal by Bulent Uyaniker, improved automation by Rob
Reid.

Returns the names of the logfile produced by ptsrcs, and the resulting
visibility file.

=cut
sub mclatim {
  my ($survey, $visibs, $map, $band, $minspacing, $maxspacing) = @_;

  # R.A. and declination of phase tracking center in degrees.
  my ($raf, $decf) = dec2hms(DRAORed::get_phase_center($map, $band));

  # modcal does not converge if it runs on the phase tracking center, so
  # offset it by 5 degrees.
  $decf -= 5.0;

  # dec2hms() magically goes both ways!
  my ($rastr, $decstr) = dec2hms($raf, $decf);

  my $liind = latestimageindex();

  open(PRG, "|ptsrcs > /dev/null 2>&1");
  print PRG "N\n";  		#! Do you wish to run in batch mo
  print PRG "Y\n";  		#! Do you want to create a log? [
  print PRG "n\n";  		#! Is log file to be printed on e
  print PRG "N\n";  		#! Do you want to run in debug mo
  print PRG "21\n";  		#! Wavelength for analysis (21 or
  print PRG "N\n";  		#! OK? [Y]:
  print PRG "2\n";  		#! Item number [0]:
  print PRG "\n";  		#! Item number [0]:
  print PRG "Y\n";  		#! OK? [Y]:
  print PRG "N\n";  		#! OK? [Y]:
  print PRG "6\n";  		#! Item number [0]:
  print PRG "$minspacing\n";  	#! Minimum spacing
  print PRG "7\n";  		#! Item number [0]:
  print PRG "$maxspacing\n";  	#! Maximum spacing
  print PRG "12\n";  		#! Item number [0]:
  print PRG "13\n";  		#! Item number [0]:
  print PRG "\n";  		#! Item number [0]:
  print PRG "Y\n";  		#! OK? [Y]:
  print PRG "$rastr\n";		#! J2000 RA :
  print PRG "$decstr\n";	#! J2000 DEC:
  print PRG "3\n";  		#! Select option [1]:
  print PRG "\n";		#!  model visibilities? [Y]:
  print PRG "N\n";  		#! for different sizes of antenn
  print PRG "1\n";  		#! Scaling factor for valid model
  print PRG "$survey\n";	#! Survey name (2 characters) [00
  print PRG "$visibs\n";	#! UV plane code (2 characters) [
  print PRG "Y\n";  		#! Do you want to calibrate data STOKES
  print PRG "$map\n";  		#! Type of data to select (I,Q,U,
  print PRG "Y\n";  		#! Process continuum uv plane(s)?
  print PRG "$band\n";		#! Bands to be used in these data
  print PRG "\n";  		#! COMMENTS ON THIS UV GENERATION
  print PRG "N\n";  		#! nine-point subsample interval
  print PRG "$liind\n";		#! File definition number [DEFI
  print PRG "\n"; 	        #! Minimum abs. flux
  close(PRG);
  die "ptsrcs failed" if $?;

  # See visfilenames() for reasoning of this hack.
  $band = substr($band, 0, 1);

  my $ofile = latestfile("ptsrcs*.LOG");
  unless(system("gzip $ofile")){
    $ofile .= ".gz";
  }

  return ($ofile, latestfile("\U$survey${map}?${band}\E.V21*"));
}

=item B<getextrema($madr_index)>

Returns the maximum and minimum (in that order) of the given map index.

=cut
sub getextrema {
  return unless defined wantarray;               # Do nothing in void context.
  my $ind = $_[0];
  my $max;
  my $min;

  open(MADR, "|madr > extrema.output 2>&1");
  print MADR "extrema $ind\n";
  close(MADR);

  open(MADROUT, "extrema.output") or die "Could not open extrema.output\n";
  while (<MADROUT>) {
    if (/Maximum   =  (.{8})/) {
      $max = $1;
    }
    elsif (/Minimum   =  (.{8})/) {
      $min = $1;
    }
  }
  close(MADROUT);
  return wantarray ? ($max, $min) : "$max, $min";
}

=item B<leapyear($year)>

Returns 1 if $_[0] (an integer) is a leapyear, 0 otherwise.

=cut
sub leapyear {
  my $y = int($_[0]);

  if ( $y % 4 ) {
    return 0;
  }
  $y /= 4;                 # divisible by 4 to get here.

  if ( $y % 100 ) {        # If memory serves, 2000 was a leap year.
    return 1;
  }
  elsif ( $y % 25 ) {      # But normally century turns are not.
    return 0;
  }
  return 1;                # Noncentury turn leap year to get here.
}

=item B<decy2ymd($decimalyear)>

Convert a decimal year, i.e. 1999.54, to YYYYMMDD

=cut
sub decy2ymd {
  return unless defined wantarray;               # Do nothing in void context.
  my $decy = $_[0];
  my $y = int($decy);
  my $diy = 365.0 + leapyear($y);
  my $soy = ($decy - $y) * 86400 * $diy;
  my $time = timegm(0, 0, 0, 1, 0, $y - 1900) + $soy;
  my ($m, $d) = (gmtime($time))[4, 3];
  return $y * 10000 + ($m + 1) * 100 + $d; # 100 acts like 2 spaces.
}

=item B<getbeam($madr_index)>

Returns (in arcminutes) the major and minor axes, and the position angle (in
degrees), in that order, of the spatial resolution of $madr_index.

=cut
sub getbeam {
  return unless defined wantarray;               # Do nothing in void context.
  my $beamind = $_[0];

  # Get $beamfile's beam.
  open(MADR, "|madr > beam.madrout 2>&1");
  print MADR "s f$beamind\n";
  print MADR "exit\n";
  close(MADR);

  my $bmajas = -999; # Insanity check.
  my $bmajam;
  my $bminam;
  my $bminas;
  my $pa;
  open(MADROUT, "beam.madrout") || die "Could not open beam.madrout\n";
  while (<MADROUT>) {
    #    Spatial res.:       1' 32.71"      x 0' 57.64"   at -86.613D
    if (/   Spatial res\.:\s*(\d+)\' ([0-9.]+)\"\s*x\s*(\d+)\' ([0-9.]+)\"\s+at ([-+0-9.]+)D/) {
      $bmajam = $1;
      $bmajas = $2;
      $bminam = $3;
      $bminas = $4;
      $pa     = $5;
    }
  }
  close(MADROUT);

  if($bmajas < -180.0){
    die "Beam (spatial resolution) not found in beam.madrout by getbeam(madr index $beamind)\n";
  }

  # Convert it to arcminutes
  $bmajam += $bmajas / 60.0;
  $bminam += $bminas / 60.0;

  return wantarray ? ($bmajam, $bminam, $pa): "$bmajam, $bminam, $pa";
}

=item B<hreffn($fh, $fn)>

Make a hyperlink in the filehandle $fh to the file $fn, using the filename $fn
as the link label.

=cut
sub hreffn{
  my $fh = shift;
  my $fn = shift;

  print $fh "<a href=\"$fn\">$fn</a>";
}

=item B<addmisclogtologs($instring, $fh)>

Add an entry for the first argument ("filesize filename.LOG") to the second
argument (a logs/index.html filehandle).  Returns 1 if it gzipped the log, 0
otherwise.

=cut
sub addmisclogtologs {
  my $instring = shift;
  my $fh       = shift;

  $instring =~ /(\s*[\w.]+) (\w+\.LOG)/;
  my $filesize = $1;
  my $logname  = $2;

  # Get the (at least partial) name of the program that was run.
  my $taskname = $logname;
  #
  # Programs that end with a digit need special care because of the date format
  # used in the .LOG filenames.  Note that the day of the month can be *either*
  # 1 or 2 digits!
  for($taskname){        # Really a C-ish switch.
    /^ph2/        && do { $taskname = "ph2";      last; };  # Most common
    /^ph1/        && do { $taskname = "ph1";      last; };
    /^bph2/       && do { $taskname = "bph2";     last; };
    /^listgps2/   && do { $taskname = "listgps2"; last; };
    /^listgps3/   && do { $taskname = "listgps3"; last; };

    # Otherwise...
    $taskname =~ s/\d\d?[A-Z]{3}\d{8}\.LOG//;
  }

  # Look for $logname in <*${taskname}.rds>
  my $rdsmatch = "";
  my @rdses = <*${taskname}.rds>;
  $rdsmatch = `grep -Ha $logname *${taskname}.rds | strings` if(@rdses);
  chomp $rdsmatch;
  if ($rdsmatch) {
    $rdsmatch =~ s/:.*//;
    my $checkforlastness = `grep -a "Log file will be: " $rdsmatch`;
    $rdsmatch =~ s/\.rds//;
    print LOG "rds ";
    my @rdslls = split(/Log file will be: /, $checkforlastness);
    if($rdslls[-1] =~ /$logname/){           # Log corresponds to last
      hreffn(\*LOG, $rdsmatch);              # run of $rdsmatch.
      mvlogww($rdsmatch);
      unlink "${rdsmatch}.rds"               # Useless now.
	or print "Could not unlink ${rdsmatch}.rds.\n";
    }
    else{                 # $rdsmatch was also run later in $rdsmatch.rds.
      print LOG $rdsmatch;
    }
  }
  else {
    # HTMLize $taskname.
    $taskname =  sprintf("%-13s", $taskname);
    $taskname =~ s/ /%/;	# Escape the first ' '.
    $taskname =~ s/ /&nbsp;/g;
    $taskname =~ s/%/ &nbsp;/;	# Convert it back.
    print LOG "$taskname";
  }

  # If $filesize > 6 KB, gzip $logname.
  if($filesize =~ /[MGT]/){         # Ridiculously large.
    print "${logname}'s filesize is ${filesize}B - you should really check it out.\n";
  }
  elsif($filesize =~ /([0-9.]+)K/i){
    my $numfs = $1;
    if($numfs > 6.0){
      if (-f $logname) {
	unless(system("gzip $logname")){
	  $logname .= ".gz";
	  $filesize = `ls -sh $logname`;
	  chomp $filesize;
	  $filesize =~ s/ .*//;
	}
      }
      else{
	warn "$logname not found";
	return 1;
      }
    }
  }

  $filesize =~ s/ /&nbsp;/g;

  print LOG " (";
  hreffn(\*LOG, $logname);
  my $ll = 30 - length $logname;
  while($ll-- > 0){
    print LOG "&nbsp;";
  }
  print LOG " (${filesize}B))<br>\n";
  return 0;
}

=item B<parseconfusionremoval($rclfn)>

Returns an array of pairs with the relevant info from an old-style
(preHTMLization) confusionremoval.log.  Each pair has the filename of the
first PH2 .LOG, and the HTMLized body of the entry.

=cut
sub parseconfusionremoval {
  my $rclfn = shift;
  my @removedcss;
  my $body = "";

  if (-r $rclfn) {
    my $line = "";
    my $entrylogs = "";

    open(OLDRCL, "<$rclfn") or return (0, "");
    $line = <OLDRCL>;               # Skip initial "remove_confsrc\n"
    $line = <OLDRCL>;               # and "--------------\n".
    while($line = <OLDRCL>){
      if($line =~ /^remove_confsrc/){      # Finished an entry.
	$entrylogs = `ls -rt1 $entrylogs`; # Find the .LOG that will
	$entrylogs =~ s/[\n\s].*//g;       # appear first to @ola
	$entrylogs =~ s/\.gz//;            # in checklogd().
	push @removedcss, $entrylogs;
	$entrylogs = "";

	push @removedcss, $body;
	$body = "";

	next;
      }
      if($line =~ /^--------------/){
	next;
      }

      if($line =~ /\((\w+\.LOG)\)/){
	$entrylogs .= "${1}* ";
      }

      # HTMLize $line.
#      $line =~ s/^\s+//;                          # Remove leading whitespace
#      $line =~ s/^(Centered at)/&nbsp;&nbsp;&nbsp;&nbsp; $1/;
      $line =~ s/^\t//;                          # Remove leading whitespace
      $line =~ s/^\t/&nbsp;&nbsp;&nbsp;&nbsp;/;

      # Link directories.  Looks for / so must come first.
      $line =~ s,(\S+)/,<a href=\"../$1/logs/index.html\">$1/</a>,;

      # Link .LOG files.
      $line =~ s,(\w+\.LOG),<a href=\"$1\">$1</a>,;

      # Always gzip the ptsrcs*.LOG, leave ph2s alone.
      if($line =~ /(ptsrcs\w+\.LOG)/){
	my $logname = $1;
	unless(system("gzip $logname")){
	  $line =~ s/$logname/${logname}.gz/g;
	}
      }

      $line =~ s/$/<br>\n/;

      $body .= $line;
    }
    close(OLDRCL) or warn "Error closing $rclfn";

    # The last entry did not get triggered.
    $entrylogs = `ls -rt1 $entrylogs`; # Find the .LOG that will
    $entrylogs =~ s/[\n\s].*//g;       # appear first to @ola
    $entrylogs =~ s/\.gz//;            # in checklogd().
    push @removedcss, $entrylogs;
    push @removedcss, $body;
  }
  else{
    print "\"$rclfn\" not readable - returning empty array\n";
    print "  of confusion removals.\n";
  }

  push @removedcss, ("Done!", "Done!");

  return @removedcss;
}

=item B<add_remove_confsrc_entry($fh, $body)>

Reconstruct a remove_confsrc command line from $body, append it to the
filehandle $fh, and link it to a file containing $body.
Returns the number of .LOGs mentioned in $body.

=cut
sub add_remove_confsrc_entry{
  my $fh   = shift;
  my $body = shift;

  if($body eq "Done!"){
      return 0;
  }

  my $cl   = "remove_confsrc";

  $body =~ /Name of confusing source: ([^<]+)/; # Lines end with <br>.
  my $logname = $1;

  # Location, location, location.
  if($logname eq "Cas A"){
    $cl .= " --casa";
  }
  elsif($logname =~ "Cyg A"){
    $cl .= " --cyga";
  }
  else{
    $body =~ /Centered at ([0-9.hmsHMS"']+,\s+-?[0-9.dmsDMS'"]+)/;
    my $loc = $1;

    $cl .= " -l \"$loc\"";
  }

  if ($body =~ /, size (\d+)/) {
    my $size = $1;

    if ($size != 128) {
      $cl .= " -s $size";
    }
  }

  if ($body =~ /Large image of [^:]+:\s+[A-Z0-9.]+\s+\(<a href="(\w+\.LOG)"/) {
    my $lilog = $1;
    my $daysused = `zgrep \'Days Used:\' ${lilog}*`;
    chomp $daysused;
    unless($daysused){
      die "body: \'$body\'\n";
    }
    $daysused =~ s/.*Days Used:\s+//;
    $daysused =~ s/\s+$//;
    if ($daysused !~ /ALL/i) {
      $cl .= " -n $daysused";
    }
  }

  if ($body =~ /\(arcminutes\): ([0-9.]+), ([0-9.]+)/) {
    my $xsize = $1;
    my $ysize = $2;
    if ($xsize != $ysize) {
      if ($xsize !~ /^\s*0.333333/) { # The default.
	$cl .= " -x $xsize";
      }
      if ($ysize !~ /^\s*0.333333/) { # That should be enough decimal places.
	$cl .= " -y $ysize";
      }
    } elsif ($xsize !~ /^\s*0.333333/) {
      $cl .= " --xy $xsize";
    }
  }

  if ($body =~ /Minimum and maximum spacings used: (\d+), (\d+)/) {
    my $minspac = $1;
    my $maxspac = $2;
    if ($minspac > 3) {
      $cl .= " -i $minspac";
    }
    if ($maxspac < 144) {
      $cl .= " -a $maxspac";
    }
  }

  if($body =~ /\nDirty image/){  # ^ does not work for start of line
    $cl .= " -m";                # because $body is one long string with
  }                              # embedded newlines.

  $body =~ /\nSmall image of [^:]+: ([^.]+)\.M/;
  my $csn = $1;
  unless($csn eq "CASA" or $csn eq "CYGA"){
    $cl .= " $csn";
  }

  $logname =~ s/ //;
  $logname .= ".html";
  open(RCLOG, ">logs/$logname") or warn "Could not open logs/$logname";
  print RCLOG "<h2>$cl</h2>\n";
  print RCLOG $body;
  close(RCLOG) or warn "Could not close logs/$logname";

  print $fh "<a href=\"$logname\">$cl</a><br>\n";

  my @numlogs = split(/\.LOG/, $body);
  return $#numlogs / 2;                      # They are hyperlinked.
}

=item B<checklogd($scrpat)>

If necessary, create a logs/ directory and initialize its index.html.
Returns the number of times $scr(pat) has been run since logs/ was created.

=cut
sub checklogd{
  if(-d "logs"){
    my @prevlogs = <logs/$_[0]*>;
    return @prevlogs;             # Meant to be used as a scalar!
  }
  else{
    if (system("mkdir logs")) {
      die "Could not mkdir logs";
    }
    open(LOG, ">logs/index.html") or
      die "Could not initialize index.html";
    print LOG "<h1>Processing log for ";
    my $cwd = `pwd`;
#    print "Start of checklogd $_[0]: cwd = $cwd";
    chomp $cwd;
    my $sn = survey();
    if($sn ne "-1"){
      print LOG "$sn";

      # Reimplement get_stokesandbandfromdir() to avoid spurious message.
      my @dirs = split('/', $cwd);

      if($dirs[-1] eq 'ipc'){
	print LOG " instrumental polarization correction</h1>\n\n";
      }
      elsif($dirs[-1] =~ /[abcd]|abcd|comb/ && $dirs[-2] =~ /[quv]/){
	print LOG "/$dirs[-2]/$dirs[-1]</h1>\n\n";
      }
      elsif($dirs[-1] =~ /$sn/i) {
	print LOG "</h1>\n\n";
	print LOG "<h2>Operations in subdirectories</h2>\n";
	print LOG "<a href=\"../ipc/logs/index.html\">ipc/ &nbsp;&nbsp; ";
	print LOG "(Instrumental Polarization Correction)</a><P>\n\n";

	foreach my $p ("q", "u") {
	  foreach my $b ('a' .. 'd', 'abcd') {
    print LOG "<a href=\"../$p/$b/logs/index.html\">$p/$b</a> &nbsp;&nbsp;\n ";
          }
	  print LOG "<br>\n";
	}
	print LOG "<p>\n\n";

	print LOG "<h2>Operations in root directory for $sn</h2>\n";
      }
    }
    else{			# Use directory name
      my $cdn = $cwd;
      $cdn =~ s,^$ENV{HOME}/?,,;
      $cdn =~ s,^/cgps03/rreid/?,,;
      print LOG "$cdn</h1>\n\n";
    }

    # Tidy up preexisting logs, if any.
    my $oldlogs = `find . -maxdepth 1 -mtime +1 -name '*.LOG' -print`;
    chomp $oldlogs;
    if ($oldlogs ne "") {
      $oldlogs =~ s,\./,,g;        	# Trim off find's annoying ./'s.
      $oldlogs =~ s/\n/ /g;
      $oldlogs =~ s/\.LOG/.LOG*/g;	# Allow for .gz
      my @ola = split(/\n/, `ls -rtsh1 $oldlogs`);
      my @rcs = parseconfusionremoval("confusionremoval.log");
      while (@ola) {
	if($rcs[0] =~ /href/){
	  die "href found in rcs[0]: $rcs[0]\nrcs[1]: $rcs[1]\n";
	}
	while (@ola && ($ola[0] !~ $rcs[0])) {
	  print "adding $ola[0] as misc log\n";
	  if(addmisclogtologs(shift @ola, \*LOG)){
	    die "rcs[0]: $rcs[0]\nrcs[1]: $rcs[1]\n";
	  }
	}
	shift @rcs;	# Get rid of PH2 .LOG.

	my $numshift = add_remove_confsrc_entry(\*LOG,
						shift @rcs);
	print "numshift: $numshift\n";
	if ($numshift =~ /\.5/) {
	  die "numshift should not be fractional";
	}
	while (@ola && $numshift-- > 0) {
	  shift @ola;
	}
      }
      mvlogww($oldlogs);
    }

    close(LOG) or warn "Could not close index.html";
    return 0;
  }
}

=item B<mvlogww($clog)>

mv $clog logs/, and warn if mv complains.  Does not check if logs/ exists.

=cut
sub mvlogww{
  my $clog = $_[0];
  if (system("mv $clog logs")) {
    warn "error in mv $clog logs";
  }
}

=item B<mprint($string, FILEHANDLE1, FILEHANDLE2, ...)>

Print $string to FILEHANDLE1, FILEHANDLE2, ...

=cut
sub mprint {
  my $string = shift;
  foreach (@_){
    print $_ $string;
  }
}

=item B<liprint(\*FH1, \*FH2, " Destroy Earth now? [Y]: n")>

Prints a string to the first filehandle, and only the part after the 1st ": "
to the second filehandle.

=cut
sub liprint {
  my $vfh    = shift;
  my $ifh    = shift;
  my $string = shift;

  print $vfh $string;
  $string =~ s/[^:]*:? ?//;
  print $ifh $string;
}

=item B<manip($command)>

Run $command through madr's manip.

=cut
sub manip{
  my $command = $_[0];

  open(MADR, "|madr >> manip.madrout 2> /dev/null")
    or die "Could not |madr >> manip.madrout 2> /dev/null";
  print MADR "m\n";
  print MADR "$command\n";
  print MADR "exit\n";		# Leave manip.
  print MADR "exit\n";		# Leave madr.
  close(MADR) or warn "Error closing |madr >> manip.madrout 2> /dev/null";
}

=item B<scitodec($numstr)>

Returns $numstr, a number in string form, possibly in scientific notation,
as a decimal number.

=cut
sub scitodec{
  my $numstr = $_[0];

  $numstr =~ s/\s//g;
  if($numstr =~ /E/i){
    $numstr =~ /([^Ee]+)[Ee](.+)/;
    my $mant = $1;
    my $expo = $2;
    $numstr = $mant * 10**$expo;
  }
  return $numstr;
}

=head1 AUTHOR

Rob Reid, E<lt>rob.reid@nrc-cnrc.gc.caE<gt>, with contributions as noted above.

=head1 LICENSE

GNU General Public Licence, version 2.

=cut