NCI Database CGI Script
#!/bin/sh
# This line makes the next one a comment in Tcl \
exec /usr/local/www/cgi-bin/csts -d -q -f $0
set WWWDIR_LOCAL /usr/local/www
set BASEDIR_LOCAL $WWWDIR_LOCAL/ncidb2
set ARCDIR_LOCAL $BASEDIR_LOCAL/archives
set DATABASEDIR_LOCAL $BASEDIR_LOCAL/data
set WWWTMPDIR_LOCAL $WWWDIR_LOCAL/tmp
set JSDIR_LOCAL $BASEDIR_LOCAL/js
set IMGDIR_WEB /ncidb2/images
set WWWCOUNTERDIR_LOCAL /usr/local/etc/Counter/data
set WWWTMPDIR_WEB /tmp
set CGIDIR /cgi-bin
set LOGDIR $WWWDIR_LOCAL/logs
set SERVERIP 131.188.127.222
set BASEURL http://$SERVERIP/ncidb2/
set TMPURL http://$SERVERIP/tmp/
set DBFILE $DATABASEDIR_LOCAL/nci2000.cbs
set DBSIZE 249679
set COOKIEDOMAIN $SERVERIP
set cactvs(filexpath) /usr/local/www/cgi-bin/cactvs/modules
#file delete /usr/local/www/tmp/nci.log
#set trace_fh [open /usr/local/www/tmp/nci.log w]
#cmdtrace on $trace_fh
proc check_file_online {} {
foreach f $::DBFILE {
if {![file readable $f]} {
printerror "Database file is offline"
}
}
}
proc set_button {fh b} {
if {!$::params(nomsg)} {
puts $fh "<SCRIPT Language=JavaScript>parent.selectButton(\"$b\");</SCRIPT>"
}
}
proc map_to_label eh {
if {![ens valid $eh A_MAPPING]} return
foreach m [ens get $eh A_MAPPING] {
set maps($m) 1
}
if {![info exists maps]} return
set n 1
set newlabels {}
foreach a [ens atoms $eh] {
set m [atom get $eh $a A_MAPPING]
if {[atom get $eh $a A_MAPPING]} {
lappend newlabels $m
} else {
while {[info exists maps($n)]} {
incr n
}
lappend newlabels $n
}
}
ens set $eh A_LABEL $newlabels
}
proc include_js {fh args} {
puts $fh "<SCRIPT LANGUAGE=JavaScript>"
foreach file $args {
set fhandle [open $::JSDIR_LOCAL/$file]
copyfile $fhandle $fh
close $fhandle
}
puts $fh "</SCRIPT>"
}
proc post_multipart {host path fieldvarname} {
set sep dsagdhkj14905258852582
set data ""
upvar $fieldvarname fields
foreach element [array names fields] {
set content $fields($element)
append data "--${sep}\r\n"
append data "Content-Disposition: form-data; name=\"$element\"\r\n\r\n"
append data "$content\r\n"
}
# append data "--${sep}--"
set fd [socket $host 80]
fconfigure $fd -translation binary
puts $fd "POST $path HTTP/1.1\r"
puts $fd "Host: $host\r"
puts $fd "Content-type: multipart/form-data; boundary=$sep\r"
puts $fd "Content-Length: [clength $data]\r"
puts $fd "User-Agent: CACTVS System $::cactvs(version)\r"
puts $fd "\r"
puts $fd $data
flush $fd
echo [read $fd]
close $fd
}
proc post_webbook {} {
set fields(MolFile) [molfile string [ens create CCO] eolchars "\r\n"]
set fields(StrSave) File
set fields(Type) Struct
set fields(cTG) ""
set fields(cIR) ""
set fields(cTC) ""
set fields(cMC) ""
set fields(cTP) ""
set fields(cUV) ""
set fields(cTR) ""
set fields(cES) ""
set fields(cIE) ""
set fields(cDI) ""
set fields(cIC) ""
set fields(cSO) ""
post_multipart webbook.nist.gov /cgi/cbook.cgi fields
}
proc sort_table {thandle mode} {
catch {
switch $mode {
nsc {
qtable sort $thandle ascending E_NSC
}
weight {
qtable sort $thandle ascending E_WEIGHT
}
complexity {
qtable sort $thandle ascending E_COMPLEXITY
}
natoms {
qtable sort $thandle ascending E_NATOMS
}
sim {
qtable sort $thandle descending cmpvalue
}
}
}
}
proc printerror {txt {iserror 1} {timeout 1}} {
puts "Pragma: no-cache\r"
puts "Content-type: text/html\r\n\r"
puts "<HTML><HEAD><TITLE>NCI Database Query Error</TITLE>"
if {$timeout} {
puts "<META HTTP-EQUIV=\"Refresh\" CONTENT=\"15; URL=$::BASEURL/status.html\">"
}
puts "<SCRIPT LANGUAGE=\"JavaScript\">"
if {$timeout} {
puts "function clearMessage() {
document.clear();
}
self.setTimeout(\"clearMessage();\",10000);"
}
puts "self.focus();
</SCRIPT>"
set rawtxt $txt
puts "</HEAD><BODY BGCOLOR=#FFFFFF>"
set txt "<H4>$txt</H4>"
if {$iserror} { set txt "<FONT COLOR=red>$txt</FONT>" }
puts $txt
if {$iserror} {
puts "<SCRIPT Language=JavaScript>alert(\"$rawtxt\");</SCRIPT>"
}
puts "</BODY></HTML>"
flush stdout
exit 0
}
proc verify_cas casno {
regsub -all {[- _%]+} $casno {} casno
if {![ctype digit $casno]} {
printerror "Illegal CAS number $casno."
}
set checkdigit [cindex $casno end]
set l [clength $casno]
set sum 0
loop i 0 $l-1 {
set c [cindex $casno $l-$i-2]
incr sum [expr $c*($i+1)]
}
if {$checkdigit!=$sum%10} {
printerror "Illegal CAS number $casno."
}
return $casno
}
proc verify_partial_formula {formula} {
global pse ghandle
regsub -all {[ ,]+} $formula {} formula
set formula_orig $formula
while {$formula!=""} {
if {+[A-Z][a-z]?[)]|[A-Z][a-z]?))([0-9]*)(-?)([0-9]*)} $formula all element dummy dummy from minus to]} {
printerror "Syntax error in formula $formula_orig."
}
set formula [crange $formula [clength $all] end]
if {$from=="" && $to==""} {
if {$minus!=""} {
set from 1
set to 999
} else {
set from 1
set to 1
}
} elseif {$from==""} {
set from 0
} elseif {$to==""} {
if {$minus!=""} {
set to 999
} else {
set to $from
}
}
if {$from>$to} {
printerror "Illegal range $from-$to in formula $formula_orig"
}
if {[cindex $element 0]=="("} {
set elist [split [string trim $element ()] +-]
foreach element $elist {
set elementok 0
foreach psedata $pse {
if {$element==[lindex $psedata 0]} {
set elementok 1
break
}
}
if {!$elementok} break
}
} else {
set elementok 0
foreach psedata $pse {
if {$element==[lindex $psedata 0]} {
set elementok 1
break
}
}
}
if {!$elementok} {
printerror "Illegal element $element in formula $formula_orig"
}
}
}
proc build_hitlist {thandle time} {
set tmpfile [tmpname hits $::WWWTMPDIR_LOCAL].html
set tmpurl $::TMPURL[file tail $tmpfile]
set fh [open $tmpfile w]
set nhits [qtable get $thandle nrows]
set rcdata {}
set matchbonds {}
set matchatoms {}
set simlist {}
set conflist {}
set newrecoffset -1
loop i 0 $nhits {
set rc [qtable celldata $thandle $i record]
set newrecoffset [expr max($newrecoffset,$rc)]
lappend rcdata $rc
if {$::params(sshighlight)} {
lappend matchbonds [qtable celldata $thandle $i highlightbonds]
lappend matchatoms [qtable celldata $thandle $i highlightatoms]
}
if {$::params(has_sim)} {
lappend simlist [qtable celldata $thandle $i cmpvalue]
}
lappend conflist [qtable celldata $thandle $i confid]
}
puts $fh "<HTML><HEAD>"
puts $fh "<META HTTP-EQUIV=\"Pragma\" CONTENT=\"No-Cache\">"
puts $fh "<TITLE>NCI Database Query Selector</TITLE>"
include_js $fh setfilename.js
puts $fh "</HEAD><BODY BGCOLOR=#FFFFFF>"
puts $fh "<TABLE CELLPADDING=1 WIDTH=100% BGCOLOR=#e0e0e0>"
puts $fh "<FORM ACTION=$::CGIDIR/nci2.tcl/nci_download.sdf TARGET=messages METHOD=POST NAME=download>"
puts $fh "<TR><TH COLSPAN=3 BGCOLOR=#b0b0b0>Operations with this Dataset of $nhits Structure[plural $nhits]:"
puts $fh "<TR><TH ALIGN=left>Data Retrieval:<TD BGCOLOR=#e0e0f0 VALIGN=top>"
puts $fh "Format:<SELECT NAME=output ONCHANGE=\"setDownloadFilename(0);\">"
puts $fh "<OPTION VALUE=cbin>CACTVS/Binary"
puts $fh "<OPTION VALUE=sdf SELECTED>SDFile"
puts $fh "<OPTION VALUE=smiles>SMILES"
puts $fh "<OPTION VALUE=tabtable>Tab-separated Table"
puts $fh "<OPTION VALUE=tabtable+>Tab-separated Table + Column Names"
puts $fh "<OPTION VALUE=diftable>DIF Spreadsheet Table"
puts $fh "<OPTION VALUE=sylktable>SYLK Spreadsheet Table"
puts $fh "<OPTION VALUE=cactvstable>CACTVS QSAR Table"
puts $fh "<OPTION VALUE=hitlist>Hitlist"
puts $fh "</SELECT>"
puts $fh "3D<INPUT TYPE=checkbox NAME=use3d VALUE=1>"
output_field_selector $fh
puts $fh "<INPUT TYPE=hidden NAME=op1 VALUE=record>"
puts $fh "<INPUT TYPE=hidden NAME=maxhits VALUE=$nhits>"
puts $fh "<INPUT TYPE=hidden NAME=sort VALUE=$::params(sort)>"
puts $fh "<INPUT TYPE=hidden NAME=data1 VALUE=\"$rcdata\">"
puts $fh "<INPUT TYPE=hidden NAME=highbondlist VALUE=\"$matchbonds\">"
puts $fh "<INPUT TYPE=hidden NAME=highatomlist VALUE=\"$matchatoms\">"
puts $fh "<INPUT TYPE=hidden NAME=simlist VALUE=\"$simlist\">"
puts $fh "<INPUT TYPE=hidden NAME=conflist VALUE=\"$conflist\">"
puts $fh "<TD BGCOLOR=#b0b0b0><INPUT TYPE=submit VALUE=\"Retrieve\">"
puts $fh "</FORM>"
puts $fh "<FORM ACTION=$::CGIDIR/nci2.tcl TARGET=messages METHOD=POST NAME=visualization>"
puts $fh "<TR><TH ALIGN=left>Visualization:"
puts $fh "<TD BGCOLOR=#e0e0f0><SELECT NAME=output ONCHANGE=\"submitForm(1,0);\">"
puts $fh "<OPTION VALUE=gifgallery>GIF Image Gallery"
puts $fh "<OPTION VALUE=chimegallery>MDL Chime Gallery/2D (need MDL plug-in)"
puts $fh "<OPTION VALUE=chimegallery3D>MDL Chime Gallery/3D (need MDL plug-in)"
puts $fh "<OPTION VALUE=covell>Covell Group Neural Network Mapping"
puts $fh "<OPTION VALUE=dtp>DTP Compound Ordering Form"
puts $fh "</SELECT>"
puts $fh "<INPUT TYPE=hidden NAME=op1 VALUE=record>"
puts $fh "<INPUT TYPE=hidden NAME=maxhits VALUE=$nhits>"
puts $fh "<INPUT TYPE=hidden NAME=passid VALUE=$::params(passid)>"
puts $fh "<INPUT TYPE=hidden NAME=namefrag VALUE=$::params(namefrag)>"
puts $fh "<INPUT TYPE=hidden NAME=sort VALUE=$::params(sort)>"
puts $fh "<INPUT TYPE=hidden NAME=data1 VALUE=\"$rcdata\">"
puts $fh "<INPUT TYPE=hidden NAME=highbondlist VALUE=\"$matchbonds\">"
puts $fh "<INPUT TYPE=hidden NAME=highatomlist VALUE=\"$matchatoms\">"
puts $fh "<INPUT TYPE=hidden NAME=simlist VALUE=\"$simlist\">"
puts $fh "<INPUT TYPE=hidden NAME=conflist VALUE=\"$conflist\">"
puts $fh "<TD BGCOLOR=#b0b0b0><INPUT TYPE=submit VALUE=\"Display\">"
puts $fh "</FORM>"
puts $fh "<FORM ACTION=$::CGIDIR/nci2.tcl TARGET=messages METHOD=POST ONSUBMIT=\"getUserID(2);\" NAME=misc>"
puts $fh "<TR><TH ALIGN=left>Miscellaneous:"
puts $fh "<INPUT TYPE=hidden NAME=tablefilename VALUE=\"[qtable get $thandle filename]\">"
puts $fh "<INPUT TYPE=hidden NAME=userid VALUE=$::params(userid)>"
puts $fh "<INPUT TYPE=hidden NAME=passwd VALUE=$::params(passwd)>"
puts $fh "<INPUT TYPE=hidden NAME=maxhits VALUE=$::params(maxhits)>"
puts $fh "<INPUT TYPE=hidden NAME=sort VALUE=$::params(sort)>"
puts $fh "<INPUT TYPE=hidden NAME=recoffset VALUE=$newrecoffset>"
puts $fh "<INPUT TYPE=hidden NAME=query VALUE=\"[encode -html $::params(query)]\">"
puts $fh "<INPUT TYPE=hidden NAME=namefrag VALUE=\"[encode -html $::params(namefrag)]\">"
puts $fh "<INPUT TYPE=hidden NAME=passid VALUE=\"[encode -html $::params(passid)]\">"
puts $fh "<INPUT TYPE=hidden NAME=has_sim VALUE=$::params(has_sim)>"
puts $fh "<INPUT TYPE=hidden NAME=has_ss VALUE=$::params(has_ss)>"
puts $fh "<INPUT TYPE=hidden NAME=sshighlight VALUE=$::params(sshighlight)>"
puts $fh "<INPUT TYPE=hidden NAME=op1 VALUE=nsc>"
puts $fh "<INPUT TYPE=hidden NAME=data1 VALUE=\"[qtable data $thandle all E_NSC]\">"
puts $fh "<TD BGCOLOR=#e0e0f0><SELECT NAME=output ONCHANGE=\"submitForm(2,1);\">"
if {!$::params(iseof)} {
if {$::params(output)=="table+" || \
$::params(output)=="next+" || \
$::params(output)=="restart+"} {
puts $fh "<OPTION VALUE=\"next+\" SELECTED>Retrieve Next Hits (record>$newrecoffset)"
} else {
puts $fh "<OPTION VALUE=\"next\" SELECTED>Retrieve Next Hits (record>$newrecoffset)"
}
}
if {$::params(output)=="table+" || \
$::params(output)=="next+" || \
$::params(output)=="restart+"} {
puts $fh "<OPTION VALUE=\"restart+\">Restart Query (at first record)"
} else {
puts $fh "<OPTION VALUE=\"restart\">Restart Query (at first record)"
}
puts $fh "<OPTION VALUE=refine_list>Refine Hitlist by Additional Query"
puts $fh "<OPTION VALUE=store_list>Store Hitlist on Server"
puts $fh "</SELECT>"
puts $fh "<TD BGCOLOR=#b0b0b0><INPUT TYPE=submit VALUE=\"Execute\">"
puts $fh "</FORM>"
puts $fh "</TABLE>"
if {$::params(output)=="table+" || \
$::params(output)=="next+" || \
$::params(output)=="restart+"} {
puts $fh "<TABLE WIDTH=100%><TR BGCOLOR=#c0c0c0>"
if {$nhits<=5} {
loop i 0 $nhits {
lappend idxlist $i
}
puts $fh "<TH COLSPAN=$nhits ALIGN=CENTER>Structure[plural $nhits]"
} else {
puts $fh "<TH COLSPAN=5 ALIGN=CENTER>Sample Structures"
set idxlist ""
random seed [clock seconds]
while {[llength $idxlist]<5} {
set idx [random $nhits]
if {![lcontain $idxlist $idx]} {
lappend idxlist $idx
}
}
set idxlist [lsort -integer $idxlist]
}
puts $fh "<TR BGCOLOR=#e0e0e0>"
set mf [molfile open $::DBFILE]
foreach i $idxlist {
set nsc [qtable celldata $thandle $i E_NSC]
set confid [qtable celldata $thandle $i confid]
if {[catch {qtable celldata $thandle $i highlightbonds} matchbonds]} {
set matchbonds ""
}
if {[catch {qtable celldata $thandle $i highlightatoms} matchatoms]} {
set matchatoms ""
}
set eh [molfile scan $mf "record = [qtable celldata $thandle $i record]" ens]
puts $fh "<TD ALIGN=CENTER><A HREF=$::CGIDIR/nci2.tcl?op1=nsc&data1=$nsc&output=detail&highbondlist=[urlencode $matchbonds]&highatomlist=[urlencode $matchatoms]&conflist=$confid&passid=[urlencode $::params(passid)] TARGET=messages>$nsc</A><BR>"
set giffile nci${nsc}x[pid].gif
prop setparam E_GIF width 110 height 110 \
filename $::WWWTMPDIR_LOCAL/$giffile \
atomcolor type asymbol box dashes 0 wedges 0 \
showradical 0
if {[catch {ens get $eh A_XY}]} {
set giffile ""
} elseif {[lcontain [ens propenv $eh A_XY flags] unreliable]} {
prop setparam E_GIF footer "(plot is ugly)"
}
if {$giffile!=""} {
prop setparam E_GIF highlightbonds $matchbonds
if {[catch {ens get $eh E_GIF}]} {
set giffile ""
}
}
if {$giffile!=""} {
puts $fh "<IMG SRC=\"/tmp/$giffile\">"
}
}
puts $fh "</TABLE>"
molfile close $mf
}
puts $fh "<FORM ACTION$::CGIDIR/nci2.tcl TARGET=messages METHOD=POST NAME=list>"
puts $fh "<TABLE CELLPADDING=1 BGCOLOR=#e0e0e0 WIDTH=100%>"
puts $fh "<TR BGCOLOR=#c0c0c0><TD>"
switch $::params(sort) {
none -
nsc {
set ncols 6
}
natoms {
puts $fh "<TH>#Atoms"
set ncols 7
}
weight {
puts $fh "<TH>Weight"
set ncols 7
}
complexity {
puts $fh "<TH>Complexity"
set ncols 7
}
sim {
puts $fh "<TH>Similarity"
set ncols 7
}
}
if {$::params(has_sim) && $::params(sort)!="sim"} {
puts $fh "<TH>Similarity"
incr ncols
}
puts $fh "<TH>NSC Number<TH>Formula<TH>CAS<TH>#Names<TH>Sample Name"
loop i 0 $nhits {
set names [qtable celldata $thandle $i E_NAMESET]
set nnames [llength $names]
set found 0
if {$::params(namefrag)!=""} {
foreach name $names {
if {[regexp -nocase -- "\\.?$::params(namefrag)\\.?" $name]} {
set found 1
regsub -nocase -all -- $::params(namefrag) $name "<B><FONT COLOR=red>&</FONT></B>" name
set name [format_name $name]
break
}
}
}
if {!$found} {
set name [format_name [select_name $names]]
}
if {$name==""} {
set name "<EM>No Name</EM>"
}
set cas [qtable celldata $thandle $i E_CAS]
if {$cas=="" || [cequal $cas 999-99-9]} {
set cas "<EM>(None)</EM>"
}
set formula [qtable celldata $thandle $i E_FORMULA]
regsub -all {[0-9]+} $formula "<SUB>&</SUB>" formula
set nsc [qtable celldata $thandle $i E_NSC]
set confid [qtable celldata $thandle $i confid]
if {[catch {qtable celldata $thandle $i highlightbonds} matchbonds]} {
set matchbonds ""
}
if {[catch {qtable celldata $thandle $i highlightatoms} matchatoms]} {
set matchatoms ""
}
if {$::params(sort)=="sim"} {
set sim [qtable celldata $thandle $i cmpvalue]
} else {
set sim ""
}
set buttonvalue [encode -html $nsc:$matchbonds:$matchatoms:$confid:$sim]
puts $fh "<TR><TD><INPUT TYPE=checkbox NAME=NSC$nsc VALUE=\"$buttonvalue\" CHECKED ONCLICK=\"updateSelection();\">"
switch $::params(sort) {
natoms {
puts $fh "<TD>[qtable celldata $thandle $i E_NATOMS]"
}
sim {
puts $fh "<TD>[qtable celldata $thandle $i cmpvalue]%"
}
weight {
puts $fh "<TD>[format %.2f [qtable celldata $thandle $i E_WEIGHT]]"
}
complexity {
puts $fh "<TD>[format %.2f [qtable celldata $thandle $i E_COMPLEXITY]]"
}
}
if {$::params(has_sim) && $::params(sort)!="sim"} {
puts $fh "<TD>[qtable celldata $thandle $i cmpvalue]%"
}
puts $fh "<TD><A HREF=$::CGIDIR/nci2.tcl?op1=nsc&data1=$nsc&output=detail&highbondlist=[urlencode $matchbonds]&highatomlist=[urlencode $matchatoms]&conflist=$confid&passid=[urlencode $::params(passid)] TARGET=messages>$nsc</A>"
puts $fh "<TD>$formula<TD>$cas<TD>$nnames<TD>$name"
}
puts $fh "<TR BGCOLOR=#c0c0c0><TD>"
puts $fh "<TD><INPUT TYPE=BUTTON VALUE=\"Invert Selection\" ONCLICK=\"invertSelection();\">"
puts $fh "<TD COLSPAN=[expr $ncols-1]>"
puts $fh "</TABLE>"
puts $fh "</FORM>"
set date [clock format [clock seconds] -format "%Y-%m-%d %H:%M:%S"]
puts $fh "<P> Date: $date"
puts $fh "</BODY></HTML>"
close $fh
set msg "Your query yielded $nhits hit[plural $nhits] after $time second[plural $time].<BR>Click to select specific hit and display it in table format. Deselect checkboxes to exclude hits from export."
send_load_msg $msg $tmpurl 2
exit 0
}
proc send_load_msg {msg url pageno {restore 0} {extrascript {}} {timeout 15}} {
# now prepare message file, which loads the result file
# via JavaScript
puts "Pragma: No-cache\r"
puts "Content-type: text/html\r\n\r"
if {$::params(nomsg)} {
regsub $::TMPURL $url $::WWWTMPDIR_LOCAL/ tmpfile
set fh [open $tmpfile]
copyfile $fh stdout
close $fh
return
}
puts "<HTML><HEAD>"
if {$timeout>0} {
puts "<META HTTP-EQUIV=\"Refresh\" CONTENT=\"$timeout; URL=$::BASEURL/status.html\">"
}
puts "<SCRIPT Language=JavaScript>"
puts $extrascript
switch -- $pageno {
-1 {
if {$restore} { puts "oldurl = parent.external_page;" }
if {$url!=""} {
puts "parent.external_page = \"$url\";"
}
}
1 {
if {$restore} { puts "oldurl = parent.form_page;" }
puts "parent.form_page = \"$url\";"
}
2 {
if {$restore} { puts "oldurl = parent.list_page;" }
puts "parent.list_page = \"$url\";"
}
3 {
if {$restore} { puts "oldurl = parent.detail_page;" }
puts "parent.detail_page = \"$url\";"
}
4 {
if {$restore} { puts "oldurl = parent.viz_page;" }
puts "parent.viz_page = \"$url\";"
}
5 {
if {$restore} { puts "oldurl = parent.manager_page;" }
puts "parent.manager_page = \"$url\";"
}
}
if {$url!=""} {
puts "parent.frames\[0\].switchPage($pageno);"
}
if {$restore} {
switch -- $pageno {
-1 {
puts "parent.external_page = oldurl;"
}
1 {
puts "parent.form_page = oldurl;"
}
2 {
puts "parent.list_page = oldurl;"
}
3 {
puts "parent.detail_page = oldurl;"
}
4 {
puts "parent.viz_page = oldurl;"
}
5 {
puts "parent.manager_page = oldurl;"
}
}
}
puts "</SCRIPT>"
puts "</HEAD><BODY BGCOLOR=#FFFFFF>"
puts $msg
puts "</BODY></HTML>"
}
proc output_field_selector {fh} {
puts $fh "Fields: "
puts $fh "<SELECT NAME=fields SIZE=3 MULTIPLE>"
puts $fh "<OPTION VALUE=E_NSC SELECTED>NSC Number"
puts $fh "<OPTION VALUE=E_WEIGHT>Molecular Weight"
puts $fh "<OPTION VALUE=E_NAME>Name (ACD)"
puts $fh "<OPTION VALUE=E_NAMESET>All Names"
puts $fh "<OPTION VALUE=E_COMPLEXITY>Complexity"
puts $fh "<OPTION VALUE=E_NHDONORS>H-Bond Donors"
puts $fh "<OPTION VALUE=E_NHACCEPTORS>H-Bond Acceptors"
puts $fh "<OPTION VALUE=E_NROTBONDS># Rotatable Bonds"
puts $fh "<OPTION VALUE=E_FORMULA>Formula"
puts $fh "<OPTION VALUE=E_CAS SELECTED>CAS Number"
puts $fh "<OPTION VALUE=E_SMILES SELECTED>SMILES String"
puts $fh "<OPTION VALUE=E_WLN>WLN String"
puts $fh "<OPTION VALUE=E_LOGP>KOW logP"
puts $fh "<OPTION VALUE=E_LOGP/2>Experimental logP"
puts $fh "<OPTION VALUE=E_LOGP/3>ACD logP"
puts $fh "<OPTION VALUE=E_DRUGLIKENESS>Drug Likeness (std)"
puts $fh "<OPTION VALUE=E_DRUGLIKENESS/2>Drug Likeness (neg)"
puts $fh "<OPTION VALUE=E_PASS_DATA_PA>All Activity PASS Predictions"
puts $fh "<OPTION VALUE=E_PASS_DATA_PI>All Inactivity PASS Predictions"
puts $fh "<OPTION VALUE=E_VIRAL_SCREENING>Anti-HIV Screening Result"
puts $fh "</SELECT>"
}
proc build_detail {thandle highbondlist simlist conflist time} {
set tmpfile [tmpname detail $::WWWTMPDIR_LOCAL].html
set tmpurl ${::TMPURL}[file tail $tmpfile]
set fh [open $tmpfile w]
set rc [qtable celldata $thandle 0 record]
if {[catch {molfile scan $::DBFILE {record = $rc}} ehandle]} {
printerror "Failed to retrieve structure from database"
}
set cas [qtable celldata $thandle 0 E_CAS]
if {$cas=="" || [cequal $cas 999-99-9]} {
set cas "<EM>(None)</EM>"
set hascas 0
} else {
set hascas 1
}
set nsc [qtable celldata $thandle 0 E_NSC]
set names [qtable celldata $thandle 0 E_NAMESET]
set nnames [llength $names]
if {$nnames} {
set name [select_name $names]
ens set $ehandle E_NAME $name
} else {
set name $nsc
}
set formula [ens get $ehandle E_FORMULA]
regsub -all {[0-9]+} $formula "<SUB>&</SUB>" formula
prop setparam E_SMILES unique 1 usestereo 0
set smiles [ens new $ehandle E_SMILES]
set giffile nci${nsc}x[pid].gif
prop setparam E_GIF width 250 height 250 \
filename $::WWWTMPDIR_LOCAL/$giffile dashes 0 wedges 0 \
atomcolor type \
showradical 0
if {[catch {ens get $ehandle A_XY}]} {
set giffile ""
} elseif {[lcontain [ens propenv $ehandle A_XY flags] unreliable]} {
prop setparam E_GIF footer "(plot is ugly)"
}
if {$giffile!=""} {
prop setparam E_GIF highlightbonds $highbondlist
if {[catch {ens get $ehandle E_GIF}]} {
set giffile ""
}
}
set ntumorscreening 0
set naidsscreening 0
set nscreening 0
foreach prop {E_TGI E_LC50 E_GI50 E_YEAST_SCREEN} {
if {[ens valid $ehandle $prop]} {
incr nscreening
incr ntumorscreening
}
}
foreach prop {E_EC50 E_IC50} {
if {[ens valid $ehandle $prop]} {
incr nscreening
incr naidsscreening
}
}
puts $fh "<HTML><HEAD>"
puts $fh "<TITLE>NCI Database Query Result Table</TITLE>"
include_js $fh transfer.js setfilename2.js
set_button $fh Detail
puts $fh "</HEAD>"
puts $fh "<BODY BGCOLOR=#FFFFFF>"
# puts $fh "<h2 align=center>NCI Database Query Result Table</h2><p>"
#--------------------
puts $fh "<TABLE CELLPADDING=1 WIDTH=100% BGCOLOR=#e0e0e0>"
puts $fh "<FORM ACTION=$::CGIDIR/nci2.tcl/nci_download$nsc.mol METHOD=GET TARGET=messages>"
puts $fh "<TR><TH COLSPAN=4 BGCOLOR=#b0b0b0>Operations with this Structure (NSC $nsc):"
puts $fh "<TR><TH ALIGN=left ROWSPAN=2>Structure Retrieval:"
puts $fh "<TD BGCOLOR=#e0e0f0 VALIGN=top>"
regsub -all {[ .]+} $name _ outfilename
regsub -all {[()\[\]]} $outfilename {} outfilename
regsub -all "_+" $outfilename _ outfilename
puts $fh "Format:<SELECT NAME=output ONCHANGE=\"setStructureFilename(0,$nsc,'$outfilename');\">"
puts $fh "<OPTION VALUE=alchemy>Alchemy"
puts $fh "<OPTION VALUE=cbin>Cactvs/Binary"
puts $fh "<OPTION VALUE=cerius>Cerius II Toolkit"
puts $fh "<OPTION VALUE=ctx>CTX"
puts $fh "<OPTION VALUE=cml>CML"
puts $fh "<OPTION VALUE=compass>Compass"
puts $fh "<OPTION VALUE=gaussin>Gaussian Input"
puts $fh "<OPTION VALUE=hyperchem>Hyperchem"
puts $fh "<OPTION VALUE=jcamp>JCAMP/CS"
puts $fh "<OPTION VALUE=sdf SELECTED>MDL Molfile"
puts $fh "<OPTION VALUE=molconnz>Molconn-Z"
puts $fh "<OPTION VALUE=pdb>PDB"
puts $fh "<OPTION VALUE=scf>SCF"
puts $fh "<OPTION VALUE=smd4>SMD 4"
puts $fh "<OPTION VALUE=smiles>SMILES"
puts $fh "<OPTION VALUE=sybyl2>Sybyl2 Molfile"
puts $fh "<OPTION VALUE=sln>Sybyl Line Notation"
puts $fh "<OPTION VALUE=vrml>VRML 2.0"
puts $fh "<OPTION VALUE=xtel>Xtelplot"
puts $fh "<OPTION VALUE=xyz>Rasmol XYZ"
puts $fh "<OPTION VALUE=car>CAR"
puts $fh "<OPTION VALUE=m3d>Webmolecules.com M3D"
# puts $fh "<OPTION VALUE=xfig>XFIG plot"
puts $fh "</SELECT><TD ROWSPAN=2 BGCOLOR=#e0e0f0>"
output_field_selector $fh
puts $fh "<TD BGCOLOR=#b0b0b0 ROWSPAN=2><INPUT TYPE=submit VALUE=\"Retrieve\">"
puts $fh "<TR BGCOLOR=#e0e0f0><TD>"
puts $fh "3D<INPUT TYPE=checkbox NAME=use3d VALUE=1>"
puts $fh " File Name: <EM>NSC</EM>"
puts $fh "<INPUT TYPE=radio NAME=outfilenametype VALUE=nsc SELECTED ONCLICK=\"setStructureFilename(0,$nsc,'$outfilename');\">"
puts $fh "<EM>Name</EM>"
puts $fh "<INPUT TYPE=radio NAME=outfilenametype VALUE=name ONCLICK=\"setStructureFilename(0,$nsc,'$outfilename');\">"
puts $fh "<INPUT TYPE=hidden NAME=op1 VALUE=nsc>"
puts $fh "<INPUT TYPE=hidden NAME=data1 VALUE=$nsc>"
puts $fh "<INPUT TYPE=hidden NAME=highbondlist VALUE=\"{$highbondlist}\">"
puts $fh "<INPUT TYPE=hidden NAME=simlist VALUE=\"{$simlist}\">"
puts $fh "<INPUT TYPE=hidden NAME=conflist VALUE=\"{$conflist}\">"
puts $fh "</FORM>"
if {$nscreening} {
puts $fh "<FORM ACTION=\"$::CGIDIR/nci2.tcl/nci_download$nsc.tab\" METHOD=GET TARGET=messages>"
puts $fh "<TR><TH align=left>Cell Screens:"
puts $fh "<TD COLSPAN=2 BGCOLOR=#e0e0f0>"
puts $fh "<SELECT NAME=output>"
foreach prop {E_GI50 E_TGI E_LC50 E_YEAST_SCREEN E_EC50 E_IC50} \
name {"GI<SUB>50</SUB> Screen" "TGI Screen" "LC<SUB>50</SUB> Screen" \
"Yeast Screen" \
"EC<SUB>50</SUB> Screen" "IC<SUB>50</SUB> Screen"} {
if {![ens valid $ehandle $prop]} continue
puts $fh "<OPTION VALUE=$prop>$name"
}
puts $fh "</SELECT>"
puts $fh " Format: "
puts $fh "<SELECT NAME=tablefmt ONCHANGE=\"setTableFilename(1,$nsc);\">"
puts $fh "<OPTION VALUE=html>HTML"
puts $fh "<OPTION VALUE=tabtable>Tab-separated Table"
puts $fh "<OPTION VALUE=tabtable+>Tab-separated Table + Column Names"
puts $fh "<OPTION VALUE=diftable>DIF Spreadsheet Table"
puts $fh "<OPTION VALUE=sylktable>SYLK Spreadsheet Table"
puts $fh "<OPTION VALUE=cactvstable>CACTVS QSAR Table"
puts $fh "</SELECT>"
puts $fh "<TD BGCOLOR=#b0b0b0><INPUT TYPE=submit VALUE=\"Retrieve\">"
puts $fh "<INPUT TYPE=hidden NAME=op1 VALUE=nsc>"
puts $fh "<INPUT TYPE=hidden NAME=data1 VALUE=$nsc>"
puts $fh "</FORM>"
}
puts $fh "<FORM ACTION=$::CGIDIR/nci2.tcl METHOD=GET TARGET=messages>"
puts $fh "<TR><TH align=left>Visualization:"
puts $fh "<TD COLSPAN=2 BGCOLOR=#e0e0f0>"
if {$nscreening} {
puts $fh "Format:<SELECT NAME=output ONCHANGE=\"submitForm(2);\">"
} else {
puts $fh "Format:<SELECT NAME=output ONCHANGE=\"submitForm(1);\">"
}
puts $fh "<OPTION SELECTED VALUE=javaviewer>3D Java Viewer"
puts $fh "<OPTION VALUE=vrmlviewer>VRML Scene (you need a VRML97 plug-in)"
puts $fh "<OPTION VALUE=vrmlmviewer>VRML Scene with Measurement (you need a VRML97 plug-in)"
puts $fh "<OPTION VALUE=chimeviewer>Chime Display/Current Conformer (you need the MDL plug-in)"
puts $fh "<OPTION VALUE=chimeviewer_conf>Chime Display/All Conformers (you need the MDL plug-in)"
puts $fh "<OPTION VALUE=pdbviewer>External PDB Viewer (you need a MIME handler for chemical/x-pdb)"
puts $fh "</SELECT>"
puts $fh "<INPUT TYPE=hidden NAME=use3d VALUE=1>"
puts $fh "<INPUT TYPE=hidden NAME=op1 VALUE=nsc>"
puts $fh "<INPUT TYPE=hidden NAME=data1 VALUE=$nsc>"
puts $fh "<INPUT TYPE=hidden NAME=highbondlist VALUE=\"{$highbondlist}\">"
puts $fh "<INPUT TYPE=hidden NAME=simlist VALUE=\"{$simlist}\">"
puts $fh "<INPUT TYPE=hidden NAME=conflist VALUE=\"{$conflist}\">"
puts $fh "<TD BGCOLOR=#b0b0b0><INPUT TYPE=submit VALUE=\"Display\">"
puts $fh "</FORM>"
puts $fh "<FORM ACTION=$::CGIDIR/nci2.tcl METHOD=GET TARGET=messages>"
puts $fh "<TR><TH align=left>External Services:"
puts $fh "<TD COLSPAN=2 BGCOLOR=#e0e0f0>"
if {$nscreening} {
puts $fh "Format:<SELECT NAME=output ONCHANGE=\"submitForm(3);\">"
} else {
puts $fh "Format:<SELECT NAME=output ONCHANGE=\"submitForm(2);\">"
}
puts $fh "<OPTION SELECTED VALUE=chemfinder>Cambridge Soft ChemFinder Search"
puts $fh "<OPTION VALUE=chemindustry>ChemIndustry Search"
puts $fh "<OPTION VALUE=nist>NIST WebBook Search"
# puts $fh "<OPTION VALUE=chemid>NLM ChemIDplus Search"
if {[ens valid $ehandle E_LIQCRYST_ID]} {
puts $fh "<OPTION VALUE=liqcryst>LIQCRYST Database Link (ID [ens get $ehandle E_LIQCRYST_ID])"
}
puts $fh "<OPTION VALUE=acd>ACD/Labs Physicochemical Property Computation"
puts $fh "<OPTION VALUE=telespec>TeleSpec Neural Network IR Prediction"
puts $fh "<OPTION VALUE=comspec3d>ComSpec3D IR/Raman Simulation and Normal Vibrations"
puts $fh "<OPTION VALUE=orbvis>Orbvis AM1 MO Computation and Visualization"
puts $fh "<OPTION VALUE=compare>DTP Compare Analysis"
puts $fh "<OPTION VALUE=petra>PETRA Physicochemical Data Computation"
if {$giffile!=""} {
puts $fh "<OPTION VALUE=gifgen>Custom GIF Image Generator"
}
puts $fh "<OPTION VALUE=vrmlgen>Custom VRML Scene Generator"
puts $fh "<OPTION VALUE=covell>Covell Group Neural Network Mapping"
puts $fh "<OPTION VALUE=dtp>DTP Compound Ordering Form"
if {$hascas} {
puts $fh "<OPTION VALUE=medline>Medline CAS Number Search"
}
if {[ens valid $ehandle E_NTP_LINK]} {
puts $fh "<OPTION VALUE=ntp>NTP Toxicology Database Link"
}
puts $fh "</SELECT>"
puts $fh "<INPUT TYPE=hidden NAME=op1 VALUE=nsc>"
puts $fh "<INPUT TYPE=hidden NAME=data1 VALUE=$nsc>"
puts $fh "<INPUT TYPE=hidden NAME=highbondlist VALUE=\"{$highbondlist}\">"
puts $fh "<INPUT TYPE=hidden NAME=simlist VALUE=\"{$simlist}\">"
puts $fh "<INPUT TYPE=hidden NAME=conflist VALUE=\"{$conflist}\">"
puts $fh "<TD BGCOLOR=#b0b0b0><INPUT TYPE=submit VALUE=\"Contact\">"
puts $fh "</FORM>"
puts $fh "</TABLE>"
#--------------------
puts $fh "<FORM>"
puts $fh "<TABLE CELLPADDING=1 BGCOLOR=#e0e0e0 WIDTH=100%>"
puts $fh "<TR><TH COLSPAN=5 BGCOLOR=#b0b0b0>Structure Data:<TR>"
if {$giffile==""} {
puts $fh "<TD COLSPAN=1 ROWSPAN=8 ALIGN=center><EM>(Too complex for plotting)</EM>"
} else {
puts $fh "<TD COLSPAN=1 ROWSPAN=8><IMG SRC=/tmp/$giffile width=250 height=250>"
}
puts $fh "<TH bgcolor=#c0c0c0>NSC Number:<TD>$nsc"
set date [clock format [clock seconds] -format "%Y-%m-%d %R"]
puts $fh "<TH bgcolor=#c0c0c0>Date:<TD>$date"
puts $fh "<TR><TH bgcolor=#c0c0c0>File Record:<TD>$rc"
puts $fh "<TH bgcolor=#c0c0c0>CAS Number:<TD>$cas"
puts $fh "<TR><TH bgcolor=#c0c0c0>Formula:<TD>$formula"
puts $fh "<TH bgcolor=#c0c0c0>Weight:<TD>[ens get $ehandle E_WEIGHT] gr/mol"
puts $fh "<TR><TH bgcolor=#c0c0c0>Complexity:<TD>[format %.1f [ens get $ehandle E_COMPLEXITY]]"
puts $fh "<TH bgcolor=#c0c0c0>Anti-HIV Screening:<TD>"
if {[ens props $ehandle E_VIRAL_SCREENING]!=""} {
switch [ens get $ehandle E_VIRAL_SCREENING] {
CA {
puts $fh "Confimed active"
}
CM {
puts $fh "Confimed moderately active"
}
CI {
puts $fh "Confimed inactive"
}
default {
puts $fh "Illegal data record"
}
}
} else {
puts $fh "<EM>No data available</EM>"
}
puts $fh "<TR><TH bgcolor=#c0c0c0>Druglikeness(std):<BR>"
puts $fh "Druglikeness(neg):<BR>"
puts $fh "WDI Record:"
puts $fh "<TD VALIGN=center>"
if {![ens valid $ehandle E_DRUGLIKENESS]} {
puts $fh "<EM>Not predicted</EM><BR>"
puts $fh "<EM>Not predicted</EM>"
} else {
switch -- [ens show $ehandle E_DRUGLIKENESS] {
N { puts $fh "No drug" }
D { puts $fh "<B>Is drug</B>" }
- { puts $fh "Not predicted" }
}
puts $fh "<BR>"
switch -- [ens show $ehandle E_DRUGLIKENESS/2] {
N { puts $fh "No drug" }
D { puts $fh "<B>Is drug</B>" }
- { puts $fh "Not predicted" }
}
}
if {[ens valid $ehandle E_VENDOR_IDS]} {
set vdata [ens get $ehandle E_VENDOR_IDS]
if {[prop compare E_VENDOR_IDS $vdata wdi bitset]!=-1} {
puts $fh "<BR><B>Yes</B>"
} else {
puts $fh "<BR>No"
}
} else {
puts $fh "<BR>No"
}
puts $fh "<TH bgcolor=#c0c0c0>logP(KOW):<BR>logP(exp):<BR>logP(ACD):<TD VALIGN=center>"
if {[ens valid $ehandle E_LOGP]} {
set val [lindex [ens show $ehandle E_LOGP] 0]
puts $fh "[format %.2f $val]<BR>"
} else {
puts $fh "<EM>No data</EM><BR>"
}
if {[ens valid $ehandle E_LOGP/2]} {
set val [lindex [ens show $ehandle E_LOGP/2] 0]
puts $fh "[format %.2f $val]<BR>"
} else {
puts $fh "<EM>No data</EM><BR>"
}
if {[ens valid $ehandle E_LOGP/3]} {
lassign [ens show $ehandle E_LOGP/3] val1 val2
set s [format "%.2f+/-%.2f" $val1 $val2]
puts $fh "$s"
} else {
puts $fh "<EM>No data</EM>"
}
puts $fh "<TR><TH bgcolor=#c0c0c0>H-Bond Acceptors:<BR>H-Bond Donors:<TD>"
puts $fh "[ens get $ehandle E_NHACCEPTORS]<BR>"
puts $fh "[ens get $ehandle E_NHDONORS]"
puts $fh "<TH bgcolor=#c0c0c0>Available on DTP Plates:<TD>"
if {[ens get $ehandle E_PLATED]} {
puts $fh "<B>Yes</B>"
} else {
puts $fh "No"
}
puts $fh "<TR><TH BGCOLOR=#c0c0c0># Rotatable Bonds: (CACTVS)"
puts $fh "<TD>[ens get $ehandle E_NROTBONDS]"
puts $fh "<TH BGCOLOR=#c0c0c0>WLN:<TD>"
if {[ens props $ehandle E_WLN]!=""} {
puts $fh [ens show $ehandle E_WLN]
} else {
puts $fh "<EM>No data</EM>"
}
puts $fh "<TR><TH bgcolor=#c0c0c0>Stereochemistry Potential<BR><EM>R/S atoms and E/Z bonds</EM><TD>"
if {[ens get $ehandle E_STEREO_POTENTIAL]} {
puts $fh "<B>Yes</B>"
} else {
puts $fh "No"
}
puts $fh "<TH bgcolor=#c0c0c0>Yeast Screen Level"
puts $fh "<TD>[ens get $ehandle E_YEAST_SCREENING_LEVEL]"
# ----------------- Transfer back to editor
puts $fh "<TR><TD ALIGN=center BGCOLOR=#b0b0b0>"
filex load jme
set jmestring [string trim [molfile string $ehandle format jme nitrostyle pentavalent]]
puts $fh "<INPUT TYPE=BUTTON VALUE=\"Transfer to Java Editor\" onClick=\"transfer('$jmestring');\">"
puts $fh "<TH BGCOLOR=#c0c0c0># Catalyst Conformers:<BR><EM>(0 if Catalyst could not handle structure)</EM><TD>[ens get $ehandle E_NCONFORMER]"
puts $fh "<TH BGCOLOR=#c0c0c0>Matched Conformer:<TD>"
if {$conflist==-1} {
puts $fh "<EM>None</EM>"
} else {
puts $fh [expr $conflist+1]
}
puts $fh "<TR><TH bgcolor=#c0c0c0>Composition:<TD COLSPAN=4>[ens get $ehandle E_COMPOSITION]"
puts $fh "<TR><TH bgcolor=#c0c0c0>SMILES:<TD COLSPAN=4>$smiles"
puts $fh "<TR><TH VALIGN=top bgcolor=#c0c0c0>Name[plural [llength $names]]:<TD COLSPAN=4>"
foreach name $names {
regsub -all {\(ACD/Name\)} $name "(ACD/Name 4.0)" name
puts $fh "[format_name $name]<BR>"
}
if {!$nnames} {
puts $fh "<EM>(No Name)</EM>"
}
puts $fh "<TR><TH bgcolor=#c0c0c0>Commercial Availability:<TD COLSPAN=4>"
if {![ens valid $ehandle E_VENDOR_IDS]} {
puts $fh "<EM>No</EM>"
} else {
set vendors [ens get $ehandle E_VENDOR_IDS]
set n 0
foreach v $vendors {
set v [string toupper [cindex $v 0]][crange $v 1 end]
if {$n} {
puts -nonewline $fh ", "
}
switch $v {
Acx { set v ACX }
Wdi { set v WDI }
Acd { set v ACD }
Csd { set v CSD }
}
puts -nonewline $fh $v
incr n
}
}
puts $fh "<TR><TH bgcolor=#c0c0c0>Commercial Database Keys:<TD COLSPAN=4>"
if {![ens valid $ehandle E_DATABASE_KEYS]} {
puts $fh "<EM>None</EM>"
} else {
set keys [ens get $ehandle E_DATABASE_KEYS]
set n 0
foreach v $keys {
if {$n} {
puts -nonewline $fh ", "
}
puts -nonewline $fh $v
incr n
}
}
puts $fh "<TR><TH bgcolor=#c0c0c0 VALIGN=TOP>Available Screening Data:<TD COLSPAN=4>"
if {$nscreening} {
set n 0
foreach prop {E_TGI E_LC50 E_GI50 E_YEAST_SCREEN E_EC50 E_IC50} {
if {[ens valid $ehandle $prop]} {
if {$n} { puts -nonewline $fh ", " }
switch $prop {
E_GI50 { puts -nonewline $fh "GI<SUB>50</SUB>" }
E_TGI { puts -nonewline $fh TGI }
E_LC50 { puts -nonewline $fh "LC<SUB>50</SUB>" }
E_YEAST_SCREEN { puts -nonewline $fh Yeast }
E_EC50 { puts -nonewline $fh "EC<SUB>50</SUB>" }
E_IC50 { puts -nonewline $fh "IC<SUB>50</SUB>" }
}
incr n
}
}
} else {
puts $fh "<EM>No screen data available</EM>"
}
puts $fh "<TR><TH bgcolor=#c0c0c0 VALIGN=TOP>Anti-HIV Screening:<TD COLSPAN=4>"
if {$naidsscreening} {
puts $fh "<B>Conclusion:</B><FONT color=red>"
switch [ens get $ehandle E_VIRAL_SCREENING] {
CA {
puts $fh "Confirmed Active"
}
CM {
puts $fh "Moderately Active"
}
CI {
puts $fh "Confirmed Inactive"
}
}
puts $fh "</FONT><P>"
loop i 1 999 {
set p E_IC50/$i
if {![ens valid $ehandle $p]} break
set conc [ens get $ehandle ${p}(concentration)]
set unit [string tolower [ens get $ehandle ${p}(concunit)]]
set flag [ens get $ehandle ${p}(flag)]
set icconc [ens get $ehandle ${p}(icconc)]
puts $fh "IC<SUB>50</SUB>(${conc}$unit) $flag $icconc<BR>"
}
loop i 1 999 {
set p E_EC50/$i
if {![ens valid $ehandle $p]} break
set conc [ens get $ehandle ${p}(concentration)]
set unit [string tolower [ens get $ehandle ${p}(concunit)]]
set flag [ens get $ehandle ${p}(flag)]
set ecconc [ens get $ehandle ${p}(ecconc)]
puts $fh "EC<SUB>50</SUB>(${conc}$unit) $flag $ecconc<BR>"
}
} else {
puts $fh "<EM>No data (EC<SUB>50</SUB>/IC<SUB>50</SUB>) available.</EM>"
}
puts $fh "<TR><TH bgcolor=#c0c0c0 VALIGN=TOP>Cancer Screening Summary:<TD COLSPAN=4>"
if {$ntumorscreening} {
set cells {}
foreach p {E_GI50 E_TGI E_LC50} {
loop i 1 999 {
if {![ens valid $ehandle $p/$i]} break
set cell [ens get $ehandle $p/${i}(cell)]
set conc [ens get $ehandle $p/${i}(lcconc)]
set unit [string tolower [ens get $ehandle $p/${i}(concunit)]]
set key [list $cell $conc $unit]
if {![lcontain $cells $key]} {
lappend cells $key
}
}
}
puts $fh "<PRE><B>Cell log(Concentration) -log(GI<SUB>50</SUB>) -log(TGI) -log(LC<SUB>50</SUB>)</B>"
set lasti(E_GI50) 0
set lasti(E_TGI) 0
set lasti(E_LC50) 0
foreach key $cells {
lassign $key cell conc unit
puts -nonewline $fh [format "%-16s %.2f%s" $cell $conc $unit]
foreach p {E_GI50 E_TGI E_LC50} {
set idx 0
loop i $lasti($p)+1 999 {
if {![ens valid $ehandle $p/$i]} break
set cell2 [ens get $ehandle $p/${i}(cell)]
set conc2 [ens get $ehandle $p/${i}(lcconc)]
set unit2 [string tolower [ens get $ehandle $p/${i}(concunit)]]
if {[cequal $cell $cell2] && \
[cequal $conc $conc2] && \
[cequal $unit $unit2]} {
set idx $i
set lasti($p) $i
break
}
}
switch $p {
E_GI50 {
if {$idx==0} {
set gi50 " (No data)"
} else {
set gi50 [format %12.3f [ens get $ehandle $p/${idx}(nlog_gi50)]]
}
}
E_TGI {
if {$idx==0} {
set tgi " (No data)"
} else {
set tgi [format %12.3f [ens get $ehandle $p/${idx}(nlog_tgi)]]
}
}
E_LC50 {
if {$idx==0} {
set lc50 " (No data)"
} else {
set lc50 [format %12.3f [ens get $ehandle $p/${idx}(nlog_lc50)]]
}
}
}
}
puts $fh [format "%s%s%s" $gi50 $tgi $lc50]
}
} else {
puts $fh "<EM>No data (GI<SUB>50</SUB>/TGI/LC<SUB>50</SUB>/Yeast) available.</EM>"
}
if 0 {
set ncellscreening 0
if {[ens props $ehandle E_GI50]!=""} {
incr ncellscreening
puts $fh "<TR><TH VALIGN=TOP bgcolor=#c0c0c0>GI50 Screening Results:<TD COLSPAN=4><PRE>"
puts $fh "<EM>ConcUnit LcConc Panel Cell Panel# Cell# -logGI50 #Tests/Line Max#Tests/Cpd</EM>"
foreach prop [ens props $ehandle E_GI50*] {
lassign [ens get $ehandle $prop] cu lc p c pn cn nlog tl mt
puts $fh [format "%8s %6s %5s %15s %6d %5d %8.3f %11d %13d" \
$cu $lc $p $c $pn $cn $nlog $tl $mt]
}
puts $fh "</PRE>"
}
if {[ens props $ehandle E_LC50]!=""} {
incr ncellscreening
puts $fh "<TR><TH VALIGN=TOP bgcolor=#c0c0c0>LC50 Screening Results:<TD COLSPAN=4><PRE>"
puts $fh "<EM>ConcUnit LcConc Panel Cell Panel# Cell# -logLC50 #Tests/Line Max#Tests/Cpd</EM>"
foreach prop [ens props $ehandle E_LC50*] {
lassign [ens get $ehandle $prop] cu lc p c pn cn nlog tl mt
puts $fh [format "%8s %6s %5s %15s %6d %5d %8.3f %11d %13d" \
$cu $lc $p $c $pn $cn $nlog $tl $mt]
}
puts $fh "</PRE>"
}
if {[ens props $ehandle E_TGI]!=""} {
incr ncellscreening
puts $fh "<TR><TH VALIGN=TOP bgcolor=#c0c0c0>TGI Screening Results:<TD COLSPAN=4><PRE>"
puts $fh "<EM>ConcUnit LcConc Panel Cell Panel# Cell# -logTGI #Tests/Line Max#Tests/Cpd</EM>"
foreach prop [ens props $ehandle E_TGI*] {
lassign [ens get $ehandle $prop] cu lc p c pn cn nlog tl mt
puts $fh [format "%8s %6s %5s %15s %6d %5d %7.3f %11d %13d" \
$cu $lc $p $c $pn $cn $nlog $tl $mt]
}
puts $fh "</PRE>"
}
if {!$ncellscreening} {
puts $fh "<TR><TH bgcolor=#c0c0c0>Cancer Cell Screening:<TD COLSPAN=4>"
puts $fh "<EM>No data (GI50/LC50/TGI) available</EM>"
}
}
puts $fh "<TR><TH bgcolor=#c0c0c0 VALIGN=top>PASS Predictions:"
if {[ens valid $ehandle E_PASS_DATA_PA]} {
set pa_data [ens show $ehandle E_PASS_DATA_PA]
set pi_data [ens show $ehandle E_PASS_DATA_PI]
set pnames [split [string trim [read_file $::BASEDIR_LOCAL/pass.txt]] "\n"]
set namelist {}
set idxlist {}
set passidx -1
regexp {([0-9]+)} $::params(passid) dummy passidx
foreach p $pnames {
lassign $p idx name
if {[lindex $pa_data $idx]>=0 ||
[lindex $pi_data $idx]>=0} {
if {$idx==$passidx} {
lappend namelist "<B>$name</B>"
} else {
lappend namelist $name
}
lappend idxlist $idx
}
}
puts $fh "<TD COLSPAN=2><PRE><B>Predicted Activity</B>"
foreach p $namelist {
puts $fh $p
}
puts $fh "</PRE><TD><PRE><B>p(active)</B>"
foreach i $idxlist {
set num [format %.3f [lindex $pa_data $i]]
if {$i==$passidx && [string match E_PASS_DATA_PA* $::params(passid)]} {
puts $fh "<B><FONT COLOR=red>$num</FONT></B>"
} else {
puts $fh $num
}
}
puts $fh "</PRE><TD><PRE><B>p(inactive)</B>"
foreach i $idxlist {
set num [format %.3f [lindex $pi_data $i]]
if {$i==$passidx && [string match E_PASS_DATA_PI* $::params(passid)]} {
puts $fh "<B><FONT COLOR=red>$num</FONT></B>"
} else {
puts $fh $num
}
}
puts $fh "</PRE>"
} else {
puts $fh "<TD COLSPAN=4><EM>No data available</EM>"
}
puts $fh "</TABLE></FORM><P>"
ens delete $ehandle
puts $fh " Enhanced NCI database browser V2 by <A HREF=\"mailto:wdi@ccc.chemie.uni-erlangen.de\">W. D. Ihlenfeldt</A>"
puts $fh "</BODY></HTML>"
close $fh
set msg "Your query yielded one hit after $time second[plural $time]."
send_load_msg $msg $tmpurl 3
exit 0
}
proc count_digits s {
set n 0
foreach c [split $s {}] {
if {[ctype digit $c]} {
incr n
}
}
return $n
}
proc format_name name {
regsub -all {~([0-9]+)~} $name {<SUP>\1</SUP>} name
regsub -nocase -all {\.alpha\.} $name "<IMG SRC=$::IMGDIR_WEB/alpha.gif WIDTH=14 HEIGHT=13>" name
regsub -nocase -all {\.?beta\.?} $name "<IMG SRC=$::IMGDIR_WEB/beta.gif WIDTH=11 HEIGHT=15>" name
regsub -nocase -all {\.?delta\.?} $name "<IMG SRC=$::IMGDIR_WEB/delta.gif WIDTH=12 HEIGHT=14>" name
regsub -nocase -all {\.?epsilon\.?} $name "<IMG SRC=$::IMGDIR_WEB/epsilon.gif WIDTH=11 HEIGHT=11>" name
regsub -nocase -all {\.?gamma\.?} $name "<IMG SRC=$::IMGDIR_WEB/gamma.gif WIDTH=11 HEIGHT=14>" name
regsub -nocase -all {\.?lambda\.?} $name "<IMG SRC=$::IMGDIR_WEB/lambda.gif WIDTH=13 HEIGHT=13>" name
regsub -nocase -all {\.?omega\.?} $name "<IMG SRC=$::IMGDIR_WEB/omega.gif WIDTH=14 HEIGHT=13>" name
return $name
}
proc select_name {names} {
set bestname ""
set bestlen 999
set bestndig 999
foreach name $names {
set name [string trim $name]
if {[regexp {ACD/Name} $name]} {
regsub {\(ACD/Name\)} $name "" name
return [string trim $name]
}
if {[crange $name 0 3]=="MIL-"} continue
if {[regexp {\([A-Z][A-Z]+\)$} $name]} continue
set ndig [count_digits $name]
set len [clength $name]
if {$len<=5} continue
if {$bestname=="" ||
$bestndig>$ndig ||
($bestndig==$ndig && $len<$bestlen)} {
set bestname $name
set bestlen [clength $bestname]
set bestndig [count_digits $bestname]
}
}
if {$bestname==""} {
return [lindex $names 0]
}
return $bestname
}
proc build_gallery {format thandle highbondlist highatomlist simlist conflist time} {
set mfin [molfile open $::DBFILE]
set tmpfile [tmpname hits $::WWWTMPDIR_LOCAL].html
set tmpurl ${::TMPURL}[file tail $tmpfile]
set fh [open $tmpfile w]
puts $fh "<HTML><HEAD>"
puts $fh "<META HTTP-EQUIV=\"Pragma\" CONTENT=\"no-cache\">"
puts $fh "<TITLE>NCI Database Query Image Gallery</TITLE>"
include_js $fh transfer.js
set_button $fh Display
puts $fh "</HEAD>"
puts $fh "<BODY BGCOLOR=#FFFFFF>"
# puts $fh "<H1 ALIGN=center>NCI Database Query Image Gallery</H1>"
puts $fh "<TABLE CELLPADDING=1 BGCOLOR=#e0e0e0 WIDTH=100%><TR BGCOLOR=#b0b0b0><TH>Image<TH COLSPAN=3>Basic Data"
set nrecs [qtable get $thandle nrows]
loop i 0 [min $nrecs 100] {
set highbonds [lindex $highbondlist $i]
set sim [lindex $simlist $i]
set rc [qtable celldata $thandle $i record]
set names [qtable celldata $thandle $i E_NAMESET]
set nsc [qtable celldata $thandle $i E_NSC]
set cas [qtable celldata $thandle $i E_CAS]
set confid [qtable celldata $thandle $i confid]
set formula [qtable celldata $thandle $i E_FORMULA]
if {$::params(sort)=="none" && ![info exists params($nsc)]} continue
molfile set $mfin record $rc
if {[catch {molfile read $mfin} ehandle]} {
printerror "Failed to retrieve structure NSC:$nsc from database: $ehandle"
}
set name [select_name $names]
if {$name==""} {set name "No Name"}
ens set $ehandle E_NAME $name
ens set $ehandle E_NSC $nsc
ens set $ehandle E_IDENT "NCI NSC $nsc"
ens set $ehandle E_AUTHOR "National Cancer Institute"
if {$cas=="" || [cequal $cas 999-99-9]} {
set cas "(None)"
set cas_html "<EM>$cas</EM>"
} else {
set cas_html $cas
}
ens set $ehandle E_CAS $cas
ens set $ehandle E_METADATA(rights) "Public Domain"
ens set $ehandle E_METADATA(source) "NCI database record NSC$nsc"
ens set $ehandle E_METADATA(publisher) "National Cancer Institute"
if {[info exists ::env(HTTP_REFERER)]} {
ens set $ehandle E_METADATA(creator) $::env(HTTP_REFERER)
}
set nrow 7
if {$sim!=""} { incr nrow }
if {$::params(sort)!="sim" && $::params(sort)!="none" && $::params(sort)!="nsc"} {
incr nrow
}
puts $fh "<TR><TD ALIGN=center ROWSPAN=$nrow>"
switch $format {
gifgallery {
set giffile nci${nsc}x[pid].gif
prop setparam E_GIF width 230 height 230 \
filename $::WWWTMPDIR_LOCAL/$giffile \
dashes 0 wedges 0 \
showradical 0
if {[catch {ens need $ehandle A_XY}]} {
puts $fh "<EM>Coordinate generation failed</EM>"
} else {
if {[lcontain [ens propenv $ehandle A_XY flags] unreliable]} {
prop setparam E_GIF footer "(plot is ugly)"
} else {
prop setparam E_GIF footer ""
}
prop setparam E_GIF highlightbonds $highbonds
if {[catch {ens need $ehandle E_GIF}]} {
puts $fh "<EM>Too complex for plot</EM>"
} else {
puts $fh "<IMG SRC=\"/tmp/$giffile\" WIDTH=230 HEIGHT=230>"
}
}
}
chimegallery {
set molfile nci${nsc}x[pid].mol
set mh [molfile open $::WWWTMPDIR_LOCAL/$molfile w format mdl hydrogens strip writeflags nostereo subformat 2D]
molfile write $mh $ehandle
molfile close $mh
puts $fh "<EMBED WIDTH=230 HEIGHT=230 FRANK=false FONTSIZE2D=11 HLABELS2D=ASDRAWN SRC=\"/tmp/$molfile\">"
}
chimegallery3D {
set molfile nci${nsc}x[pid].mol
set mh [molfile open $::WWWTMPDIR_LOCAL/$molfile w format mdl writeflags nostereo subformat 3D]
molfile write $mh $ehandle
molfile close $mh
set script [chime_bond_highlight_script $ehandle $highbonds]
puts $fh "<EMBED WIDTH=230 HEIGHT=230 DISPLAY3D=sticks FRANK=false SRC=\"/tmp/$molfile\" $script>"
}
default {
printerror "Illegal gallery format"
}
}
puts $fh "<TH>NSC:<TD><A HREF=$::CGIDIR/nci2.tcl?op1=nsc&data1=$nsc&output=detail&highbondlist=[urlencode $highbonds]&confid=$confid&passid=[urlencode $::params(passid)] TARGET=messages>$nsc</A>"
set jmestring [string trim [molfile string $ehandle format jme nitrostyle pentavalent]]
puts $fh "<TD ALIGN=right><FORM><INPUT type=button value=\"Transfer to Java Editor\" onClick=\"transfer('$jmestring');\"></FORM>"
regsub -all {[0-9]+} $formula "<SUB>&</SUB>" formula
if {$sim!=""} {
puts $fh "<TR><TH>Similarity:<TD COLSPAN=2>$sim%"
}
puts $fh "<TR><TH>Formula:<TD COLSPAN=2>$formula"
puts $fh "<TR><TH>CAS No:<TD COLSPAN=2>$cas_html"
switch $::params(sort) {
weight {
set val [format "%.2f gr/mol" [ens get $ehandle E_WEIGHT]]
puts $fh "<TR><TH>Weight:<TD COLSPAN=2>$val"
}
complexity {
set val [format "%.2f" [ens get $ehandle E_COMPLEXITY]]
puts $fh "<TR><TH>Complexity:<TD COLSPAN=2>$val"
}
natoms {
puts $fh "<TR><TH>#Atoms:<TD COLSPAN=2>[ens get $ehandle E_NATOMS]"
}
}
puts $fh "<TR><TH>Anti-HIV Screening:<TD COLSPAN=2>"
if {[ens valid $ehandle E_VIRAL_SCREENING]} {
switch [ens get $ehandle E_VIRAL_SCREENING] {
CA {
puts $fh "<FONT COLOR=red>Confirmed Active</FONT>: "
}
CM {
puts $fh "<FONT COLOR=red>Moderately Active</FONT>: "
}
CI {
puts $fh "<FONT COLOR=red>Confirmed Inactive</FONT>: "
}
}
} else {
puts $fh "<EM>(no data)</EM>"
}
set baseurl "<A HREF=\"$::CGIDIR/nci2.tcl?data1=$nsc&op1=nsc&tablefmt=html&window=detail&output="
set cnt 0
if {[ens valid $ehandle E_IC50]} {
puts -nonewline $fh "${baseurl}E_IC50\">IC<SUB>50</SUB> data</A>"
incr cnt
}
if {[ens valid $ehandle E_EC50]} {
if {$cnt} { puts -nonewline $fh "; " }
puts -nonewline $fh "${baseurl}E_EC50\">EC<SUB>50</SUB> data</A>"
incr cnt
}
puts $fh "<TR><TH>Cancer Cell Screening:<TD COLSPAN=2>"
set cnt 0
if {[ens valid $ehandle E_GI50] ||
[ens valid $ehandle E_LC50] ||
[ens valid $ehandle E_YEAST_SCREEN] ||
[ens valid $ehandle E_TGI]} {
if {[ens valid $ehandle E_GI50]} {
puts -nonewline $fh "${baseurl}E_GI50\">GI<SUB>50</SUB> data</A>"
incr cnt
}
if {[ens valid $ehandle E_TGI]} {
if {$cnt} { puts -nonewline $fh "; " }
puts -nonewline $fh "${baseurl}E_TGI\">TGI data</A>"
incr cnt
}
if {[ens valid $ehandle E_LC50]} {
if {$cnt} { puts -nonewline $fh "; " }
puts -nonewline $fh "${baseurl}E_LC50\">LC<SUB>50</SUB> data</A>"
incr cnt
}
if {[ens valid $ehandle E_YEAST_SCREEN]} {
if {$cnt} { puts -nonewline $fh "; " }
puts -nonewline $fh "${baseurl}E_YEAST_SCREEN\">Yeast screen data</A>"
incr cnt
}
} else {
puts $fh "<EM>(no data)</EM>"
}
puts $fh "<TR><TH>#Names:<TD COLSPAN=2>[llength $names]"
puts $fh "<TR><TH>Sample Name:<TD COLSPAN=2>$name"
ens delete $ehandle
}
puts $fh "</TABLE>"
set date [clock format [clock seconds] -format "%Y-%m-%d %H:%M:%S"]
puts $fh "<P> Date: $date"
puts $fh "<P> Enhanced NCI Database Browser V2 by <A HREF=\"mailto:wdi@ccc.chemie.uni-erlangen.de\">W. D. Ihlenfeldt</A>"
puts $fh "</BODY></HTML>"
molfile close $mfin
close $fh
set msg "Your query yielded $nrecs hit[plural $nrecs] after $time second[plural $time]."
send_load_msg $msg $tmpurl 4
exit 0
}
proc display_structure {fmt thandle highbondlist highatomlist conflist} {
set mfin [molfile open $::DBFILE]
set confid [lindex $conflist 0]
set highbonds [lindex $highbondlist 0]
set rc [qtable celldata $thandle 0 record]
set nsc [qtable celldata $thandle 0 E_NSC]
set names [qtable celldata $thandle 0 E_NAMESET]
molfile set $mfin record $rc
if {[catch {molfile read $mfin} ehandle]} {
printerror "Failed to retrieve structure from database"
}
molfile close $mfin
if {$confid!=-1} {
foreach a [ens atoms $ehandle] adata [ens show $ehandle A_CONFORMER] {
atom set $ehandle $a A_XYZ [lindex $adata $confid]
}
}
switch $fmt {
javaviewer {
set tmpfile [tmpname dsp $::WWWTMPDIR_LOCAL].html
set tmpurl ${::TMPURL}[file tail $tmpfile]
set fh [open $tmpfile w]
set pdbfile nci${nsc}x[pid].pdb
set fhandle [molfile open $::WWWTMPDIR_LOCAL/$pdbfile w format pdb]
molfile write $fhandle $ehandle
molfile close $fhandle
puts $fh "<HTML><HEAD><TITLE>Java 3D Viewer</TITLE>"
set_button $fh Display
puts $fh "</HEAD>"
puts $fh "<BODY BGCOLOR=white><DIV ALIGN=center>"
puts $fh "<TABLE CELLPADDING=1 WIDTH=100% BGCOLOR=#e0e0e0"
puts $fh "<TR><TH BGCOLOR=#b0b0b0>3D Structure Viewer for NSC $nsc"
set formula [ens get $ehandle E_FORMULA]
regsub -all {[0-9]+} $formula "<SUB>&</SUB>" formula
set name [select_name $names]
if {$name==""} {
puts $fh "<TR><TD ALIGN=center><B>$formula</B>"
} else {
puts $fh "<TR><TD ALIGN=center><B>[format_name $name]</B>"
}
puts $fh "<TR><TD ALIGN=center><A HREF=http://www.chemsymphony.com>ChemSymphony</A> Java Applet courtesy of <A HREF=http://www.cherwell.com>Cherwell Scientific Publishing</A>"
puts $fh "<TR><TD ALIGN=center>Coordinates generated by <A HREF=http://www2.ccc.uni-erlangen.de/software/corina/>CORINA</A> module. These are computed coordinates with arbitrary stereochemistry. The NCI database does neither contain crystal structures nor stereochemical descriptors."
puts $fh "<TR><TD ALIGN=center><APPLET codebase=/ncidb2/java/chemsymphony/ code=RenderBasic.class width=650 height=450 name=model>"
puts $fh "<PARAM name=model value=$::WWWTMPDIR_WEB/$pdbfile>"
puts $fh "</APPLET>"
puts $fh "<TR><TD ALIGN=center>Left mouse: Drag to rotate,"
puts $fh "shift-drag to zoom in/out, control-drag to move"
puts $fh "</TABLE></DIV></BODY></HTML>"
close $fh
}
vrmlviewer {
set tmpfile [tmpname dsp $::WWWTMPDIR_LOCAL].wrl
set tmpurl ${::TMPURL}[file tail $tmpfile]
prop setparam E_VRML filename $tmpfile
prop setparam E_VRML style all
prop setparam E_VRML highlightbonds $highbonds
if {[catch {ens get $ehandle E_VRML}]} {
printerror "Failed to write VRML file."
}
}
vrmlmviewer {
set tmpfile [tmpname dsp $::WWWTMPDIR_LOCAL].wrl
set tmpurl ${::TMPURL}[file tail $tmpfile]
prop setparam E_VRML filename $tmpfile
prop setparam E_VRML style all
prop setparam E_VRML geometry 1
prop setparam E_VRML highlightbonds $highbonds
if {[catch {ens get $ehandle E_VRML}]} {
printerror "Failed to write VRML file."
}
}
pdbviewer {
puts "Content-type: chemical/x-pdb\r\n\r"
set mf [molfile open stdout w format pdb]
molfile write $mf $ehandle
molfile close $mf
}
chimeviewer_conf {
set nconf [ens get $ehandle E_NCONFORMER]
if {$nconf==0} {
printerror "No conformation data for this compound."
}
set tmpfile [tmpname dsp $::WWWTMPDIR_LOCAL].html
set tmpurl ${::TMPURL}[file tail $tmpfile]
set fh [open $tmpfile w]
loop i 0 $nconf {
foreach a [ens atoms $ehandle] adata [ens show $ehandle A_CONFORMER] {
atom set $ehandle $a A_XYZ [lindex $adata $i]
}
set molfile nci${nsc}x[pid]x$i.mol
set fhandle [molfile open $::WWWTMPDIR_LOCAL/$molfile w]
molfile set $fhandle format mdl subformat 3D
molfile write $fhandle $ehandle
molfile close $fhandle
}
set tmpfile [tmpname dsp $::WWWTMPDIR_LOCAL].html
set tmpurl ${::TMPURL}[file tail $tmpfile]
set fh [open $tmpfile w]
puts $fh "<HTML><HEAD><TITLE>Chemscape Chime 3D Viewer</TITLE>"
set_button $fh Display
puts $fh "</HEAD>"
puts $fh "<BODY BGCOLOR=white><DIV ALIGN=center>"
puts $fh "<TABLE CELLPADDING=1 WIDTH=100% BGCOLOR=#e0e0e0"
puts $fh "<TR><TH COLSPAN=3 BGCOLOR=#b0b0b0>3D Structure Viewer for NSC $nsc"
set formula [ens get $ehandle E_FORMULA]
regsub -all {[0-9]+} $formula "<SUB>&</SUB>" formula
set name [select_name $names]
if {$name==""} {
puts $fh "<TR><TD COLSPAN=3 ALIGN=center><B>$formula</B>"
} else {
puts $fh "<TR><TD COLSPAN=3 ALIGN=center><B>[format_name $name]</B>"
}
puts $fh "<TR><TD COLSPAN=3 ALIGN=center>Coordinates generated by <A HREF=http://www.msi.com>MSI Catalyst</A>. These are computed coordinates with arbitrary stereochemistry. The NCI database does neither contain crystal structures nor stereochemical descriptors."
set nrows [expr ($nconf-1)/3+1]
loop row 0 $nrows {
puts $fh "<TR>"
loop col 0 3 {
if {$row*3+$col==$confid} {
puts $fh "<TD ALIGN=center BGCOLOR=#FFB0B0>"
} else {
puts $fh "<TD ALIGN=center>"
}
if {$row*3+$col>=$nconf} {
puts $fh " "
} else {
set molfile nci${nsc}x[pid]x[expr $row*3+$col].mol
puts $fh "<EMBED WIDTH=250 HEIGHT=250 SRC=\"$::WWWTMPDIR_WEB/$molfile\" FRANK=false DISPLAY3D=ball&stick></EMBED>"
}
}
}
puts $fh "<TR><TD COLSPAN=3 ALIGN=center>Left mouse: Drag to rotate,"
puts $fh "shift-drag to zoom in/out<BR>"
puts $fh "Right mouse: Control-drag to move, click for menu"
puts $fh "</TABLE></DIV></BODY></HTML>"
close $fh
}
chimeviewer {
set molfile nci${nsc}x[pid].mol
set fhandle [molfile open $::WWWTMPDIR_LOCAL/$molfile w]
molfile set $fhandle format mdl subformat 3D
molfile write $fhandle $ehandle
molfile close $fhandle
set tmpfile [tmpname dsp $::WWWTMPDIR_LOCAL].html
set tmpurl ${::TMPURL}[file tail $tmpfile]
set fh [open $tmpfile w]
puts $fh "<HTML><HEAD><TITLE>Chemscape Chime 3D Viewer</TITLE>"
set_button $fh Display
puts $fh "</HEAD>"
puts $fh "<BODY BGCOLOR=white><DIV ALIGN=center>"
puts $fh "<TABLE CELLPADDING=1 WIDTH=100% BGCOLOR=#e0e0e0"
puts $fh "<TR><TH BGCOLOR=#b0b0b0>3D Structure Viewer for NSC $nsc"
set formula [ens get $ehandle E_FORMULA]
regsub -all {[0-9]+} $formula "<SUB>&</SUB>" formula
set name [select_name $names]
if {$name==""} {
puts $fh "<TR><TD ALIGN=center><B>$formula</B>"
} else {
puts $fh "<TR><TD ALIGN=center><B>[format_name $name]</B>"
}
puts $fh "<TR><TD ALIGN=center>Coordinates generated by <A HREF=http://www2.ccc.uni-erlangen.de/software/corina/>CORINA</A> module. These are computed coordinates with arbitrary stereochemistry. The NCI database does neither contain crystal structures nor stereochemical descriptors."
set script [chime_bond_highlight_script $ehandle $highbonds]
puts $fh "<TR><TD ALIGN=center>"
puts $fh "<EMBED WIDTH=650 HEIGHT=450 SRC=\"$::WWWTMPDIR_WEB/$molfile\" FRANK=false DISPLAY3D=ball&stick $script></EMBED>"
puts $fh "<TR><TD ALIGN=center>Left mouse: Drag to rotate,"
puts $fh "shift-drag to zoom in/out<BR>"
puts $fh "Right mouse: Control-drag to move, click for menu"
puts $fh "</TABLE></DIV></BODY></HTML>"
close $fh
}
}
set msg "<H4>3D structure display for NSC $nsc.</H4>"
send_load_msg $msg $tmpurl 4
exit 0
}
proc chime_bond_highlight_script {ehandle blist} {
if {[lempty $blist]} {
return ""
}
set script "SCRIPT=\"{set bondmode and;"
foreach b $blist {
lassign [bond atoms $ehandle $b] a1 a2
append script "select atomno=$a1,atomno=$a2;"
append script "color bonds green;"
}
append script "}\"";
return $script
}
proc contact_acd ehandle {
set msg "Contacting ACD/Labs ILAB Server. <FONT COLOR=red>Works currently only on PC with Netscape browser!</FONT>"
set tmpfile [tmpname hits $::WWWTMPDIR_LOCAL].html
set tmpurl $::TMPURL[file tail $tmpfile]
set fh [open $tmpfile w]
puts $fh "<HTML><HEAD>"
puts $fh "<META HTTP-EQUIV=Pragma CONTENT=no-cache>"
include_js $fh acd.js
puts $fh "</HEAD><BODY BGCOLOR=white>"
puts $fh "<FORM NAME=smiOp ACTION=http://www2.acdlabs.com/ilab/perl/smiles.pl ENCTYPE=multipart/form-data METHOD=POST>"
puts $fh "<INPUT TYPE=hidden NAME=mode VALUE=smi2mol>"
puts $fh "<INPUT TYPE=hidden NAME=smilesStr VALUE=\"[ens get $ehandle E_SMILES]\">"
set m [molfile string $ehandle]
regsub -all "\n" $m "\\n" m
puts $fh "<INPUT TYPE=hidden NAME=mol VALUE=\"$m\">"
puts $fh "</FORM></BODY></HTML>"
close $fh
set script "
acdwinhandle = null;
acdurl = 'http://www2.acdlabs.com/ilab/perl/login3.pl?user_type=nositelicense&login_name=&login_password_&CALCULATE=LOGIN';
function waitForACDLogin() {
if (acdwinhandle.frames.length<5) {
setTimeout('waitForACDLogin()',5000);
return;
}
url = '$tmpurl';
heapframe = acdwinhandle.frames\[0\];
heapframe.completeOperation('none',url,false, '', 'main');
self.location.replace('/ncidb2/status.html');
}
acdwinhandle = open(acdurl,'acd');
waitForACDLogin();
"
send_load_msg $msg {} -1 0 $script 0
exit 0
}
proc contact_service {fmt thandle} {
set mfin [molfile open $::DBFILE]
set windowid 4
set rc [qtable celldata $thandle 0 record]
set cas [qtable celldata $thandle 0 E_CAS]
set nsc [qtable celldata $thandle 0 E_NSC]
if {$cas=="" || [cequal $cas 999-99-9]} {
set hascas 0
} else {
set hascas 1
}
molfile set $mfin record $rc
if {[catch {molfile read $mfin} ehandle]} {
printerror "Failed to retrieve structure from database"
}
molfile close $mfin
set smiles [ens get $ehandle E_SMILES]
switch $fmt {
covell {
set nsclist [join [qtable data $thandle all E_NSC]]
set tmpurl "http://www2.ccc.uni-erlangen.de/scripts/services/customize.tcl?url=http://spheroid.ncifcrf.gov/HTMLproject042300.html&Nsclist=[urlencode $nsclist]"
set msg "<H4>Calling Covell group neural network selection page.</H4>"
}
ntp {
set tmpurl [ens get $ehandle E_NTP_LINK]
set msg "<H4>Following NTP database link."
}
medline {
set msg "<H4>Performung Medline CAS number search</H4>."
set tmpurl http://www.ncbi.nlm.nih.gov/htbin-post/Entrez/query?db=m&form=4&term=${cas}%5BRN%5D
}
dtp {
set nsclist [join [qtable data $thandle all E_NSC]]
set tmpurl "http://www2.ccc.uni-erlangen.de/scripts/services/customize.tcl?url=http://dtp.nci.nih.gov/docs/misc/available_samples/dtp_indsamples.html&"
loop i 0 [min [llength $nsclist] 10] {
append tmpurl "&NSC[expr $i+1]=[lindex $nsclist $i]"
}
set msg "<H4>Calling DTP compound order form.</H4>"
}
gifgen {
set smiles [ens get $ehandle E_SMILES]
set tmpurl "http://www2.ccc.uni-erlangen.de/scripts/services/customize.tcl?url=http://www2.ccc.uni-erlangen.de/services/gifcreator/gif_main.html&smiles=[urlencode $smiles]"
set msg "<H4>Calling GIF generator with NSC$nsc.</H4>"
}
vrmlgen {
set smiles [ens get $ehandle E_SMILES]
set tmpurl "http://www2.ccc.uni-erlangen.de/scripts/services/customize.tcl?url=http://www2.ccc.uni-erlangen.de/services/vrmlcreator/vrml_main.html&smiles=[urlencode $smiles]"
set msg "<H4>Calling VRML generator with NSC$nsc.</H4>"
}
chemindustry {
set windowid -1
if {$hascas} {
set tmpurl "http://www2.ccc.uni-erlangen.de/scripts/services/customize.tcl?url=http://www.chemindustry.com/&by=[urlencode $cas]"
set msg "<H4>Calling ChemIndustry form with CAS $cas for NSC$nsc.</H4>"
} else {
set name [lindex [ens get $ehandle E_NAMESET] 0]
if {$name!=""} {
regsub { +\(ACD/Name.*} $name {} name
set tmpurl "http://www2.ccc.uni-erlangen.de/scripts/services/customize.tcl?url=http://www.chemindustry.com/&by=[urlencode $name]"
set msg "<H4>Calling ChemIndustry form with name $name for NSC$nsc.</H4>"
} else {
printerror "ChemIndustry search needs name or CAS number."
}
}
}
chemfinder {
set tmpfile [tmpname dsp $::WWWTMPDIR_LOCAL].html
set tmpurl ${::TMPURL}[file tail $tmpfile]
set fh [open $tmpfile w]
puts $fh "<HTML><HEAD><TITLE>Chemfinder Interface</TITLE>"
puts $fh "<SCRIPT Language=JavaScript>"
puts $fh "function autoSubmit() { document.form.submit(); }"
puts $fh "self.onload = autoSubmit;"
puts $fh "</SCRIPT></HEAD>"
puts $fh "<BODY BGCOLOR=white>"
puts $fh "<FORM NAME=form ACTION=\"http://chemfinder.camsoft.com/result.asp\" METHOD=post>"
if {$hascas} {
set msg "<H4>Initiating Chemfinder CAS number search.</H4>"
puts $fh "<INPUT TYPE=hidden NAME=polyQuery VALUE=\"$cas\">"
} else {
printerror "ChemFinder full-structure search is not yet implemented."
set msg "<H4>Initiating Chemfinder full-structure search.</H4>"
set smiles [ens get $ehandle E_SMILES]
puts $fh "<INPUT TYPE=hidden NAME=polyQuery VALUE=\"$smiles\">"
}
puts $fh "</FORM></BODY></HTML>"
close $fh
}
nist {
set windowid -1
if {$hascas} {
set tmpurl http://webbook.nist.gov/cgi/cbook.cgi?Units=SI&ID=$cas
set msg "<H4>Initiating NIST WebBook CAS Number search.</H4>"
} else {
printerror "NIST structure search ist not yet implemented"
}
}
chemid {
set tmpfile [tmpname dsp $::WWWTMPDIR_LOCAL].html
set tmpurl ${::TMPURL}[file tail $tmpfile]
set fh [open $tmpfile w]
puts $fh "<HTML><HEAD><TITLE>Chemfinder Interface</TITLE>"
puts $fh "<SCRIPT Language=JavaScript>"
puts $fh "function autoSubmit() { document.form.submit(); }"
puts $fh "self.onload = autoSubmit;"
puts $fh "</SCRIPT></HEAD>"
puts $fh "<BODY BGCOLOR=white>"
puts $fh "<FORM NAME=form ACTION=\"http://chem.sis.nlm.nih.gov/reults.html?NETSCAPE_LIVEWIRE_ID=2ABE3194CCE976AB835D8693A3D4CE7500184368\" METHOD=post>"
if {$hascas} {
puts $fh "<INPUT TYPE=hidden NAME=beginRec VALUE=1>"
puts $fh "<INPUT TYPE=hidden NAME=endRec VALUE=10>"
puts $fh "<INPUT TYPE=hidden NAME=outStruct VALUE=molstructure>"
puts $fh "<INPUT TYPE=hidden NAME=bNewSearch VALUE=true>"
puts $fh "<INPUT TYPE=hidden NAME=csFldLog_Alias1 VALUE=AND>"
puts $fh "<INPUT TYPE=hidden NAME=csFldLog_Alias2 VALUE=AND>"
puts $fh "<INPUT TYPE=hidden NAME=csFldAlias_Alias3 VALUE=\"TBL_SUPERLIST>TBL_NAME>MEMDATAUPR\">"
puts $fh "<INPUT TYPE=hidden NAME=csFldOp_Alias3 VALUE=\"=\">"
puts $fh "<INPUT TYPE=hidden NAME=csFld_Alias3 VALUE=\"\">"
puts $fh "<INPUT TYPE=hidden NAME=csFldAlias_Alias1 VALUE=\"molstructure\">"
puts $fh "<INPUT TYPE=hidden NAME=csFld_Alias1 VALUE=\"\">"
puts $fh "<INPUT TYPE=hidden NAME=csFldExOp_Alias1 VALUE=\"\">"
puts $fh "<INPUT TYPE=hidden NAME=OraCase VALUE=\"U\">"
puts $fh "<INPUT TYPE=hidden NAME=threed VALUE=\"off\">"
puts $fh "<INPUT TYPE=hidden NAME=csOra_Total VALUE=\"2\">"
puts $fh "<INPUT TYPE=hidden NAME=csFldAlias_Alias2 VALUE=\"TBL_SUPERLIST>TBL_NUMBER>MEMDATAUPR\">"
puts $fh "<INPUT TYPE=hidden NAME=csFldOp_Alias2 VALUE=\"-\">"
puts $fh "<INPUT TYPE=hidden NAME=csFld_Alias2 VALUE=\"$cas\">"
set msg "<H4>Initiating ChemIDplus CAS number search.</H4>"
} else {
printerror "ChemIDplus full-structure search is not yet implemented."
}
puts $fh "</FORM></BODY></HTML>"
close $fh
}
liqcryst {
set id [ens get $ehandle E_LIQCRYST_ID]
set tmpurl "http://liqcryst.chemie.uni-hamburg.de/cgi-bin/display.perl?$id"
set msg "<H4>Calling LIQCRYST database with NSC$nsc.</H4>"
}
orbvis {
filex load jme
set jmestring [string trim [molfile string $ehandle format jme nitrostyle pentavalent]]
set msg "<H4>Calling OrbVis form with NSC$nsc.</H4>"
set tmpurl "http://www2.ccc.uni-erlangen.de/scripts/services/customize.tcl?url=http://www2.ccc.uni-erlangen.de/services/orbital/index.html&jme=[urlencode $jmestring]"
# will break out of frame, use external frame
set windowid -1
}
petra {
set msg "<H4>Calling PETRA form with NSC$nsc</H4>"
set smiles [ens get $ehandle E_SMILES]
set tmpurl "http://www2.ccc.uni-erlangen.de/scripts/services/customize.tcl?url=http://www2.ccc.uni-erlangen.de/software/petra/access/smiles.phtml&smiles=[urlencode $smiles]"
}
compare {
set msg "<H4>Calling COMPARE form with NSC$nsc</H4>"
set tmpurl "http://www2.ccc.uni-erlangen.de/scripts/services/customize.tcl?url=http://dtp.nci.nih.gov/docs/cancer/searches/cancer_open_compounds.html&searchnsc=$nsc"
}
telespec {
set tmpfile [tmpname dsp $::WWWTMPDIR_LOCAL].html
set tmpurl ${::TMPURL}[file tail $tmpfile]
set fh [open $tmpfile w]
set msg "<H4>Invoking TeleSpec IR simulation</H4>"
set smiles [ens get $ehandle E_SMILES]
puts $fh "<HTML><HEAD><TITLE>TeleSpec Interface</TITLE>"
puts $fh "<SCRIPT Language=JavaScript>"
puts $fh "function autoSubmit() { document.form.submit(); }";
puts $fh "self.onload = autoSubmit;"
puts $fh "</SCRIPT></HEAD>"
puts $fh "<BODY BGCOLOR=white>"
puts $fh "<FORM NAME=form METHOD=post ACTION=\"http://www2.ccc.uni-erlangen.de/scripts/telespec/nci_sim.tcl\">"
puts $fh "<INPUT TYPE=HIDDEN NAME=smiles VALUE=\"$smiles\">"
puts $fh "<INPUT TYPE=HIDDEN NAME=password1 VALUE=nci[clock clicks]>"
puts $fh "<INPUT TYPE=HIDDEN NAME=resultname VALUE=nci[clock clicks]>"
puts $fh "<INPUT TYPE=HIDDEN NAME=email_adress VALUE=nci[clock clicks]>"
puts $fh "</FORM></BODY></HTML>"
close $fh
}
comspec3d {
set smiles [ens get $ehandle E_SMILES]
filex load jme
set jmestring [string trim [molfile string $ehandle format jme nitrostyle pentavalent]]
set tmpurl "http://www2.ccc.uni-erlangen.de/scripts/services/customize.tcl?url=http://www2.ccc.uni-erlangen.de/services/vrmlvib/vrmlvib_main.html&jme=[urlencode $jmestring]"
set msg "<H4>Calling IR/Raman service with NSC$nsc.</H4>"
# will break out of frame, use external frame
set windowid -1
}
acd {
contact_acd $ehandle
}
}
send_load_msg $msg $tmpurl $windowid
exit 0
}
proc output_table {format thandle sort fields} {
set mfin [molfile open $::DBFILE]
set th [qtable create]
foreach f $fields {
qtable addcol $th $f
}
qtable set $th eolchars "\r\n"
set nrecs [qtable get $thandle nrows]
loop i 0 $nrecs {
set rc [qtable celldata $thandle $i record]
molfile set $mfin record $rc
if {[catch {molfile read $mfin} ehandle]} {
printerror "Failed to retrieve structure NSC:$nsc from database"
}
set name [select_name [ens get $ehandle E_NAMESET]]
if {$name==""} {set name "No Name"}
ens set $ehandle E_NAME $name
qtable addens $th $ehandle ens
ens delete $ehandle
}
molfile close $mfin
puts "Content-type: application/save-to-disk\r\n\r"
switch $format {
tabtable+ {
qtable save $th stdout tabnames
}
tabtable {
qtable save $th stdout tab
}
diftable {
qtable save $th stdout dif
}
sylktable {
qtable save $th stdout sylk
}
cactvstable {
qtable save $th stdout tbin
}
}
exit 0
}
# export structure for writing onto disk
proc output_structure {format use3d thandle highbondlist highatomlist simlist conflist sort fields} {
set mfin [molfile open $::DBFILE]
if {![filex defined $format]} { filex load $format }
puts "Content-type: application/save-to-disk\r\n\r"
set mfhandle [molfile open stdout w format $format eolchars "\r\n"]
if {$use3d} {
molfile set $mfhandle subformat 3d
molfile set $mfhandle writeflags write3d
}
prop setparam E_SMILES unique 1
# set writelist [list E_NSC E_SMILES E_CAS]
set writelist {}
if {![lempty $fields]} {
set writelist [concat $writelist $fields]
}
molfile set $mfhandle writelist $writelist writeflags writename
set nrecs [qtable get $thandle nrows]
loop i 0 $nrecs {
set sim [lindex $simlist $i]
set highbonds [lindex $highbondlist $i]
set highatoms [lindex $highatomlist $i]
set confid [lindex $conflist $i]
set nsc [qtable celldata $thandle $i E_NSC]
set rc [qtable celldata $thandle $i record]
set names [qtable celldata $thandle $i E_NAMESET]
set cas [qtable celldata $thandle $i E_CAS]
molfile set $mfin record $rc
if {[catch {molfile read $mfin} ehandle]} {
printerror "Failed to retrieve structure NSC:$nsc from database"
}
ens zap $ehandle E_SMILES
set name [select_name $names]
if {$name==""} {set name "No Name"}
if {$format=="smiles"} {
ens set $ehandle E_NAME "NSC$nsc"
} else {
ens set $ehandle E_NAME $name
}
ens set $ehandle E_NSC $nsc
ens set $ehandle E_IDENT "NCI NSC $nsc"
ens set $ehandle E_AUTHOR "National Cancer Institute"
if {$cas=="" || [cequal $cas 999-99-9]} {
set cas "(None)"
set cas_html "<EM>$cas</EM>"
} else {
set cas_html $cas
}
ens set $ehandle E_CAS $cas
ens set $ehandle E_METADATA(rights) "Public Domain"
ens set $ehandle E_METADATA(source) "NCI database record NSC$nsc"
ens set $ehandle E_METADATA(publisher) "National Cancer Institute"
if {[info exists ::env(HTTP_REFERER)]} {
ens set $ehandle E_METADATA(creator) $::env(HTTP_REFERER)
}
foreach b $highbonds {
bond append $ehandle $b B_FLAGS highlight
}
foreach a $highatoms {
atom append $ehandle $a A_FLAGS highlight
}
if {range($confid,0,[ens get $ehandle E_NCONFORMER]-1)} {
foreach a [ens atoms $ehandle] adata [ens get $ehandle A_CONFORMER] {
atom set $ehandle $a A_XYZ [lindex $adata $confid]
}
}
if {[catch {molfile write $mfhandle $ehandle}]} {
printerror "Failed to write structure data"
}
ens delete $ehandle
incr nrecs
}
molfile close $mfin
exit 0
}
proc output_screen {thandle prop fmt} {
set rc [qtable celldata $thandle 0 record]
if {[catch {molfile scan $::DBFILE {record = $rc}} ehandle]} {
printerror "Failed to retrieve structure from database"
}
set th2 [qtable create]
qtable addcol $th2 $prop
loop i 1 999 {
if {![ens valid $ehandle $prop/$i]} break;
qtable addrow $th2 $prop/$i end [list [ens get $ehandle $prop/$i]]
}
qtable flatten $th2
foreach colname [qtable get $th2 colnames] {
regexp {\((.*)\)} $colname dummy newname
set newname [string toupper [cindex $newname 0]][crange $newname 1 end]
switch $newname {
Concunit { set newname Unit }
Lcconc { set newname Concentration }
Panel_number { set newname Panel# }
Cell_number { set newname Cellnumber }
Ntest_this { set newname #Tests }
Ntest_max { set newname #Tests/Max }
Nlog_gi50 { set newname \\-log(GI50) }
Nlog_tgi { set newname \\-log(TGI) }
Nlog_lc50 { set newname \\-log(LC50) }
Nexperiments { set newname #Experiments }
}
qtable setcol $th2 $colname format right
qtable setcol $th2 $colname name $newname
}
if {$fmt=="html"} {
set msg "<H4>Displaying table as HTML</H4>"
set tmpfile [tmpname table $::WWWTMPDIR_LOCAL].html
set tmpurl $::TMPURL[file tail $tmpfile]
set fh [open $tmpfile w]
puts $fh "<HTML><HEAD><META HTTP-EQUIV=\"Pragma\" CONTENT=\"no-cache\"></HEAD>"
puts $fh "<BODY BGCOLOR=#ffffff>"
qtable set $th2 bgcolor #e0e0e0 format {padding expand}
qtable save $th2 $fh html
puts $fh "</BODY></HTML>"
close $fh
if {[info exists ::params(window)] && $::params(window)=="detail"} {
set window 3
} else {
set window 4
}
send_load_msg $msg $tmpurl $window
} else {
puts "Content-type: application/save-to-disk\r\n\r"
switch $fmt {
tabtable+ {
qtable save $th2 stdout tabnames
}
tabtable {
qtable save $th2 stdout tab
}
diftable {
qtable save $th2 stdout dif
}
sylktable {
qtable save $th2 stdout sylk
}
cactvstable {
qtable save $th2 stdout tbin
}
}
}
exit 0
}
proc add_constraint {ehandle type atoms val} {
if {[regexp {^[0-9]+[.]?[0-9]*-[0-9]+[.]?[0-9]*$} $val]} {
scan $val "%f-%f" low high
if {$low<$high} {
set tmp $low
set low $high
set high $tmp
}
} elseif {[regexp {^-[0-9]+[.]?[0-9]*$} $val]} {
set low 0
set high [crange $val 1 end]"
} elseif {[regexp {^[0-9]+[.]?[0-9]*-$} $val]} {
scan $val %f low
set high 999999
} elseif {[regexp {^[0-9]+[.]?[0-9]*$} $val]} {
set low [expr $val-0.5]
set high [expr $val+0.5]
} else {
printerror "Illegal value range $val"
}
switch $type {
distance {
if {[llength $atoms]!=2} {
printerror "Illegal atom list $val in distance constraint $j in input field $i"
}
}
angle {
if {[llength $atoms]!=3} {
printerror "Illegal atom list $val in angle constraint $j in input field $i"
}
}
torsion {
if {[llength $atoms]!=4} {
printerror "Illegal atom list $val in torsion constraint $j in input field $i"
}
}
default {
printerror "Illegal constraint type $type"
}
}
if {[catch {group create $ehandle $atoms} gh]} {
printerror "Illegal atom labels {$atoms} in constraint"
}
if {[catch {group set $ehandle $gh G_CONSTRAINT [list $type [list $low $high]]}]} {
printerror "Failed to attach $type constraint"
}
}
proc normalize_params {data} {
global params
#set fh [open /usr/local/www/tmp/params.dat w]
#puts -nonewline $fh $data
#close $fh
uncgi $data params data4
loop i 1 5 {
if {![info exists params(data$i)]} {
set params(data$i) ""
} elseif {$i<4} {
set params(data$i) [string trim $params(data$i)]
}
if {![info exists params(method$i)]} {
set params(method$i) ""
} else {
set params(method$i) [string trim $params(method$i)]
}
if {![info exists params(extra$i)]} {
set params(extra$i) ""
} else {
set params(extra$i) [string trim $params(extra$i)]
}
if {![info exists params(neg$i)]} {
set params(neg$i) 0
}
}
foreach para {use3d ssoverlap ssnoaro maxhits output \
sshighlight sort highbondlist highatomlist \
simlist conflist tauto ssringmatch \
timeout fields recoffset query namefrag has_sim has_ss \
passid has_random userid passwd nomsg} \
defval {0 0 0 100 table 0 nsc {} {} {} {} 0 0 10 {} 0 {} {} 0 0 {} 0 {} {} 0} {
if {![info exists params($para)]} {
set params($para) $defval
}
}
if {[scan $params(maxhits) "%d" params(maxhits)]==1} {
set params(maxhits) [expr limit($params(maxhits),1,10000)]
} else {
set params(maxhits) 100
}
if {[scan $params(timeout) "%d" params(timeout)]==1} {
set params(timeout) [expr limit($params(timeout),5,300)]
} else {
set params(timeout) 300
}
}
proc analyze_range {data prop fieldno emsg {allownull 0}} {
set q {}
regsub -all , $data " " data
regsub -all {[ ]+} $data " " data
foreach spec [split $data " "] {
if {$allownull && $spec=="isnull"} {
lappend q "isnull $prop"
} elseif {$allownull && $spec=="notnull"} {
lappend q "notnull $prop"
} elseif {[regexp {^[0-9]+-[0-9]+$} $spec]} {
scan $spec "%u-%u" low high
if {$low>$high} {
set tmp $low
set low $high
set high $tmp
}
lappend q "and {$prop >= $low} {$prop <= $high}"
} elseif {[regexp {^-[0-9]+$} $spec]} {
lappend q "$prop <= [crange $spec 1 end]"
} elseif {[regexp {^[0-9]+-$} $spec]} {
scan $spec %u low
lappend q "$prop >= $low"
} elseif {[regexp {^[0-9]+$} $spec]} {
lappend q "$prop == $spec"
} else {
printerror [format "%s in input field %d" $emsg $fieldno]
}
}
return $q
}
proc check_repository_access {} {
if {$::params(userid)==""} {
if {[info exists ::env(HTTP_COOKIE)]} {
if {[regexp {.*=([^:]+):(.*)} $::env(HTTP_COOKIE) dummy id pw]} {
set ::params(userid) $id
set ::params(passwd) $pw
}
}
}
if {$::params(userid)==""} {
set url /ncidb2/register.html
set msg "<H4>Please register or log in before you use this feature.</H4>"
send_load_msg $msg $url 5 1
exit 0
}
set pw $::params(passwd)
set id $::params(userid)
set dir $::ARCDIR_LOCAL/$id
if {![file isdirectory $dir]} {
set msg "<H4>You repository does not exist any longer.</H4>"
set url /ncidb2/register.html
send_load_msg $msg $url 5 1
exit 0
}
set oldpw [string trim [read_file $dir/passwd]]
if {![passwd decode $oldpw $pw]} {
printerror "The password is incorrect."
}
}
proc retrieve_list {} {
check_repository_access
set id $::params(userid)
set dir $::ARCDIR_LOCAL/$id
if {$::params(table1)=="" && $::params(table2)==""} {
printerror "Please select a table for retrieval."
}
if {$::params(table1)!="" && $::params(table2)!=""} {
printerror "Please select exactly one table for retrieval."
}
if {$::params(table1)!=""} {
set tablefile $::params(table1)
} else {
set tablefile $::params(table2)
}
if {[catch {qtable read $tablefile} thandle]} {
printerror "Failed to read table file."
}
check_file_online
array set ::params [qtable get $thandle T_QUERY(parameters)]
build_hitlist $thandle 0
}
proc annotate_list {} {
check_repository_access
set id $::params(userid)
set pw $::params(passwd)
if {$::params(table1)=="" && $::params(table2)==""} {
printerror "Please select a table for annotation."
}
if {$::params(table1)!="" && $::params(table2)!=""} {
printerror "Please select exactly one table for annotation."
}
if {$::params(table1)!=""} {
set tablefile $::params(table1)
} else {
set tablefile $::params(table2)
}
if {[catch {qtable read $tablefile} thandle]} {
printerror "Failed to read table file."
}
qtable set $thandle T_QUERY(comment) $::params(annotation)
file delete $tablefile
qtable save $thandle $tablefile tbin
set url "$::CGIDIR/nci2.tcl?output=list_archives&userid=$id&passwd=$pw"
set msg "<H4>Table annotated.</H4>"
send_load_msg $msg $url 5
exit 0
}
proc delete_list {} {
check_repository_access
set id $::params(userid)
set pw $::params(passwd)
if {$::params(table1)=="" && $::params(table2)==""} {
printerror "Please select a table for deletion."
}
if {$::params(table1)!=""} {
file delete $::params(table1)
}
if {$::params(table2)!=""} {
file delete $::params(table2)
}
set url "$::CGIDIR/nci2.tcl?output=list_archives&userid=$id&passwd=$pw"
set msg "<H4>Query deletion successful.</H4>"
send_load_msg $msg $url 5
exit 0
}
proc list_operation mode {
check_repository_access
set id $::params(userid)
if {$::params(table1)=="" || $::params(table2)==""} {
printerror "Please select two tables for the operation."
}
if {[cequal $::params(table1) $::params(table2)]} {
printerror "Please select two different tables for the operation."
}
if {[catch {qtable read $::params(table1)} th1]} {
printerror "Failed to read first table."
}
if {[catch {qtable read $::params(table2)} th2]} {
printerror "Failed to read second table."
}
if {[catch {qtable merge $th1 $th2 $mode union}]} {
printerror "Failed to $mode the tables."
}
if {[qtable get $th1 nrows]==0} {
printerror "Table operation yielded empty set" 0
}
check_file_online
array set ::params [qtable get $th1 T_QUERY(parameters)]
build_hitlist $th1 0
}
proc list_archives {} {
check_repository_access
set id $::params(userid)
set pw $::params(passwd)
set dir $::ARCDIR_LOCAL/$id
set cookie "nciuser=$id:$pw; path=/; domain=$::COOKIEDOMAIN; expires=Fri, 31-Dec-2005 00:00:00 GMT"
puts "Pragma: no-cache\r"
puts "Set-Cookie: $cookie\r"
puts "Content-type: text/html\r\n\r"
set files [glob -nocomplain $dir/*.tbin]
set nfiles [llength $files]
puts "<HTML><HEAD><TITLE>Repository listing for user $id</TITLE>"
include_js stdout setlistmode.js
set filedata {}
foreach file $files {
if {[catch {qtable read $file} thandle]} {
incr nfiles -1
continue
}
set s [qtable get $thandle nrows]
set q [qtable get $thandle T_QUERY(query)]
set a [qtable get $thandle T_QUERY(comment)]
set m [file mtime $file]
if {$a=="NULL"} { set a "" }
qtable destroy $thandle
lappend filedata [list $file $m $s $q $a]
}
# sort according to date
set filedata [lsort -integer -index 1 $filedata]
puts "<SCRIPT Language=JavaScript>"
if {$nfiles} {
puts "var ANNOTATIONS = new Array($nfiles);"
set i 0
foreach item $filedata {
puts "ANNOTATIONS\[$i\] = \"[lindex $item 4]\";"
incr i
}
}
puts "parent.userid = '$id';"
puts "parent.passwd = '$pw';"
puts "</SCRIPT>"
puts "<BODY BGCOLOR=#ffffff>"
puts "<H4>Repository listing for user <EM>$id</EM></H4>"
puts "<FORM ACTION=$::CGIDIR/nci2.tcl METHOD=POST TARGET=messages>"
puts "<TABLE CELLPADDING=1 WIDTH=100% BGCOLOR=#e0e0e0>"
if {$nfiles==0} {
puts "<TR><TD COLSPAN=5>No stored queries."
} else {
puts "<TR><TD COLSPAN=5 ALIGN=LEFT BGCOLOR=#e0e0f0 VALIGN=TOP><B>Annotation:<B> <TEXTAREA COLS=80 ROWS=5 NAME=annotation></TEXTAREA>"
puts "<TR><TH>Selection 1<TH>Selection 2<TH>Date<TH>Size<TH>Query"
set i 0
foreach item $filedata {
puts "<TR>"
set file [lindex $item 0]
puts "<TD><INPUT TYPE=RADIO NAME=sel1 ONCLICK=\"setTable(1,'$file',$i);\">"
puts "<TD><INPUT TYPE=RADIO NAME=sel2 ONCLICK=\"setTable(2,'$file',$i);\">"
puts "<TD>[clock format [lindex $item 1] -format "%Y-%m-%d %T"]"
puts "<TD>[lindex $item 2]"
puts "<TD>[encode -html [lindex $item 3]]"
incr i
}
}
puts "<INPUT TYPE=HIDDEN NAME=output VALUE=\"\">"
puts "<INPUT TYPE=HIDDEN NAME=table1 VALUE=\"\">"
puts "<INPUT TYPE=HIDDEN NAME=table2 VALUE=\"\">"
puts "<INPUT TYPE=HIDDEN NAME=userid VALUE=\"$id\">"
puts "<INPUT TYPE=HIDDEN NAME=passwd VALUE=\"$pw\">"
puts "<TR BGCOLOR=#b0b0b0><TD COLSPAN=5 ALIGN=LEFT>"
if {$nfiles} {
puts "<INPUT TYPE=SUBMIT VALUE=\"Retrieve\" ONCLICK=\"setListMode('retrieve_list');\">"
puts "<INPUT TYPE=SUBMIT VALUE=\"Annotate\" ONCLICK=\"setListMode('annotate_list');\">"
puts "<INPUT TYPE=SUBMIT VALUE=\"Delete\" ONCLICK=\"setListMode('delete_list');\">"
if {$nfiles>1} {
puts "<INPUT TYPE=SUBMIT VALUE=\"Union\" ONCLICK=\"setListMode('union_list');\">"
puts "<INPUT TYPE=SUBMIT VALUE=\"Intersect\" ONCLICK=\"setListMode('intersect_list');\">"
puts "<INPUT TYPE=SUBMIT VALUE=\"Subtract\" ONCLICK=\"setListMode('subtract_list');\">"
}
}
puts "<INPUT TYPE=SUBMIT VALUE=\"Reload\" ONCLICK=\"setListMode('reload_archives');\">"
if {$nfiles} {
puts "<INPUT TYPE=RESET VALUE=\"Reset Form\" ONCLICK=\"resetForm();\">"
}
puts "<INPUT TYPE=SUBMIT VALUE=\"Change Login\" ONCLICK=\"setListMode('newlogin_archives');\">"
puts "</TABLE></FORM>"
puts "</BODY></HTML>"
exit 0
}
proc store_hitlist {} {
if {$::params(userid)==""} {
set msg "<H4>You must first log in in order to use this function.</H4>"
set url /ncidb2/register.html
send_load_msg $msg $url 5 1
}
check_repository_access
set id $::params(userid)
set pw $::params(passwd)
set dir $::ARCDIR_LOCAL/$id
if {![file readable $::params(tablefilename)]} {
printerror "Cannot read result table file."
}
file copy $::params(tablefilename) $dir
set msg "<H4>Query result stored in data repository.</H4>"
set url "$::CGIDIR/nci2.tcl?output=list_archives&userid=$id&passwd=$pw"
send_load_msg $msg $url 5
exit 0
}
proc refine_list {nsclist} {
set msg "<H4>Refine hitlist. Do not edit first query field settings.</H4>"
set tmpurl $::BASEURL/form.html
set script "parent.queryformdata\[\"op1\"\] = 0;\n"
append script "parent.queryformdata\[\"data1\"\] = \"$nsclist\";"
send_load_msg $msg $tmpurl 1 0 $script
exit 0
}
proc delete_archives {} {
check_repository_access
if {$::params(passwd2)==""} {
printerror "Please fill both password fields for this opertation."
}
if {![cequal $::params(passwd) $::params(passwd2)]} {
printerror "Passwords are not identical."
}
set id $::params(userid)
set dir $::ARCDIR_LOCAL/$id
file delete -force $dir
set msg "Account was deleted successfully."
set url /ncidb2/register.html
send_load_msg $msg $url 5 1
exit 0
}
proc login_archives {} {
set pw1 $::params(passwd)
set pw2 $::params(passwd2)
set id $::params(userid)
if {$id==""} {
printerror "Please specify a user id."
}
set dir $::ARCDIR_LOCAL/$id
if {[file isdirectory $dir]} {
if {$pw1==""} {
printerror "Please specify your password."
}
set oldpw [string trim [read_file $dir/passwd]]
if {![passwd decode $oldpw $pw1]} {
printerror "The password is incorrect."
}
set url "$::CGIDIR/nci2.tcl?output=list_archives&userid=$id&passwd=$pw1"
set msg "<H4>Welcome to your data warehouse</H4>"
send_load_msg $msg $url 5
} else {
if {![regexp {^[A-Za-z0-9]+$} $id]} {
printerror "The user id contain illegal characters."
}
if {[clength $id]<3} {
printerror "Please use a user id of at least 3 characters length."
}
if {$pw1=="" || $pw2==""} {
printerror "Please specify your new password in both password fields."
}
if {[clength $pw1]<3} {
printerror "Please use a password of at least 3 characters length."
}
if {![cequal $pw1 $pw2]} {
printerror "The passwords do not match."
}
if {![regexp {^[A-Za-z0-9]+$} $pw1]} {
printerror "Your password contain illegal characters."
}
if {[catch {file mkdir $dir}]} {
printerror "Failed to create user repository directory."
}
set fh [open $dir/passwd w]
puts $fh [passwd encode $pw1]
close $fh
file copy $::BASEDIR_LOCAL/blank.html $dir/index.html
set url "$::CGIDIR/nci2.tcl?output=list_archives&userid=$id&passwd=$pw1"
set msg "<H4>Welcome to your new data warehouse</H4>"
send_load_msg $msg $url 5
}
exit 0
}
set data [read stdin]
if {[lempty $data]} {
set data $env(QUERY_STRING)
}
normalize_params $data
loop i 1 5 {
if {![info exists params(op$i)]} continue
if {$params(op$i)=="aids"} {
set params(data$i) $params(method$i)
} elseif {$params(op$i)=="avail"} {
# if {$params(data$i)==""} {
# set params(data$i) "y"
# }
}
}
# list management commands
switch $params(output) {
list_archives {
list_archives
}
delete_archives {
delete_archives
}
store_list {
store_hitlist
}
refine_list {
refine_list $params(data1)
}
login_archives {
login_archives
}
newlogin_archives {
set msg "<H4>Please log in.</H4>"
set url $BASEURL/register.html
send_load_msg $msg $url 5
exit 0
}
retrieve_list {
retrieve_list
}
delete_list {
delete_list
}
union_list {
list_operation union
}
intersect_list {
list_operation intersect
}
subtract_list {
list_operation subtract
}
reload_archives {
set msg "<H4>Repository listing updated.</H4>"
set url "$::CGIDIR/nci2.tcl?output=list_archives&userid=$::params(userid)&passwd=$::params(passwd)"
send_load_msg $msg $url 5
exit 0
}
annotate_list {
annotate_list
}
}
if {$params(query)=="" && \
[lempty [concat $params(data1) $params(data2) $params(data3) $params(data4)]]} {
printerror "No query data specified."
}
prop setparam E_SCREEN extended 1
if {$params(output)=="restart" || \
$params(output)=="restart+" || \
$params(output)=="store"} {
set params(recoffset) 0
}
if {$params(query)==""} {
# standard entry from form field
set nfields 0
loop i 1 5 {
set data $params(data$i)
set method $params(method$i)
set query($i) ""
if {[lempty $data]} continue
incr nfields
switch $params(op$i) {
record {
set q [analyze_range $data record $i "Illegal record number range"]
set query($i) $q
}
nsc {
set q [analyze_range $data E_NSC $i "Illegal NSC number range"]
set query($i) $q
}
cas {
foreach spec [split $data " "] {
regsub -all {[- _%]+} $spec {} spec
if {$spec=="999999" || $spec=="isnull"} {
lappend query($i) "isnull E_CAS"
} elseif {$spec=="notnull"} {
lappend query($i) "notnull E_CAS"
} else {
set cas [verify_cas $spec]
lappend query($i) "E_CAS = $cas"
}
}
}
formula {
verify_partial_formula $data
if {$method=="noother"} {
lappend query($i) "formula = $data"
} else {
lappend query($i) "formula >= $data"
}
}
weight {
regsub -all , $data " " data
regsub -all {[ ]+} $data " " data
foreach spec [split $data " "] {
if {[regexp {^[0-9]+\.?[0-9]*-[0-9]+\.?[0-9]*$} $spec]} {
scan $spec "%f-%f" low high
if {$low<$high} {
set tmp $low
set low $high
set high $tmp
}
lappend query($i) "and {E_WEIGHT <= $low} {E_WEIGHT >= $high}"
} elseif {[regexp {^-[0-9]+\.?[0-9]*$} $spec]} {
set high [crange $spec 1 end]
lappend query($i) "E_WEIGHT <= $high"
} elseif {[regexp {^[0-9]+\.?[0-9]*-$} $spec]} {
scan $spec %f low
lappend query($i) "E_WEIGHT >= $low"
} elseif {[regexp {^[0-9]+\.?[0-9]*$} $spec]} {
lappend query($i) "E_WEIGHT @= $spec"
} else {
printerror "Illegal weight range in input field $i"
}
}
}
natoms {
set q [analyze_range $data E_NATOMS $i "Illegal atom range"]
set query($i) $q
}
nrings {
set q [analyze_range $data E_NESSR $i "Illegal ring range"]
set query($i) $q
}
nhdonor {
set q [analyze_range $data E_NHDONORS $i "Illegal H-donor count range"]
set query($i) $q
}
nhacceptor {
set q [analyze_range $data E_NHACCEPTORS $i "Illegal H-acceptor count range"]
set query($i) $q
}
nrotbonds {
set q [analyze_range $data E_NROTBONDS $i "Illegal rotable bond count range"]
set query($i) $q
}
liqcryst {
set q [analyze_range $data E_LIQCRYST_ID $i "Illegal LIQCRYST ID range" 1]
set query($i) $q
}
nconf {
set q [analyze_range $data E_NCONFORMER $i "Illegal conformer count range"]
set query($i) $q
}
dlike {
if {$method=="std"} {
set p E_DRUGLIKENESS
} else {
set p E_DRUGLIKENESS/2
}
set data [cindex [string tolower $data] 0]
switch $data {
y -
t -
1 -
d {
lappend query($i) "$p = 1"
}
n -
f -
0 {
lappend query($i) "$p = 0"
}
isnull {
lappend query($i) [list isnull $p]
}
notnull {
lappend query($i) [list notnull $p]
}
default {
printerror "Illegal drug likeness qualifier in input field $i"
}
}
}
pass {
if {![string match E_PASS* $method]} {
printerror "You must specify a PASS field."
}
foreach spec [split $data " "] {
if {[regexp {^[0-9]+\.?[0-9]*-[0-9]+\.?[0-9]*$} $spec]} {
scan $spec "%f-%f" low high
if {$low<$high} {
set tmp $low
set low $high
set high $tmp
}
lappend query($i) "and {$method <= $low} {$method >= $high}"
} elseif {[regexp {^-[0-9]+\.?[0-9]*$} $spec]} {
set high [crange $spec 1 end]
lappend query($i) "$method <= $high"
} elseif {[regexp {^[0-9]+\.?[0-9]*-$} $spec]} {
scan $spec %f low
lappend query($i) "$method >= $low"
} elseif {[regexp {^[0-9]+\.?[0-9]*$} $spec]} {
lappend query($i) "$method @= $spec"
} else {
printerror "Illegal PASS data in input field $i"
}
}
set params(passid) $method
}
name {
if {$data=="isnull"} {
lappend query($i) {isnull E_NAMESET}
} elseif {$data=="notnull"} {
lappend query($i) {notnull E_NAMESET}
} elseif {$method=="regexp"} {
if {[catch {regexp $data zxuytefs}]} {
printerror "Syntax error in regular expression $data"
}
lappend query($i) "E_NAMESET ~= \"$data\""
set params(namefrag) $data
} elseif {$method=="shell"} {
if {[catch {string match $data zxuytefs}]} {
printerror "Syntax error in shell string $data"
}
lappend query($i) "E_NAMESET *= \"$data\""
regsub -all {[*]} $data {} data
set params(namefrag) $data
} else {
foreach spec [split $data " "] {
switch $method {
exact {
lappend query($i) "E_NAMESET @= \"$spec\""
set params(namefrag) $spec
}
exactn {
lappend query($i) "E_NAMESET @n= \"$spec\""
set params(namefrag) $spec
}
substring {
lappend query($i) "E_NAMESET @#= \"$spec\""
set params(namefrag) $spec
}
substringn {
lappend query($i) "E_NAMESET @n#= \"$spec\""
set params(namefrag) $spec
}
}
}
}
}
complexity {
regsub -all , $data " " data
regsub -all {[ ]+} $data " " data
foreach spec [split $data " "] {
if {[regexp {^[0-9]+\.?[0-9]*-[0-9]+\.?[0-9]*$} $spec]} {
scan $spec "%f-%f" low high
if {$low<$high} {
set tmp $low
set low $high
set high $tmp
}
lappend query($i) "and {E_COMPLEXITY <= $low} {E_COMPLEXITY >= $high}"
} elseif {[regexp {^-[0-9]+\.?[0-9]*$} $spec]} {
set high [crange $spec 1 end]
lappend query($i) "E_COMPLEXITY <= $high"
} elseif {[regexp {^[0-9]+\.?[0-9]*-$} $spec]} {
scan $spec %f low
lappend query($i) "E_COMPLEXITY >= $low"
} elseif {[regexp {^[0-9]+\.?[0-9]*$} $spec]} {
lappend query($i) "E_COMPLEXITY @= $spec"
} else {
printerror "Illegal complexity range in input field $i"
}
}
}
aids {
set data [string toupper $data]
switch $data {
CM -
CI -
CA {
lappend query($i) "E_VIRAL_SCREENING = $data"
}
CAM {
lappend query($i) "or {E_VIRAL_SCREENING = CA} {E_VIRAL_SCREENING = CM}"
}
CAI {
lappend query($i) "or {E_VIRAL_SCREENING = CA} {E_VIRAL_SCREENING = CI}"
}
CMI {
lappend query($i) "or {E_VIRAL_SCREENING = CM} {E_VIRAL_SCREENING = CI}"
}
default {
printerror "Illegal flag value $data on input field $i"
}
}
}
yeast {
set q [analyze_range $data E_YEAST_SCREENING_LEVEL $i "Illegal yeast screening level range"]
set query($i) $q
}
stereo {
switch $method {
potential {
set data [cindex [string tolower $data] 0]
switch -- $data {
y -
t -
1 -
d {
lappend query($i) "E_STEREO_POTENTIAL = 1"
}
n -
f -
0 {
lappend query($i) "E_STEREO_POTENTIAL = 0"
}
isnull {
lappend query($i) [list isnull E_STEREO_POTENTIAL]
}
notnull {
lappend query($i) [list notnull E_STEREO_POTENTIAL]
}
default {
printerror "Illegal stereo potential qualifier in input field $i"
}
}
}
atomcount {
set q [analyze_range $data E_ATOM_STEREOCENTER_COUNT $i "Illegal atom stereocenter count range"]
set query($i) $q
}
bondcount {
set q [analyze_range $data E_BOND_STEREOCENTER_COUNT $i "Illegal bond stereocenter count range"]
set query($i) $q
}
}
}
avail {
set data [cindex [string tolower $data] 0]
switch -- $data {
0 -
n {
set q isnull
set v 0
}
1 -
y -
{} -
t {
set q notnull
set v 1
}
default {
printerror "Illegal data availability qualifier in input field $i"
}
}
switch $method {
aids {
lappend query($i) "$q E_VIRAL_SCREENING"
}
tgi {
lappend query($i) "E_HAS_TGI = $v"
}
gi50 {
lappend query($i) "E_HAS_GI50 = $v"
}
lc50 {
lappend query($i) "E_HAS_LC50 = $v"
}
ec50 {
lappend query($i) "E_HAS_EC50 = $v"
}
ic50 {
lappend query($i) "E_HAS_IC50 = $v"
}
yeast {
if {$v} {
lappend query($i) "E_YEAST_SCREENING_LEVEL > 0"
} else {
lappend query($i) "E_YEAST_SCREENING_LEVEL = 0"
}
}
anytumor {
if {$v} {
lappend query($i) "or {E_HAS_TGI = 1} {E_HAS_GI50 = 1} {E_HAS_LC50 = 1} {E_YEAST_SCREENING_LEVEL > 0}"
} else {
lappend query($i) "and {E_HAS_TGI = 0} {E_HAS_GI50 = 0} {E_HAS_LC50 = 0} {E_YEAST_SCREENING_LEVEL = 0}"
}
}
anyaids {
if {$v} {
lappend query($i) "or {E_HAS_EC50 = 1} {E_HAS_IC50 = 1}"
} else {
lappend query($i) "and {E_HAS_EC50 = 0} {E_HAS_IC50 = 0}"
}
}
kowlogp {
lappend query($i) "$q E_LOGP"
}
explogp {
lappend query($i) "$q E_LOGP/2"
}
acdlogp {
lappend query($i) "$q E_LOGP/3"
}
anylogp {
if {$v} {
lappend query($i) "or {notnull E_LOGP} {notnull E_LOGP/2} {notnull E_LOGP/3}"
} else {
lappend query($i) "and {isnull E_LOGP} {isnull E_LOGP/2} {isnull E_LOGP/3}"
}
}
dlike {
lappend query($i) "$q E_DRUGLIKENESS"
}
liq {
lappend query($i) "$q E_LIQCRYST_ID"
}
pass {
lappend query($i) "$q E_PASS_DATA_PA"
}
ntp {
lappend query($i) "$q E_NTP_LINK"
}
cas {
lappend query($i) "$q E_CAS"
}
dbref {
lappend query($i) "$q E_DATABASE_KEYS"
}
vendor {
lappend query($i) "$q E_VENDOR_IDS"
}
plated {
if {$v} {
lappend query($i) "E_PLATED > 0"
} else {
lappend query($i) "E_PLATED = 0"
}
}
wdi {
if {$v} {
lappend query($i) "E_VENDOR_IDS 1= wdi"
} else {
lappend query($i) "not {E_VENDOR_IDS 1= wdi}"
}
}
catalyst {
if {$v} {
lappend query($i) "E_NCONFORMER > 0"
} else {
lappend query($i) "E_NCONFORMER = 0"
}
}
}
}
random {
set reclist ""
random seed [clock seconds]
while {[llength $reclist]<$params(maxhits)} {
set rec [expr [random $DBSIZE]+1]
if {![lcontain $reclist $rec]} {
lappend reclist $rec
}
}
foreach rec [lsort -integer $reclist] {
lappend query($i) "record = $rec"
}
set params(has_random) 1
}
logp {
regsub -all , $data " " data
regsub -all {[ ]+} $data " " data
foreach spec [split $data " "] {
if {[regexp {^-?[0-9]+\.?[0-9]*--?[0-9]+\.?[0-9]*$} $spec]} {
scan $spec "%f-%f" low high
if {$low<$high} {
set tmp $low
set low $high
set high $tmp
}
switch $method {
kowlogp {
lappend query($i) "and {E_LOGP <= $low} {E_LOGP >= $high}"
}
explogp {
lappend query($i) "and {E_LOGP/2 <= $low} {E_LOGP/2 >= $high}"
}
acdlogp {
lappend query($i) "and {E_LOGP/3 <= $low} {E_LOGP/3 >= $high}"
}
anylogp {
lappend query($i) "or {and {E_LOGP <= $low} {E_LOGP >= $high}} {and {E_LOGP/2 <= $low} {E_LOGP/2 >= $high}} {and {E_LOGP/3 <= $low} {E_LOGP/3 >= $high}}"
}
}
} elseif {[regexp {^--?[0-9]+\.?[0-9]*$} $spec]} {
set high [crange $spec 1 end]
switch $method {
kowlogp {
lappend query($i) "E_LOGP <= $high"
}
explogp {
lappend query($i) "E_LOGP/2 <= $high"
}
acdlogp {
lappend query($i) "E_LOGP/3 <= $high"
}
anylogp {
lappend query($i) "or {E_LOGP <= $high} {E_LOGP/2 <= $high} {E_LOGP/3 <= $high}"
}
}
} elseif {[regexp {^-?[0-9]+\.?[0-9]*-$} $spec]} {
scan $spec %f low
switch $method {
kowlogp {
lappend query($i) "E_LOGP >= $low"
}
explogp {
lappend query($i) "E_LOGP/2 >= $low"
}
acdlogp {
lappend query($i) "E_LOGP/3 >= $low"
}
anylogp {
lappend query($i) "or {E_LOGP >= $low} {E_LOGP/2 >= $low} {E_LOGP/3 >= $low}"
}
}
} elseif {[regexp {^-?[0-9]+\.?[0-9]*$} $spec]} {
switch $method {
kowlogp {
lappend query($i) "E_LOGP @= $spec"
}
explogp {
lappend query($i) "E_LOGP/2 @= $spec"
}
acdlogp {
lappend query($i) "E_LOGP/3 @= $spec"
}
anylogp {
lappend query($i) "or {E_LOGP @= $spec} {E_LOGP/2 @= $spec} {E_LOGP/3 @= $spec}"
}
}
} else {
printerror "Illegal logP range in input field $i"
}
}
}
fs -
ss -
trafo -
sim {
if {range($i,1,3)} {
if {$params(op$i)=="ss"} {
set addh 0
} else {
set addh 1
}
if {[catch {ens create $data $addh} eh]} {
printerror "Syntax error in SMILES string in input field $i"
}
map_to_label $eh
} else {
filex load alchemy
set tmpfile [tmpname]
set fh [open $tmpfile w]
puts -nonewline $fh $data
close $fh
if {[catch {molfile open $tmpfile r hydrogens add} mh]} {
printerror "File open error on structure file"
}
if {[catch {molfile read $tmpfile} eh]} {
molfile close $mh
printerror "Read error on structure file"
}
molfile close $mh
file delete $tmpfile
}
ens nitrostyle $eh ionic
switch $params(op$i) {
fs {
if {$method=="ens"} {
if {$params(tauto)} {
lappend query($i) "structure t= $eh"
} else {
lappend query($i) "E_HASHY = [ens get $eh E_HASHY]"
}
} else {
if {$params(tauto)} {
lappend query($i) "structure t#= $eh"
} else {
lappend query($i) "M_HASHY = [ens get $eh M_HASHY]"
}
}
}
sim {
if {$method=="screen"} {
set blob [ens pack $eh]
if {$params(tauto)} {
lappend query($i) "structure t@= $eh"
lappend query_blob($i) "structure t@= $blob"
} else {
lappend query($i) "structure @= $eh"
lappend query_blob($i) "structure @= $blob"
}
} else {
set screen [ens get $eh E_SCREEN]
lappend query($i) "E_SCREEN t>= $screen $method"
set params(has_sim) 1
}
}
ss {
set op ">="
if {$params(ssnoaro)} {
append op a
}
if {$params(ssoverlap)} {
append op o
}
if {$params(sshighlight)} {
append op m
}
if {$params(tauto)} {
append op t
}
if {$params(ssringmatch)} {
append op r
}
loop j 1 5 {
if {[info exists params(constraint${i}_$j)]} {
set c $params(constraint${i}_$j)
if {$c==""} continue
if {[llength $c]!=3} {
printerror "Syntax error in constraint $j in input field $i"
}
lassign $c type atoms val
if {$atoms=="" || $val==""} continue
add_constraint $eh $type $atoms $val
}
}
lappend query($i) "structure $op $eh"
set blob [ens pack $eh]
lappend query_blob($i) "structure $op $blob"
set params(has_ss) 1
}
trafo {
if {![string match E_TRAFO* $method]} {
printerror "You must select a transformation scheme!"
}
lappend query($i) "$method = [ens get $eh $method]"
}
default {
printerror "Illegal structure search mode $params(op$i)"
}
}
}
fg {
if {[catch {llength $data} res]} {
printerror "Illegal data format"
}
if {$res&1} {
printerror "Illegal odd numer of ranges"
}
foreach val $data {
if {![regexp {[0-9]+} $val]} {
printerror "Illegal group count range $val"
}
}
lappend query($i) "E_FEATURES v= \"$data\""
}
hit {
if {![regexp {^# CACTVS database hitlist} $data]} {
printerror "Invalid hitlist file"
}
if {![regexp $DATABASEDIR_LOCAL/cbs2000* $data]} {
printerror "Hitlist not from this database"
}
set nhit 0
set query($i) "\{or "
foreach line [split $data "\n"] {
if {[cindex $line 0]=="#"} continue
if {[lempty $line]} continue
lappend query($i) "record = [lindex $line 1]"
incr nhit
}
if {!$nhit} {
printerror "Empty hitlist file"
}
append query($i) "\}"
}
default {
printerror "Illegal query type $params(op$i)"
}
}
if {![info exists query_blob($i)]} {
set query_blob($i) $query($i)
}
if {[llength $query($i)]>1} {
if {$method=="substring"||$method=="shell"||$method=="substringn"} {
set query($i) "{and $query($i)}"
set query_blob($i) "{and $query_blob($i)}"
} else {
set query($i) "{or $query($i)}"
set query_blob($i) "{or $query_blob($i)}"
}
}
if {$params(neg$i)} {
set query($i) "{not $query($i)}"
set query_blob($i) "{not $query_blob($i)}"
}
}
if {$nfields==1} {
loop i 1 5 {
if {$query($i)!=""} {
set params(query) $query($i)
set params(blobquery) $query_blob($i)
break
}
}
} else {
if {$params(has_random)} {
printerror "Random set queries cannot be combined with other queries."
}
set params(query) "\{$params(andor) "
set params(blobquery) "\{$params(andor) "
loop i 1 5 {
if {$query($i)!=""} {
append params(query) "$query($i) "
append params(blobquery) "$query_blob($i) "
}
}
append params(query) "\}"
append params(blobquery) "\}"
}
if {$params(recoffset)>0} {
set params(query) "and {record > $params(recoffset)} $params(query)"
set params(blobquery) "and {RECORD > $params(recoffset)} $params(blobquery)"
} else {
set params(query) [join $params(query)]
set params(blobquery) [join $params(blobquery)]
}
} else {
# params(query) set, means this is a followup, we just
# change the record offset
if {[regexp RECORD $params(query)]} {
set params(blobquery) $params(query)
regsub {RECORD > [0-9]+} $params(blobquery) "RECORD > $params(recoffset)" params(blobquery)
} else {
set params(blobquery) "and {RECORD > $params(recoffset)} {$params(query)}"
}
regsub RECORD $params(blobquery) record params(query)
}
check_file_online
if {![catch {open $WWWCOUNTERDIR_LOCAL/query_2.dat} fh]} {
set n [lindex [split [gets $fh] :] 0]
close $fh
set fh [open $WWWCOUNTERDIR_LOCAL/query_2.dat w]
if {$n==""} { set n 0 }
puts $fh [incr n]:127.0.0.1
close $fh
}
set mh [molfile open $DBFILE]
set starttime [clock seconds]
molfile set $mh timeout $params(timeout) postprocessing 0
set displaylist {table record E_NSC E_FORMULA E_NAMESET E_CAS confid}
switch $params(sort) {
nsc -
none {
lappend displaylist E_NSC
}
weight {
lappend displaylist E_WEIGHT
}
sim {
lappend displaylist cmpvalue
}
complexity {
lappend displaylist E_COMPLEXITY
}
natoms {
lappend displaylist E_NATOMS
}
}
if {$params(has_sim)} {
lappend displaylist cmpvalue
}
if {!$params(has_ss)} {
set params(sshighlight) 0
}
set loghandle [open $LOGDIR/nci2.log a]
puts $loghandle $params(query)
if {$params(has_ss)} {
# we have no eh if this is a blob query...
if {[info exists eh]} {
puts $loghandle "SMILES: [ens get $eh E_SMILES]"
}
}
close $loghandle
if {$params(sshighlight)} {
lappend displaylist matchbonds matchatoms
}
#printerror $displaylist
#printerror $params(query)
if {$params(has_sim) && $params(sort)=="sim"} {
set maxtablesize $DBSIZE
} else {
set maxtablesize $params(maxhits)
}
if {$params(output)=="count"} {
if {[catch {molfile scan $mh $params(query) count} nrecs]} {
printerror "Query failed: $params(query)"
}
if {[molfile get $mh eof]} {
printerror "Counted $nrecs hit[plural $nrecs]." 0 0
} else {
printerror "Counted $nrecs hit[plural $nrecs] before timeout." 0 0
}
exit 0
}
if {[catch {molfile scan $mh $params(query) $displaylist {} $maxtablesize} thandle]} {
printerror "Query failed: $params(query)"
}
set params(query) $params(blobquery)
set params(iseof) [molfile get $mh eof]
if {!$params(has_sim) && $params(sort)=="sim"} {
set params(sort) nsc
}
molfile close $mh
set stoptime [clock seconds]
qtable set $thandle undefined ""
set nrecs [qtable get $thandle nrows]
if {$nrecs==0} {
printerror "No matches." 1
}
if {$nrecs==1} {
set r [qtable celldata $thandle 0 record]
if {$params(has_ss) && $params(sshighlight)} {
set params(highbondlist) [qtable celldata $thandle 0 highlightbonds]
set params(highatomlist) [qtable celldata $thandle 0 highlightatoms]
}
if {$params(has_sim)} {
set params(simlist) [qtable celldata $thandle 0 cmpvalue]
}
if {$params(conflist)==""} {
set params(conflist) [qtable celldata $thandle 0 confid]
}
} else {
sort_table $thandle $params(sort)
if {$nrecs>$params(maxhits)} {
qtable set $thandle nrows $params(maxhits)
set nrecs $params(maxhits)
}
}
set t [expr $stoptime-$starttime]
if {$params(output)=="table" || $params(output)=="table+"} {
set tmpfile [tmpname query $::WWWTMPDIR_LOCAL].tbin
set params(tablefile) $tmpfile
qtable set $thandle T_QUERY(parameters) [array get params]
qtable set $thandle T_QUERY(comment) "(no comment yet)"
qtable save $thandle $tmpfile tbin
}
switch $params(output) {
javaviewer -
vrmlviewer -
vrmlmviewer -
pdbviewer -
chimeviewer_conf -
chimeviewer {
if {$nrecs>1} {
build_hitlist $thandle $t
} else {
display_structure $params(output) $thandle $params(highbondlist) $params(highatomlist) $params(conflist)
}
}
dtp -
covell {
contact_service $params(output) $thandle
}
E_GI50 -
E_LC50 -
E_TGI -
E_YEAST_SCREEN -
E_IC50 -
E_EC50 {
output_screen $thandle $params(output) $params(tablefmt)
}
ntp -
nist -
medline -
chemid -
chemfinder -
chemindustry -
liqcryst -
telespec -
orbvis -
compare -
petra -
gifgen -
comspec3d -
acd -
vrmlgen {
if {$nrecs>1} {
build_hitlist $thandle $t
} else {
contact_service $params(output) $thandle
}
}
alchemy -
cerius -
mdl -
pdb -
smd4 -
vrml -
xtel -
jcamp -
sybyl2 -
cml -
mopacin -
gaussin -
molconnz -
ctx -
compass -
hyperchem -
sln -
scf -
xfig -
m3d -
car -
xyz {
if {$nrecs>1} {
build_hitlist $thandle $t
} else {
output_structure $params(output) $params(use3d) $thandle \
$params(highbondlist) $params(highatomlist) \
$params(simlist) $params(conflist) $params(sort) $params(fields)
}
}
gifgallery -
chimegallery3D -
chimegallery {
if {$params(has_ss) && $pa