#!/bin/sh
# Next line is a comment to tcl \
    PATH=/opt/tcl803/bin/tcl:$PATH exec tcl $0 ${1+"$@"}

proc doFilePat {descend pat} {
    if {[catch {glob $pat} filelist]} {
	puts stderr $filelist
	return
    }
    foreach file $filelist {
	if {[file isdirectory $file]} {
	    if {$descend} {
		set olddir [pwd]
		if {[catch {cd $file} result]} {
		    puts stderr "Failed to cd to $file: $result"
		    continue
		}
		puts "\n---- Entering directory: $file ----"
		doFilePat 0 *
		puts "---- End of directory: $file ----"
		cd $olddir
	    } else {
		puts "$file: directory"
	    }
	    continue
	} elseif {[catch {open $file r} handle]} {
	    puts stderr "Can't open $file for reading: $handle"
	    continue
	} else {
	    if {[catch {readFitsHdr $handle} hdr]} {
		puts stderr "$file: $hdr"
		catch {close $handle}
		continue
	    }
	    close $handle
	    processHdr $file $hdr
	}
    }
}

proc processHdr {file hdr} {
    global Keylist PrintFilename Missing WS Use_WS_subst WS_subst

    set f [lindex [file split $file] end]
    if {[lempty $Keylist]} {
	if {[catch {keylget hdr OBJECT} object]} { set object "" }
	if $Use_WS_subst { regsub -all "\[$WS]+" $object $WS_subst object }

	if {[catch {keylget hdr ELAPTIME} exp]} {
	    set exp ""
	} else {
	    append exp s
	}
	if {$Use_WS_subst} { regsub -all "\[$WS]+" $exp $WS_subst exp }

	if {[catch {keylget hdr DATE-OBS} date]} { set date "" }
	if {$Use_WS_subst} { regsub -all "\[$WS]+" $date $WS_subst date }

	if {[catch {keylget hdr UTC} time]} { set time "" }
	if {$Use_WS_subst} { regsub -all "\[$WS]+" $time $WS_subst time }

	if {$PrintFilename} {
	    puts [format "%-20s %8s %.8s %4s %s" \
				$f $date $time $exp $object]
	} else {
	    puts [format "%8s %.8s %4s %s" \
				$date $time $exp $object]
	}
    } else {
	if {$PrintFilename} {
	    set result "$f: "
	} else {
	    set result ""
	}
	foreach key $Keylist {
	    if {[catch {keylget hdr $key} x]} { set x $Missing }
	    if {$Use_WS_subst} { regsub -all "\[$WS]+" $x $WS_subst x }
	    append result $x " "
	}
	puts $result
    }
}

# A simple-minded FITS header reader.  It only reads the first HDU.
# The keyword/value pairs are returned as a TclX keyed list.
#
# The rules for values are (NB: in this description we count from 1,
# but of course the code counts characters from 0):
#	o  If character #11 is "'", we take all data between the apostrophe
#		and its matching apostrophe, then trim trailing whitespace.
#	o  Otherwise, we take the data and strip the leading and trailing w/s.
# This of course isn't really FITS, but it will work for our simple images.
#
# Note: an uncaught error will occur if we reach EOF w/o finding the
# END keyword.
# We generate an error if the file doesn't begin with keyword SIMPLE.

proc readFitsHdr {channel} {
    set hdr {}
    set text [read $channel 80]
    set key [string trim [csubstr $text 0 8]]
    if {![cequal $key SIMPLE] && ![cequal $key XTENSION]} {
	return -code error "Not a FITS file --\
	    first keyword isn't SIMPLE or XTENSION"
    }
    regexp {[^/]*} [crange $text 10 79] value
    keylset hdr $key [string trim $value]
    while {[string length [set text [read $channel 80]]]} {
	set key [string trim [csubstr $text 0 8]]
	if {[cequal $key END]} {
	    return $hdr
	}
	if {[cequal $key ""] || ![cequal [crange $text 8 9] "= "]} {
	    continue ;# blank line or not keywd/value format
	}
	if {[cequal [crange $text 10 10] "'"]} {
	    regexp {'([^']|'')*'} $text value
	    regsub -all '' $value ' value
	    keylset hdr $key [string trimright [string trim $value ']]
	} else {
	    regexp {[^/]*} [crange $text 10 79] value
	    keylset hdr $key [string trim $value]
	}
	### if keylget hdr $key {} ...
    }
    # Reached EOF w/o finding END keyword!
    return -code error "Not a FITS file -- no END keyword!"
}

##########################################################################
# A simple-minded **textified**-FITS header reader -- NOT a FITS header reader.
# It reads the first HDU (from wherever the file is currently positioned),
# then stops.  By textified, I mean that instead of FITS 80-char fixed-length
# card images, the file contains ordinary newline-terminated text records.
# The keyword/value pairs are returned as a TclX keyed list.
#
# The rules for values are (NB: in this description we count from 1,
# but of course the code counts characters from 0):
#	o  If character #11 is "'", we take all data between the apostrophe
#		and its matching apostrophe, then trim trailing whitespace.
#	o  Otherwise, we take the data and strip the leading and trailing w/s.
# This of course isn't really FITS, but it will work for many simple cases.
#
# Note: an error will be raised if we reach EOF w/o finding the END keyword.
# We generate an error if the file doesn't begin with keyword SIMPLE.

proc readTxtFits {channel} {
    set hdr {}
    set key {}
    while {[cequal $key ""]} {
	if {[gets $channel text] < 0} {
	    return -code error "EOF on $channel"
	}
	set key [string trim [csubstr $text 0 8]]
    }
    if {![cequal $key SIMPLE] && ![cequal $key XTENSION]} {
	return -code error "Not a FITS file --\
	    first keyword isn't SIMPLE or XTENSION"
    }
    regexp {[^/]*} [crange $text 10 79] value
    keylset hdr $key [string trim $value]
    while {1} {
	if {[gets $channel text] < 0} {
	    return -code error "EOF on $channel"
	}
	set key [string trim [csubstr $text 0 8]]
	if {[cequal $key END]} {
	    return $hdr
	}
	if {[cequal $key ""] || ![cequal [crange $text 8 9] "= "]} {
	    continue ;# blank line or not keywd/value format
	}
	if {[cequal [crange $text 10 10] "'"]} {
	    regexp {'([^']|'')*'} $text value
	    regsub -all '' $value ' value
	    keylset hdr $key [string trimright [string trim $value ']]
	} else {
	    regexp {[^/]*} [crange $text 10 79] value
	    keylset hdr $key [string trim $value]
	}
	### if keylget hdr $key {} ...
    }
}

proc usage {} {
    global argv0
    set prog [file tail $argv0]
    puts "
	Use: $prog \[-k key\[,...]] \[-f] \[-m sss] \[-w ws_subst] FITSfile...
	Options:
	-k key1,key2,...	Optional list of keys to extract.
	               	Default keys are DATE-OBS,UTC,ELAPTIME,OBJECT
			All keys are converted to uppercase,and values are
			printed in the same order as input.
	-f		Do not print filename.
	-m sss		What to substitute for missing keys; def = \"\".
	-w ws_subst	What to substitute for runs of w/s; def = no subst.
"
}

##############################################################################
##############################################################################
##############################################################################

set descend 1	; # descend into directories?
if {[string compare [lindex $argv 0] "nodir"] == 0} {
    set descend 0
    set argv [lrange $argv 1 end]
}

set Keylist ""
set Missing ""
set PrintFilename 1
set WS_subst ""
set WS " \t"
set Use_WS_subst 0
for {set i 0; set n [llength $argv]} {$i < $n} {incr i} {
    set opt [lindex $argv $i]
    switch -glob -- $opt {
    -k {incr i;
	set Keylist {};
	foreach key [split [lindex $argv $i] ","] {
	    lappend Keylist [string toupper $key]
	}
	}
    -f {set PrintFilename 0}
    -m {incr i; set Missing [lindex $argv $i]}
    -w {incr i; set Use_WS_subst 1; set WS_subst [lindex $argv $i]}
    -h {usage ; exit 0}
    -* {puts stderr "Unknown option $opt" ; usage ; exit 1}
    default {break}
    }
}

set argv [lrange $argv $i end]

if {[llength $argv]} {
    foreach pat $argv {
	doFilePat $descend $pat
    }
} else {
    doFilePat 0 *
}