#!/usr/bin/perl -w
#-------------------------------------------------------------------------------
#Purpose     : convert *.in files into {arc,bias,flat,object}.table
#Author      : Robert Greimel (greimel@uvastro.phys.uvic.ca,greimel@ing.iac.es)
#Last Change : 21-Feb-2000
#-------------------------------------------------------------------------------
###### to search local directory for modules
use FindBin 1.51 qw( $RealBin );
use lib $RealBin;
######

use Scripts;

##
# make sure directory ends with a "/"
##
$dir=$ARGV[0];
if ($dir !~ m|/$|) {$dir = $dir."/"};

##########
#read generation options
##########
%filenames=();
print "$0: reading filename configuration ... ";
&Scripts::read_filenames(\%filenames,"config.names");
print "done\n";

%options=();
print "$0: reading default options ... ";
( &Scripts::read_options(\%options,$filenames{"default_options"}) ) ? print "successful\n" : print "failed\n" ;

print "$0: reading directory specific options ... ";
( &Scripts::read_options(\%options,$dir.$filenames{"custom_options"}) ) ? print "successful\n" : print "failed\n" ;

if ($options{"directory"} eq "yes")
  {
  print "directory option is on\n";
  $dir_inout=$dir.$filenames{"dir_inout"}."/";
  }
else
  {
  print "directory option is off\n";
  $dir_inout=$dir;
  }

##########
# read directory entries and generate arrays of .in files
##########

if ( ! defined(opendir DIR,$dir_inout) )
  {die "Error opening directory ".$dir_inout."\n";}
while ( defined ($_=readdir(DIR)) )
  {
  if ( $_ =~ /bias([0-9]+).*\.in/ )
    {
    push @bias,$_;
    push @nbias,$1;
    }
  if ( $_ =~ /flat([0-9]+).*\.in/ )
    {
    push @flat,$_;
    push @nflat,$1;
    }
  if ( $_ =~ /arc([0-9]+).*\.in/ )
    {
    push @arc,$_;
    push @narc,$1;
    }
  }
closedir DIR;

##
# sort file numbers
##
@bias = sort filenames @bias;
@flat = sort filenames @flat;
@arc = sort filenames @arc;
@nbias = sort numerically @nbias;
@nflat = sort numerically @nflat;
@narc = sort numerically @narc;

##
# read statistics information
##
$stat = $dir.$filenames{"stat_file"};
%scol = ();
%ecol = ();
open STAT,$stat;
while (<STAT>)
  {
  if ( m/^#/ ) {next;}
  @fields = split;
  $scol{$fields[0]}=$fields[4];
  $ecol{$fields[0]}=$fields[5];
  }
close STAT;

##
# make sure terminal output is immediately flushed
##
use FileHandle;
autoflush STDOUT 1;

##########
#bias
##########

$tbias=$dir."bias.table";
if ( -e $tbias )
  {
  print " Bias table already exists - overwrite (y/N): ";
  $answer=<STDIN>;
  chomp $answer;
  if ( $answer ne "y" && $answer ne "Y" ) {goto label_flat;}
  unlink ($tbias, $dir."bias*.out");
  }

print " creating bias table ...";
open TBIAS,">".$tbias;
print TBIAS "#name\t\tbias\tflat\tarc1\tarc2\n";
foreach $i ( @bias )
  {
  print TBIAS "$i\tnull\tnull\tnull\tnull\n";
  }
close TBIAS;
print "done\n";

print " creating bias .out ...";
$prefix="bias";
&generate_out( @bias );
print "done\n";

##########
#flat
##########
label_flat:
$tflat=$dir."flat.table";
if ( -e $tflat )
  {
  print " Flat table already exists - overwrite (y/N): ";
  $answer=<STDIN>;
  chomp $answer;
  if ( $answer ne "y" && $answer ne "Y" ) {goto label_range;}
  unlink ($tflat, $dir."flat*.out");
  }

print " creating flat table ...";
open TFLAT,">".$tflat;
print TFLAT "#name\t\tbias\tflat\tarc1\tarc2\n";
foreach $in ( @flat )
  {
  $in =~ /flat([0-9]+).*\.in/;
  $ub=&find_related($1,"nbias",$options{"flat-bias"});
  print TFLAT "$in\t$ub\tnull\tnull\tnull\n";
  }
close TFLAT;
print "done\n";

print " creating flat .out ...";
$prefix="flat";
&generate_out( @flat );
print "done\n";

##########
#find range
##########
label_range:
$rows=$dir.$filenames{"data_rows"};
if ( -e $rows )
  {
  print " Data rows already found\n";
  print " - remove $rows if you want them regenerated\n";

  open SYSTEM,"$rows";
  @in=<SYSTEM>;
  close SYSTEM;
  $default_rows=$in[-1];
  chomp $default_rows;
  }
else
  {
  print " finding location of spectrum ...";

  $c = 0;
  $smax = 0;
  $smin = 0;
  foreach $file ( @flat )
    {
    open SYSTEM,$dir_inout.$file;
    while (<SYSTEM>)
      {
      chomp;
      $smin += $scol{$_};
      $smax += $ecol{$_};
      $c++;
      }
    close SYSTEM;
    }

  $default_rows = join " ",(int($smin/$c+0.5)..int($smax/$c+1)+0.5);

  open SYSTEM,">$rows";
  print SYSTEM $default_rows;
  close SYSTEM;

  print "done\n";
  }

##########
#object
##########

print " creating object.out ...";
#$prefix="object";
#&generate_out( "object.in" );

label_object:
$tobject=$dir."object.table";
$aobject=$dir."object.out";

if ( -e $tobject )
  {
  print " Object table already exists - overwrite (y/N): ";
  $answer=<STDIN>;
  chomp $answer;
  if ( $answer ne "y" && $answer ne "Y" ) {goto label_arc;}
  unlink $tobject;
  }

##
# find location of spectra
##
print " finding location of object spectra ...\n";
# read the file object.in which contains the names of all object spectra
open SYSTEM,$dir_inout."object.in";
@object_in=<SYSTEM>;
close SYSTEM;
# remove carriage return and add data directory to filename
map {chomp $_;} @object_in;
##
# find typical spectral range
# - first pass finds typical row range
# - second pass adjusts row range to typical range for problem spectra
##
$row_low = (split " ",$default_rows)[0];
$row_high = (split " ",$default_rows)[-1];
($count, $sum_low, $sum_high) = (0,0,0);
foreach $fname ( @object_in )
  {
  if ( $scol{$fname} >= $row_low &&  $ecol{$fname} <= $row_high)
    {
    $sum_low += $scol{$fname};
    $sum_high += $ecol{$fname};
    $count++;
    }
  }
if ( $count > 0 )
  {
  $row_typ_low = int(($sum_low+0.5)/$count);
  $row_typ_high = int(($sum_high+0.5)/$count);
  }
else
  {
  print " ERROR - no object spectra locations found !!!\n";
  $row_typ_low = $row_low - 1;
  $row_typ_high = $row_high + 1;
  }
#
# check that the typical range is within the default range
#
if ($row_typ_low < $row_low)
  {
  print " WARNING - low row index : typical less than default - reset\n";
  $row_typ_low = $row_low;
  }
if ($row_typ_high > $row_high)
  {
  print " WARNING - high row index : typical larger than default - reset\n";
  $row_typ_high = $row_high;
  }
#
# pass 2
#
map
  {
  if ( $scol{$_} < $row_low ||  $ecol{$_} > $row_high)
    {
    $scol{$_} = $row_typ_low;
    $ecol{$_} = $row_typ_high;
    $_ =~ m"^rawdat/(.*)$";
    print $1," : location out of range (probably low level exposure) - adjusted\n";
    }
  } @object_in;
#
print "typical row range: $row_typ_low - $row_typ_high\n";

print " creating object table ...";

%frame_type = ();
open SYSTEM,$dir."frame.type";
while (<SYSTEM>)
  {
  chomp;
  @in=split;
  $frame_type{$in[0]}=$in[-1];
  }
close SYSTEM;

open TOBJECT,">".$tobject;
open AOBJECT,">".$aobject;
print TOBJECT "#name\t\tbias\tflat\tarc1\tarc2\tdata-rows\n";
open SYSTEM,$dir_inout."object.in";
while ( defined ($in=<SYSTEM>) )
  {
  chomp $in;
  $in =~ /\.([0-9]+)$/;
  $num=$1;
  $ub=&find_related($num,"nbias",$options{"object-bias"});
  $uf=&find_related($num,"nflat",$options{"object-flat"});
  $ua1=&find_related($num,"narc",$options{"object-arc1"});
  $ua2=&find_related($num,"narc",$options{"object-arc2"});
  $objrows=join " ",($scol{$in}..$ecol{$in});
  if ( exists $arc_ext{$ua1} )
    {
    if (  ! exists $arc_use{$ua1}{$objrows} )
      {
      $arc_ext{$ua1}++;
      $arc_use{$ua1}{$objrows} = $arc_ext{$ua1};
      }
    }
  else
    {
    $arc_ext{$ua1}="a";
    $arc_use{$ua1}{$objrows} = $arc_ext{$ua1};
    }
  if ( exists $arc_ext{$ua2} )
    {
    if (  ! exists $arc_use{$ua2}{$objrows} )
      {
      $arc_ext{$ua2}++;
      $arc_use{$ua2}{$objrows} = $arc_ext{$ua2};
      }
    }
  else
    {
    $arc_ext{$ua2}="a";
    $arc_use{$ua2}{$objrows} = $arc_ext{$ua2};
    }
  print TOBJECT "$frame_type{$in}.$num\t$ub\t$uf\t$ua1$arc_use{$ua1}{$objrows}\t$ua2$arc_use{$ua2}{$objrows}\t$objrows\n";
  print AOBJECT "$frame_type{$in}.$num\n";
  }
close SYSTEM;
close TOBJECT;
close AOBJECT;

print "done\n";

##########
#arc
##########
label_arc:
$tarc=$dir."arc.table";
if ( -e $tarc )
  {
  print " Arc table already exists - overwrite (y/N): ";
  $answer=<STDIN>;
  chomp $answer;
  if ( $answer ne "y" && $answer ne "Y" ) {goto label_end;}
  unlink ($tarc, $dir."arc*.out");
  }

print " creating arc table ...";

open TARC,">".$tarc;
print TARC "#name\t\tbias\tflat\tarc1\tarc2\tdata-rows\n";
foreach $in ( @arc )
  {
  $in =~ /arc([0-9]+).*\.in/;
  $ub=&find_related($1,"nbias",$options{"arc-bias"});
  print TARC "$in\t$ub\tnull\tnull\tnull\t$default_rows\n";
  }
close TARC;
print "done\n";

print " creating arc .out ...";
$prefix="arc";
&generate_out( @arc );
print "done\n";

##########
# arc - second pass
##########

#print "arc hash starts here --->\n";
open TARC,">>".$tarc;
foreach $arc (sort numerically (keys %arc_use))
  {
#  print "hash: $arc\n";
  foreach $rr (keys %{$arc_use{$arc}})
    {
    $append = $arc_use{$arc}{$rr};
#    print $append,":",$rr,"\n";
    $ub=&find_related($arc,"nbias",$options{"arc-bias"});
    print TARC "arc$arc$append.in\t$ub\tnull\tnull\tnull\t",$rr,"\n";
    }
  }
close TARC;
#print "arc hash ends here --->\n";

##########
# END
##########
label_end:
print " \n";
print " - please check tables\n";
print "     $tbias\n";
print "     $tflat\n";
print "     $tarc\n";
print "     $tobject\n";
print " - run> gen_reduce.csh $dir\n";

###############################           ###############################
#                              SUBROUTINES
###############################           ###############################
sub generate_out()
  {
  foreach $in ( @_ )
    {
    $out = $in;
    $out =~ s/\.in/.out/;
    open OUT,">".$dir_inout.$out;
    open IN,$dir_inout.$in;
    while (<IN>)
      {
      print OUT $prefix.".".(split /\./)[1];
      }
    close IN;
    close OUT;
    }
  }

sub find_related()
  {
  my $i;
  ( my $n, my $ns, my $o )=@_;
#print $n." ".$ns." ".$o."\n";
#initialize
  my $lb=0;
  my $ub=0;
  my $result=$$ns[$lb];
#all
  if ( $o eq "all" )
    {
    $result = join "+",@$ns;
    }
#bracket
  elsif ( $o eq "bracket" )
    {
    $lb=0;
    for ($i=0;$i<=$#$ns;$i++) {if ($$ns[$i] < $n) {$lb=$i;}}
    $result=$$ns[$lb];
    $ub=$#$ns;
    for ($i=0;$i<=$#$ns;$i++) {if ($$ns[$i] > $n) {$ub=$i;last}}
    if ($lb != $ub) {$result=$result."+".$$ns[$ub];}
    }
#following
  elsif ( $o eq "following" )
    {
    $ub=$#$ns;
    for ($i=0;$i<=$#$ns;$i++) {if ($$ns[$i] > $n) {$ub=$i;last}}
    $result=$$ns[$ub];
    }
#preceding (default)
  else
    {
    $lb=0;
    for ($i=0;$i<=$#$ns;$i++) {if ($$ns[$i] < $n) {$lb=$i;}}
    $result=$$ns[$lb];
    }
  return $result;
  }

sub numerically { $a <=> $b; }
sub filenames { $a =~ /([0-9]+)/; my $av=$1; $b =~ /([0-9]+)/; $av <=> $1; }