#######################################################################
sub fixpars { # find parameters that contain special symbols and put them
              #	in quotes
my @pars = @_;
my $par;
foreach $par ( @pars ) {
  if ( $par =~ /[\(\)\#\[\]\s\>]/ ) {
    if ( ! ( $par =~ /^[\"\']/ ) ) {
      $par = "'".$par."'";
    }
  }
}
return @pars;
}


###########################################################################
sub translate_region_wcs { # Calls transreg from ZHTOOLS
# usage  &translate_region_wcs (regfile,outfile,regwcs)
# if regwcs in "", copy regfile to outfile

  my ($regfile,$outfile,$regwcs,$towcs,@otherargs) = @_;

  use File::Copy;
  my $transreg = "transreg";  # from ZHTOOLS

  if ( ! $regfile ) {
    warn "regfile is not set in translate_region_wcs";
    return 1;
  }
  if ( ! $outfile ) {
    warn "outfile is not set in translate_region_wcs";
    return 1;
  }
  
  if ( $regwcs && $towcs ) {
    if ( $regfile eq $outfile ) {
      my $tmpfile = $outfile."_$$";
      my $stat;
      if ( $stat = 
	   &runprog ($transreg,
		     "-from",$regwcs,"-to",$towcs,
		     "-out",$tmpfile,"-reg",$regfile,
		     @otherargs) ) {
	return $stat;
      }
      return rename ($tmpfile,$outfile);
    }
    else {
      return 
	&runprog ($transreg,
		  "-from",$regwcs,"-to",$towcs,
		  "-out",$outfile,"-reg",$regfile,
		  @otherargs);
    }
  }
  else {
    warn "To/From WCS is not set in &translate_region_wcs";
    if ( ! ( $regfile eq $outfile ) ) {
      return copy($regfile,$outfile);
    }
    else {
      return 0;
    }
  }
}


###########################################################################
sub translate_region_wcs_1 { # Calls transreg from ZHTOOLS
# usage  &translate_region_wcs (regfile,outfile,regwcs)
# if regwcs in "", copy regfile to outfile

  my ($regfile,$outfile,$regwcs) = @_;

  use File::Copy;
  my $transreg = "transreg";  # from ZHTOOLS

  if ( ! $regfile ) {
    warn "regfile is not set in translate_region_wcs_1";
    return 1;
  }
  if ( ! $outfile ) {
    warn "outfile is not set in translate_region_wcs_1";
    return 1;
  }
  
  if ( $regwcs ) {
    if ( $regfile eq $outfile ) {
      my $tmpfile = $outfile."_$$";
      my $stat;
      if ( $stat = 
	   &runprog ($transreg,
		     "-from",$regwcs,"-towcs",
		     "-out",$tmpfile,"-reg",$regfile) )
	{
	  return $stat;
	}
      return rename ($tmpfile,$outfile);
    }
    else {
      return 
	&runprog ($transreg,
		  "-from",$regwcs,"-towcs",
		  "-out",$outfile,"-reg",$regfile);
    }
  }
  else {
    warn "To WCS is not set in &translate_region_wcs_1";
    if ( ! ( $regfile eq $outfile ) ) {
      return copy($regfile,$outfile);
    }
    else {
      return 0;
    }
  }
}




##########################################################################
sub reversefilter { # Since FITSIO uses .and. operation within reg files,
                    # we need to reverse the region
# Usage reversefilter(file,tofile);
my ($file,$tofile) = @_;
if ( ! $file  ) {
  warn "file is not set in reversefilter";
  return 1;
}
if ( ! $tofile  ) {
  warn "tofile is not set in reversefilter";
  return 1;
}

my $tmpfile;
if ( $file eq $tofile ) {  $tmpfile = $tofile."_$$"; }
else                    {  $tmpfile = $tofile; };

open (REVFILTFILT,$file) || die "Could not open $file\n";
open (REVFILTTOFILT,"> $tmpfile") || 
  die "Could not open $tmpfile for writing\n";
while ( <REVFILTFILT> ) {
  unless ( s/^\s*-(\w)/$1/ ) { s/^\s*\+*(\w)/-$1/; }
  print REVFILTTOFILT $_;
}
close (REVFILTFILT); close (REVFILTTOFILT);
if ( $tmpfile eq $tofile ) { return 0; }
return ( ! rename ($tmpfile,$tofile) );

}

#######################################################################
sub splitregfilter { # Splits include / exclude regions into separate files

# Usage: splitfilter (reg,reginc,regexcl);

my ($reg,$reginc,$regexcl) = @_;
unless ( $reg )     { warn "reg not set in splitregfiler"; return 1;}
unless ( $reginc )  { warn "reginc not set in splitregfiler"; return 1;}
unless ( $regexcl)  { warn "regexcl not set in splitregfiler"; return 1;}

if ( ( $reg eq $reginc ) || ( $reg eq $regexcl ) || ( $reginc eq $regexcl ) ) {
  warn "files must be different in splitfilter"; return 1;
}

open (SPLITFILTREG,$reg) || die "Could not open $reg\n";
open (SPLITFILTREGINC,"> $reginc") || 
  die "Could not open $reginc for writing\n";
open (SPLITFILTREGEXCL,"> $regexcl") || 
  die "Could not open $regexcl for writing\n";

while ( <SPLITFILTREG> ){
  if ( /^\s*-(\w)/ ) {
    print SPLITFILTREGEXCL;
  }
  else {
    print SPLITFILTREGINC;
  }
}
close (SPLITFILTREG); close (SPLITFILTREGINC); close (SPLITFILTREGEXCL);
return 0;
}

#######################################################################
sub valid_region { #determines whether the string contains a valid region
  my ($string) = @_;
  if ($string =~ /[\(\)]/ ) { # a string with parens is a correct region
    return 1;
  }
  if ($string =~ /\s/ ) { #
    my ($type) = split (/\s/,$string);
    if ($type =~ /^[\+-]?point$/i || $type =~ /^[\+-]?p$/i)   { return 1; }
    if ($type =~ /^[\+-]?line$/i)                             { return 1; }
    if ($type =~ /^[\+-]?polygon$/i)                          { return 1; }
    if ($type =~ /^[\+-]?rectangle$i/)                        { return 1; }
    if ($type =~ /^[\+-]?box$/i || $type =~ /^[\+-]?b$/i)     { return 1; }
    if ($type =~ /^[\+-]?diamond$/i)                          { return 1; }
    if ($type =~ /^[\+-]?circle$/i || $type =~ /^[\+-]?c$/i)  { return 1; }
    if ($type =~ /^[\+-]?annulus$/i || $type =~ /^[\+-]?a$/i) { return 1; }
    if ($type =~ /^[\+-]?ellipse$/i || $type =~ /^[\+-]?e$/i) { return 1; }
    if ($type =~ /^[\+-]?elliptannulus$/i)                    { return 1; }
    if ($type =~ /^[\+-]?sector$/i || $type =~ /^[\+-]?s$/i)  { return 1; }
    return 0; # not a known region
  } else {
    return 0;
  }
}


#######################################################################
sub combine_inc_excl_filt { # Non-trivial combination required to filter
                            # by region properly if one assumes that components
                            # are or'ed
# Usage combine_inc_excl_filt (inc,excl) # inc is assumed to be reversed

my ($inc,$excl) = @_;
return "((! regfilter( \"$inc\" )) && regfilter( \"$excl\"))";
}


#######################################################################
sub form_row_filter { 
  # writes filters to a file. appends the badpixel filter file
  if ( $#_ < 1 ) {
    return 1;
  }
  my ($rowfilterfile, $badpixfilter ) = @_;
  shift @_; shift @_;
  open (ROWFILTERFILE,"> $rowfilterfile") || 
    die "Cannot open $rowfilterfile for writing\n";
  my $written = 0;
  if ( $badpixfilter ) {
#
# Convert bad pixel file to FITSIO filter
#
    open (BADPIXFILE,$badpixfilter) || die "Cannot open $badpixfilter\n";
    while ( <BADPIXFILE> ) {
      if (/^\s*\#/) {next;}
      chop;  s/^\s+//;
      my @words = split;
      if ( $#words >= 4 ) {
	my ($ccdid,$xmin,$xmax,$ymin,$ymax) = @words;
	if ( $written == 0 ) {
	  print ROWFILTERFILE "! ( \n";
	}
	if ( $written == 1 ) {
	  print ROWFILTERFILE "||\n";
	}
	print ROWFILTERFILE "(ccd_id == ",$ccdid," && (";
	if ( $xmin == $xmax ) {
	  print ROWFILTERFILE "chipx == $xmin";
	} else {
	  print ROWFILTERFILE "chipx >= $xmin && chipx <= $xmax";
	}
	if ( $ymin != 1 || $ymax != 1024 ) {
	  if ( $ymin == $ymax ) {
	    print ROWFILTERFILE " && chipy == $ymin";
	  } else {
	    print ROWFILTERFILE " && chipy >= $ymin && chipy <= $ymax";
	  }
	}
	print ROWFILTERFILE ") )";
	$written = 1;
      }
    }
    close (BADPIXFILE);
    if ( $written == 1 ) {
      print ROWFILTERFILE "\n)\n";
    }
  }
  my $filt;
  foreach $filt ( @_ ) {
    if ( $filt ) {
      if ( $written ) {
	print ROWFILTERFILE "  &&  \n";
      }
      print ROWFILTERFILE $filt,"\n"; $written = 1;
    }
  }
  close (ROWFILTERFILE);
  return 0;
}

#######################################################################
sub runprog {   # run a system program without executing the shell

#  print "Executing ",join(' ',@_),"\n";

  unless (fork) {
    # fork returned zero so I' the child and I exec
    exec @_;
  }
  wait;
  return $?;
}


#######################################################################
sub ini_chip_names {
  %CHIPNUM=();

  $CHIPNUM{"ACIS-0"}=0;
  $CHIPNUM{"ACIS-1"}=1;
  $CHIPNUM{"ACIS-2"}=2;
  $CHIPNUM{"ACIS-3"}=3;
  $CHIPNUM{"ACIS-4"}=4;
  $CHIPNUM{"ACIS-5"}=5;
  $CHIPNUM{"ACIS-6"}=6;
  $CHIPNUM{"ACIS-7"}=7;
  $CHIPNUM{"ACIS-8"}=8;
  $CHIPNUM{"ACIS-9"}=9;

  $CHIPNUM{"ACIS-I0"}=0;
  $CHIPNUM{"ACIS-I1"}=1;
  $CHIPNUM{"ACIS-I2"}=2;
  $CHIPNUM{"ACIS-I3"}=3;
  $CHIPNUM{"ACIS-S0"}=4;
  $CHIPNUM{"ACIS-S1"}=5;
  $CHIPNUM{"ACIS-S2"}=6;
  $CHIPNUM{"ACIS-S3"}=7;
  $CHIPNUM{"ACIS-S4"}=8;
  $CHIPNUM{"ACIS-S5"}=9;

  $CHIPNUM{"I0"}=0;
  $CHIPNUM{"I1"}=1;
  $CHIPNUM{"I2"}=2;
  $CHIPNUM{"I3"}=3;
  $CHIPNUM{"S0"}=4;
  $CHIPNUM{"S1"}=5;
  $CHIPNUM{"S2"}=6;
  $CHIPNUM{"S3"}=7;
  $CHIPNUM{"S4"}=8;
  $CHIPNUM{"S5"}=9;

  $CHIPNUM{"I"}="0:3";       # The entire ACIS-I
  $CHIPNUM{"ACIS-I"} = $CHIPNUM{"I"};
  $CHIPNUM{"ACISI"}  = $CHIPNUM{"I"};
  $CHIPNUM{"FI"}="0:3,4,6,8,9";       # All FI chips
  $CHIPNUM{"SFI"}="0:3,6";            # Standard FI chips
  $CHIPNUM{"BI"}="5,7";               # All BI chips

  # generate lower-case version of all chip names
  foreach $key ( keys %CHIPNUM ) {
    my($junk);
    ($junk = $key) =~ tr/[A-Z]/[a-z]/;
    if ( ! ( $junk eq $key ) ) {
      $CHIPNUM{$junk}=$CHIPNUM{$key};
    }
  }

}

########################################################################
sub check_ftools {
  if ($ENV{'FTOOLS'}) {
    return 1;
  }
  die "You need FTOOLS\n";
}

sub check_zhtools {
  if ($ENV{'ZHTOOLS'}) {
    return 1;
  }
  my ($test);
  ($test) = `zhtools-config -b`; chomp $test;
  if ( $test ) {
    # put it in the path, just in case, and exit
    $ENV{'PATH'} = $ENV{'PATH'}.":$test";
    return 1;
  }
  die "You need ZHTOOLS\n";
}

############### END OF PERLUTIL ########################################
1;
