#!/usr/bin/perl
# fg2flg  -- convert aips flag table to UVFLG input
#            SC 20030303 
#            Table exported with TBOUT docrt=132
# $flagformat = "I I I i I l i i a4 A24";
# row, src, subarray, freq, ants, time, IFs, chan, pflags, reason

$fname = shift(@ARGV);
$oname = shift(@ARGV);
if(($fname eq "")||($oname eq "")){ 
    die "Usage: fg2flg TBOUT.txt flags.txt -- exiting"; 
}

# Read header (~60 lines) 
open (INPF, "$fname") || die "Cannot open input file"; 
while (<INPF>){
    if(/^NAXIS1\s\s=\s+(\d+)\s+(.*)/) { $NCOL = $1; }
    if(/^NAXIS2\s\s=\s+(\d+)\s+(.*)/) { $NROW = $1; }
    if(/^EXTNAME\s=\s(\S+)\s(\S+)(.*)/) { $AIPS = $1; $TNAM = $2;}
    last if(/\*\*\*BEGIN\*PASS(.*)/);
}

# Check conditions 
if($TNAM eq "FG"){
    printf("FG2FLG: Reading flag table with %d rows.\n", $NROW);
} else { 
    die "This is not an AIPS flag table produced by TBOUT! Exit";
}
if($NCOL != 132){ die "Must be output with docrt=132 in TBOUT. Exit"; }

open (OUTF, "> $oname") || die "Cannot open output file"; 

# VLBA Online flags re WFB, from correlator software
@onlineflags = (
        'Antenna offsource       ',
        'Antenna off source      ',
        'Antenna not pointed     ',
        'System idle             ',
        'Subreflector error      ',
        'Recorder 2 not running  ',
        'Recorder 1 not running  ',
        'Recorder 2 head posn err',
        'Recorder 1 head posn err',
        'Source change in progres',
        'Ellipsoid posn error    ',
        'Illegal flag 1          ',
        'Illegal flag 2          ',
        'Illegal flag 3          ',
        'Synthesizer 3 unlocked  ',
        'Synthesizer 2 unlocked  ',
        'Synthesizer 1 unlocked  ',
        'BBC Synth Unlocked      '
);
# $sysflags = join(':',@onlineflags);

# Parse flags
# row, src, subarray, freq, ants, time, IFs, chan, pflags, reason

$line = 1; $onlineflagnum=0; $newflagnum = 0;
while (<INPF>){
    chop;
    last if(/\*\*\*END\*PASS(.*)/);
    if(($line%2)==1){                      #First line of row
	($n1, $src, $subarr, $freq, $ant1, $time1, $bif, $bchan, $pflags, $reasonqt) 
	    = split(' ',$_, 10);       
	$reason = substr($reasonqt,1,24);  # remove quotes from $reason
	$line++;

    }else{                                 #Second line of row
	($n2, $jnk, $jnk2, $jnk3, $ant2, $time2, $eif, $echan, $jnk4, $jnk5) 
	    = split(' ',$_, 10); 

	if(($n1!=$n2)||($line/2 != $n1)){ die "Have $n1, $n2, $line: this can't happen! Error"; }
	$line++;

	# Is this an online flag?
	$known = 0;
	foreach(@onlineflags){
	    if ($_ eq $reason) { $known=1; }
	}
	# This is backwards, but hey, it works.
	# Should do:
	# @knownreason = grep($reason,@onlineflags);
	# then parse; undef @knownreason;
        # but that doesn't work. perlcircus.com has a working example.
	
	if ($known!=0) { 
	    $onlineflagnum++;
	} else {                           # Found something to save
	    $newflagnum++;                 # First one is 1, not 0

	    printf(OUTF "flag%d = bif=%d;eif=%d;bchan=%d;echan=%d;stokes=%s;",
		   $newflagnum, $bif,$eif, $bchan,$echan,$pflags);

	    if(($ant2!=0)&&($ant1!=$ant2)){
		printf(OUTF "ante=%d,0;basel=%d,0;",$ant1,$ant2);
	    } else {
		printf(OUTF "ante=%d,0;",$ant1);
	    }

	    #Time = (86400*dd + 3600*hh + 60*mm + ss)/86400
	    $d1 = int($time1);
	    $h1 = int(($time1 - $d1)*24);
	    $m1 = int(((($time1 - $d1)*24)-$h1)*60);
	    $s1 = (($time1*86400)%60);

	    $d2 = int($time2); 
	    $h2 = int(($time2 - $d2)*24);
	    $m2 = int(((($time2 - $d2)*24)-$h2)*60);
	    $s2 = (($time2*86400)%60);
	    if($d2==9999){$d2=0;}
 	    
	    if($d1||$h1||$m1||$s1||$d2||$h2||$m2||$s2){ #At least one is non-zero
		printf(OUTF "timer=%d,%d,%d,%d,%d,%d,%d,%d;",
		       $d1,$h1,$m1,$s1, $d2,$h2,$m2,$s2);
	    }

	    if($reason=~/\w+(.*)/){  # There is a non-blank reason
		$reason=~s/\s+/ /g;  # Convert multiple spaces to single
 		$reason=~s/\s/_/g;   # and replace them with _ for now.

		printf(OUTF "reason=\'%s\'\n", $reason);
	    } else { 
		printf(OUTF "\n");
	    }
	}
	
    } # end parsing of second line in row
} # end while

if($n1!=$NROW){ die "Expected $NROW rows, got $n1. Something is wrong"; }

printf("Discarded %d known online flags and ", $onlineflagnum); 
printf("wrote %d user flags to %s.\n", $newflagnum, $oname);
close(INPF);
close(OUTF);
exit; 

#    ($n, $src, $subarr, $freq, $ant1, $time1, $bif, $chan1, $pflags, $reason) 
#	= unpack($flagformat, $_); 
