#!/usr/user2/toby/ps/tcl_logic
#!/usr/local/bin/tclsh
# script to query the ICDD database
#
# N.B. when accessed by the WWW server, this script is run by guest.other
# so the file protections must be set accordingly
set scriptdir [file dirname [info script]]

# fields on html form
set Fields  { Name Password mustbe maybe mustbepk1 mustbepk1delta \
	mustbepk2 mustbepk2delta units count_min count_max}
# shell environment variables
set envvars {SERVER_SOFTWARE SERVER_NAME GATEWAY_INTERFACE SERVER_PROTOCOL \
	SERVER_PORT REQUEST_METHOD PATH_INFO PATH_TRANSLATED SCRIPT_NAME \
	QUERY_STRING REMOTE_HOST REMOTE_ADDR REMOTE_USER AUTH_TYPE \
	CONTENT_TYPE CONTENT_LENGTH HTTP_ACCEPT}
# set maximum number of entries in a search
set localvars(maxhits) 10
# program that formats PDF2 entries
set localvars(pdf2filter) "$scriptdir/pdf2fmt"

# create a table of elements by number (in all uppercase)
set elements [string toupper {  {dummy element to fill element Num 0}
H  He Li Be B  C  N  O  F  Ne   Na Mg Al Si P  S  Cl Ar K  Ca 
Sc Ti V  Cr Mn Fe Co Ni Cu Zn   Ga Ge As Se Br Kr Rb Sr Y  Zr 
Nb Mo Tc Ru Rh Pd Ag Cd In Sn   Sb Te I  Xe Cs Ba La Ce Pr Nd 
Pm Sm Eu Gd Tb Dy Ho Er Tm Yb   Lu Hf Ta W  Re Os Ir Pt Au Hg 
Tl Pb Bi Po At Rn Fr Ra Ac Th   Pa U  Np Pu Am Cm Bk Cf Es Fm 
Md No Lr 1a 2a 3a 4a 5a 6a 7a   8a 1b 2b 3b 4b 5b 6b 7b 8b LN AD
}]
# returns the number corresponding to an element symbol or -1
proc elemno {elemname} { 
    global elements
    return [lsearch $elements [string toupper $elemname] ]
}

# validate the info from a submission return an error message or a null
#   string if there are no errors
proc validate {} { 
    global in
    # validate the password
    if {[catch "set in(Name)"] || [string match $in(Name) {}]} \
	    {return "Need valid name"}
    if {[catch "set in(Password)"] || [string match $in(Password) {}]} \
	    {return "Need valid password"}
    # process required elements
    if {![catch {set in(mustbe)}]} { 
	set line [split $in(mustbe) { ,+}]
	set in(required) {}
	foreach val $line {
	    if {$val != {}} {
		set elem [elemno $val]
		if {$elem < 1} {return "Invalid element symbol '$val'"}
		lappend in(required) $elem
	    }
	}
    }
    # process optional elements
    if {![catch {set in(maybe)}]} { 
	set line [split $in(maybe) { ,+}]
	set in(optional) {}
	foreach val $line {
	    if {$val != {}} {
		set elem [elemno $val]
		if {$elem < 1} {return "Invalid element symbol '$val'"}
		lappend in(optional) $elem
	    }
	}
    }
    # process each number in the peak and error lists
    if {![catch {set in(mustbepk1)}]} {
	if [catch {expr 1 + $in(mustbepk1)}] {
	    return "Invalid peak position '$in(mustbepk1)'"
	}
    }
    if {![catch {set in(mustbepk2)}]} {
	if [catch {expr 1 + $in(mustbepk2)}] {
	    return "Invalid peak position '$in(mustbepk2)'"
	}
    }
    if {![catch {set in(mustbepk1delta)}]} {
	if [catch {expr 1 + $in(mustbepk1delta)}] {
	    return "Invalid peak error '$in(mustbepk1delta)'"
	}
    }
    if {![catch {set in(mustbepk2delta)}]} {
	if [catch {expr 1 + $in(mustbepk2delta)}] {
	    return "Invalid peak error '$in(mustbepk2delta)'"
	}
    }
    if {![catch {set in(count_min)}]} {
	if [catch {expr 1 + $in(count_min)}] {
	    return "Invalid element count '$in(count_min)'"
	}
    } else {
	set in(count_min) {}
    } 
    if {![catch {set in(count_max)}]} {
	if {[string trim $in(count_max)] == ""} {
	    set in(count_max) $in(count_min)
	}
	if [catch {expr 1 + $in(count_max)}] {
	    return "Invalid element count '$in(count_max)'"
	}
    } else {
	set in(count_max) {}
	if {[string trim $in(count_min)] != ""} {
	    set in(count_max) $in(count_min)
	}
    } 
    return {}
}

# perform a search or look up an entry
# output to stdout appears in the html output and is displayed to user
proc do_search {} {
    global in localvars
    # pull in all entries
    loadsub -all
    # is there a specific PDF number requested?
    if ![catch {set in(RecNum)}] {
	# an entry was requested by number
	# get rid of any trailing characters (most likely a D for deleted)
	regexp {[0-9]*} $in(RecNum) icddnum
	puts "<H3>You requested entry $icddnum</H3>"
	# this will load one entry. It will be then displayed below
	findnumber -and -list $icddnum
    } else {
	# search based on chemistry and or peaks
	if [catch {set required $in(required)}] {set required {}}
	if [catch {set optional $in(optional)}] {set optional {}}
	if {$optional != "" && $required != ""} {
	    set comopts "-allof \{ $required \} -optional \{ $optional \}"
	} elseif {$optional == ""} {
	    set comopts "-allof \{ $required \} -alloptional"
	} elseif {$required == ""} {
	    # it is possible to search without required elements, but it
	    # always turns up the entries that have no known chemical formula
	    #	    element -allof {} -optional $optional -and
	    #           set comopts "-allof {} -optional \{$optional\}"
	    puts "At least one required element is needed for a search."
	    puts "Please add this to your search criteria and try again."
	    return
	}
	# do the element search -- if errors occur report them
	if [catch {eval element -and $comopts} errmsg ] {
	    puts "Error: unable to use the specified chemistry input"
	    puts "       $errmsg"
	    puts "Please check your search criteria and try again."
	    return
	}
	set elemrange {}
	catch {
	    for {set i $in(count_min)} {$i <=  $in(count_max)} {incr i} {
		if {$i >= 0 && $i <= 9} {
		    lappend elemrange $i
		}
	    }
	}
	if {$elemrange == {} && $in(count_min) != {} } {
	    puts "Error: unable to use the specified element count range"
	    puts "($in(count_min) to $in(count_max))."
	    puts "Please check your search criteria and try again."
	    return
	}
	if {$elemrange != {}} {
	    if [catch {elemcount -and -count $elemrange} errmsg ] {
		puts "Error: unable to use the specified element count range"
		puts "($in(count_min) to $in(count_max))"
		puts "<P>error:       $errmsg</P>"
		puts "Please check your search criteria and try again."
		return
	    }
	}
	#
	# prepare to search based on peak positions
	#
	set peaklist {}
	set errorlist {}
	catch {lappend peaklist $in(mustbepk1)}
	catch {lappend peaklist $in(mustbepk2)}
	catch {lappend errorlist $in(mustbepk1delta)}
	catch {lappend errorlist $in(mustbepk2delta)}
	# have peaks been supplied
	if {$peaklist != ""} {
	    # peak positions are d-spaces or 2theta's
	    set units ""
	    catch {if {$in(units) == "2theta"} {set units "-wave 1.5418"} }
	    if {$errorlist == ""} {set errorlist 0}
	    # do the peak search here
	    if [catch {eval findpeak -and -peak [list $peaklist] \
		    -error [list $errorlist] \
		    -all $units -fast -3strongest } errmsg] {
		puts "Error: unable to use the specified peak input"
		puts "       $errmsg"
		puts "Please check your search criteria and try again."
	    }
	}
	# report the results
	puts "<H3>Your search:</H3><UL>"
	foreach line [report -history] {puts "<LI>$line"}
	puts "</UL>"
	# if we have but one hit -- report it as a PDF2 entry
	if {[report -current] == 1} \
		{puts "<H3>One entry matches your search criteria.</H3>"}
    }
    
    # now process the list of hits or single entry
    set nhits [report -current] 
    # nothing to report
    if {$nhits == 0} {
	puts "<H3>No entries match your search criteria."
	puts "Please widen your search criteria and try again.</H3>"
    } elseif {$nhits > $localvars(maxhits)} {
	# too many
	puts "<H3>[report -current] entries match your search criteria."
	puts "You cannot retrieve more than $localvars(maxhits) entries in a"
	puts "search via from the World-Wide-Web."
	puts "Please narrow your search criteria and try again.</H3>"
	# plug the product
	puts "<P>You may wish to consider purchasing the ICDD-JCPDS database."
	puts "For further information contact the "
	puts {<A HREF = "http://www.icdd.com:7999/">}
	puts "International Centre for Diffraction Data</A>."
    } elseif {$nhits == 1} {  
	# one hit; print whole record using pdf2filter -- PRE is preformmated
	puts "<PRE>"
	set list [getpdf2 -seq [nexthit -first]]
	# d's or 2thetas?
	set units "d"
	catch {if {$in(units) == "2theta"} {set units "2 1.5418"} }
	# format the entry (|& catches errors)
	set fl [open "| $localvars(pdf2filter) $units |& cat " w+]
	# copy the AIDS record line by line and flush the I/O buffer
	foreach line $list {puts $fl $line}
	flush $fl
	# read back the formatted version
	while {[gets $fl line] >= 0} {puts $line}
	close $fl
	puts "</PRE>"
    } else { 
	puts "<H3>[report -current] entries match your search criteria.</H3>"
	# multiple hits; generate an HTML table
	puts -nonewline "<CENTER><TABLE BORDER CELLPADDING=10 CELLSPACING=2>"
	puts -nonewline "<TR ALIGN=center>"
	puts -nonewline "<TR><TH>No.</TH><TH>Chemical formula</TH>"
	puts "<TH>Chemical name</TH><TH>Mineral</TH><TH>Common name</TH></TR>"
	# loop over hits
	for {set i [nexthit -first]} {$i>=0} {set i [nexthit]} {
	    set recNo [getpdf1 -seq $i -entry] 
	    # create a button to pull up the PDF-2 entry -- nice!
	    puts -nonewline "<TR><TD><INPUT name=\"RecNum\" "
	    puts -nonewline "type=\"submit\" VALUE=\"$recNo\"></TD>"
	    # get remaining info and stick into the table
	    foreach item \
		    [getpdf1 -seq $i  -formula -chemname -mineral -common ] {
		if ![string compare $item ""] {set item --}
		puts -nonewline "<TD>$item</TD>"
	    }
	    # end the column
	    puts "</TR>"
	}
	# End the table
	puts "</TABLE></CENTER>\n"
    }
}

# start processing here
if ![catch {set env(CONTENT_LENGTH)}] { # this is not set when testing
    set input [read stdin $env(CONTENT_LENGTH)]
} else {
    # read input from stdin or use dummy input
    set input [read stdin]
    if {$input == ""} {
	set input  "Name=przemek&Password=dupa&mustbe=O,Mg&units=2theta"
    }
    set env(CONTENT_LENGTH) [string length $input]
}

# parse the cgi string
set message [split $input &]
foreach pair $message {
    set name [lindex [split $pair =] 0]
    set val [lindex [split $pair =] 1]
    regsub -all {\+} $val { } val
    # kludge to unescape chars
    regsub -all {\%0A} $val \n\t val
    regsub -all {\%2C} $val {,} val
    regsub -all {\%27} $val {'} val
    set val [string trim $val]
    if [string compare $val {}] {set in($name) $val}
}

# validate the input
if ![string match [set code [validate]] {}] {
    puts "<H3>Request rejected -- please update the form and re-submit</H3>"
    puts "Reason: $code"
} else {
    # save password and units from current input for next
    puts "<INPUT TYPE=\"HIDDEN\" NAME=\"Name\" VALUE=\"$in(Name)\">"
    puts "<INPUT TYPE=\"HIDDEN\" NAME=\"Password\" VALUE=\"$in(Password)\">"
    puts "<INPUT TYPE=\"HIDDEN\" NAME=\"units\" VALUE=\"$in(units)\">"

    # process the input
    do_search
}
