[Bio] / DrugTargets / drug_targets.pl Repository:
ViewVC logotype

View of /DrugTargets/drug_targets.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.22 - (download) (as text) (annotate)
Fri Jun 2 15:45:45 2006 UTC (13 years, 6 months ago) by hwang
Branch: MAIN
CVS Tags: HEAD
Changes since 1.21: +7 -5 lines
Fixed broken links. Separated the tag from the link so there won't be broken links in the future.

use strict;
use CGI;
use FIG; 
use FIG_Config; 
use Data::Dumper;
use File::stat;

my $cgi      = new CGI; 
my $fig      = new FIG;
my $temp_dir = $FIG_Config::temp;
my $save_dir = "$FIG_Config::fig/var/DrugTargets/NewFiles";
my $fin      = "$temp_dir/tmp$$.in";

my $flist    = (-e $save_dir) ? "$save_dir/master_tables.list" : "$temp_dir/master_tables.list";
my %tdict    = ();


open(FLIST, $flist) or die print "_master_tables can not be opened";
for (<FLIST>) {
    chomp;
    my ($name, $file) = split(/\t/);
    $tdict{$name} = $file;
}

if ($cgi->param('Generate my table now')) {
    goto CREATING;
}



my $html = [];
    
push(@$html, 
     
     "<a href=http://rickettsia.uchicago.edu/khwang/FIG/ShowTable.cgi> View and Edit existing tables </a>",
     
     );

#my @display = ( 'All', 'Archaea', 'Bacteria', 'Eucarya', 'Viruses', 'Environmental samples' ); 
my @display = ( 'All', 'Bacteria', 'Viruses'); 
 
my %canonical = ( 
		  'All'                   =>  undef, 
		  'Archaea'               => 'Archaea', 
		  'Bacteria'              => 'Bacteria', 
		  'Eucarya'               => 'Eukaryota', 
		  'Viruses'               => 'Virus', 
		  'Environmental samples' => 'Environmental Sample' 
		  ); 

my $req_dom = $cgi->param( 'domain' ) || 'Bacteria'; 
my @domains = $cgi->radio_group( -name     => 'domain', 
				 -default  => $req_dom, 
				 -override => 1, 
				 -values   => [ @display ] 
				 ); 
 
my $n_domain = 0; 
my %dom_num = map { ( $_, $n_domain++ ) } @display; 
my $req_dom_num = $dom_num{ $req_dom } || 0; 

my $req_comp = ( $req_dom_num == $dom_num{ 'Viruses' } ) ? 'All' : $cgi->param( 'complete' ) || 'Only "complete"'; 

my @complete = $cgi->radio_group( -name     => 'complete', 
				  -default  => $req_comp, 
				  -override => 1, 
				  -values   => [ 'All', 'Only "complete"' ] 
				  ); 

my $complete = ( $req_comp =~ /^all$/i ) ? undef : "complete"; 
 
my @orgs = sort map { my $org = $_; my $gs = $fig->genus_species($org);  
		      "$gs ($org)" } $fig->genomes( $complete, undef, $canonical{ $req_dom } ); 

my $search = $cgi->param('search');
if ($search =~ /\s*(\S.*)/) {@orgs = grep {/$1/i} @orgs;}

my $n_genomes = @orgs; 

my $orgs_html = [];
push(@$orgs_html, 
                  "<TABLE>\n", 
                  "   <TR>\n", 
                  "      <TD>",
                  "         <table>\n",
                  "            <tr><td>",
                  $cgi->scrolling_list( -name     => 'korgs', 
                                        -values   => [@orgs] ,
					-multiple => 1,
                                        -size     => 7, 
                                      ),
                  "            </td></tr>\n",
                  "            <tr><td>",
                  "<b>Search</b> ",
                  $cgi->textfield(-name => "search", -size => 45),
                  $cgi->submit( 'Update' ), $cgi->reset, 
                  "            </td></tr>\n",
                  "         </table>\n",
	          "      </TD>"
     ); 

push(@$orgs_html, 
                  "      <TD>", 
                  join( "<br>", "<b>Domain(s) to show:</b>", @domains), "<br>\n", 
                  join( "<br>", "<b>Completeness?</b>", @complete), "\n", 
                  "      </TD>", 
                  "   </TR>\n", 
                  "</TABLE>\n", 
     ); 

push(@$html, 
     $cgi->h2("Work on New Tables"),
     "<table cellpadding=6>\n",
     "  <tr> <th> Enter gene search keys </th> <th> Input Example </th> </tr> \n",
     "  <tr> <td align=center rowspan=2>", 
                 $cgi->textarea(-name => 'keys', -rows => 21, -cols => 25), "<br>", 
                 $cgi->submit('Generate my table now'), 
     "       </td> \n",
     "       <td> <br>", 
     "            #orgs=216600.1,170187.1,171101.1 <br> ", 
     "            #cat=ES-L <br> ",
     "            #tag=essential_by_Thanassi <br> ",
     "            #url=http://www.ncbi.nlm.nih.gov/... <br>",
     "            <b> SP0121 <br> ",
     "            SP0499 <br> <br> </b>",
     "            #orgs=158879.1 <br>" ,
     "            #cat=SA <br>",
     "            <b> SA1051 </b> <br> <br>",
     "       </td> \n",
     "       <td> <i> Specification with optional comments <br> ", 
     "              Specify multiple genomes IDs here, or <b>pick organisms below</b>. <br> ",
     "              Gene Cateory <a href=cat_coding.cgi>See category codes</a><br> ",
     "              Gene Tag <br> ",
     "              Link to literature (if PubMed link, short as the <b>uids</b> value) <br> ",
     "              Gene search keys <br> ",
     "              ... <br> <br> ",
     "              New organism. All specifications set back to null. <br> ",
     "              ... <br>",
     "              key[,tag][;category][;url][;fig_ID]<br>",
     "              (Inline specifications: fig_ID overrides the search key)<br></i>",
     "       </td> \n",
     "  </tr> \n",
     "  <tr>\n",
     "       <td colspan=2> \n", 
                    @$orgs_html,
     "       </td> \n",
     "  </tr> \n",
     "</table>\n",
     $cgi->hr, 
     );

print $cgi->header();
print $cgi->head($cgi->title("Drug Targets")); 

print $cgi->start_body(); 
print $cgi->start_form(-action => "drug_targets.cgi");

print @$html;

my @korgs = $cgi->param('korgs');
@korgs = map { /\((\d+\.*\d*)\)/} @korgs;
#print "<h3>" . join("<br>", @korgs) . "</h3>\n";
#print "<h3>" . $cgi->param('keys') . "</h3>\n";

print $cgi->end_form;
print gen_google_box();
print $cgi->end_body();
print "\n";


exit;

# View existing tables

VIEWING:

print $cgi->header;

my $fview = $tdict{$cgi->param('master_table')};

my $fdown = $fview;
$fdown =~ s/\.txt/\.html\.xls/;
#my $view_down_url = (-e $save_dir) ? "http://ci-www.uchicago.edu/~fangfang/FIG_save/$fdown" : "http://seed-mac-1.mcs.anl.gov/fangfang/FIG-Tmp/$fdown";

my $view_down_url = "$FIG_Config::temp_url/$fdown";

print $cgi->h2($cgi->param('master_table'));
print "<a href=$view_down_url> Download to Excel </a> <p>\n";


$fview = (-e $save_dir) ? "$save_dir/$fview" : "$temp_dir/$fview";
open(FVIEW, $fview) or die "print cannot open directory";

print gen_html("start_table");
my $count = 0;
while (<FVIEW>) {
    chomp;
    my @row = split(/\t/);
    if (!$count++) {
	print gen_html("header", @row);
    } else {
	print gen_html("row", @row);
    }
}
close(FVIEW);
print gen_html("end_table");


exit;

# Generation of a new table

CREATING:

if (!$cgi->param('Generate my table now')) {exit;}
my $fxls_path= "$temp_dir/download$$.html.xls";
my $ftxt_path= "$temp_dir/download$$.txt";

my $fxls_name= $fxls_path;
$fxls_name =~ s/$temp_dir\///g; 
my $ftxt_name= $ftxt_path;
$ftxt_name =~ s/$temp_dir\///g;



my $tmp2_dir = "$FIG_Config::temp_url";

my $fxls     = (-e $tmp2_dir) ? "$tmp2_dir/$fxls_name" : "$temp_dir/$fxls_name";
my $ftxt     = (-e $tmp2_dir) ? "$tmp2_dir/$ftxt_name" : "$temp_dir/$ftxt_name";
#my $down_url = (-e $tmp2_dir) ? "http://ci-www.uchicago.edu/~fangfang/FIG_tmp/$fxls_name" : "http://seed-mac-1.mcs.anl.gov/fangfang/FIG-Tmp/$fxls_name";

my $down_url = "$FIG_Config::temp_url/$fxls_name";

$| = 1;

my $webpage    = 1;
my $table_only = 1;
my $include_all= 1;
my $single_hit = 0;
my $no_header  = 0;
my $ignore_comment = 0;

my $data = $cgi->param("keys");
$data =~ s/^\s*//s;
my @korgs = $cgi->param('korgs');
@korgs = map { /\((\d+\.*\d*)\)/} @korgs;
$data = "#orgs=". join(",", @korgs). "\n$data";

print $cgi->header();

my @header;
if ($webpage || !$no_header) {
    @header = ('Category', 'Tag', 'Gene Id', 'PEG ID', 'PEG SeqLen', 'GenBank ID', 'UniProt ID', 'Functional Role', 'Conservation of Seqs', 'PDB (bound)', 'e-Value (bound)', 'PDB (free)', 'e-Value', 'PDB Title', 'PDB SeqLen', 'ProtDist', 'PASS ASPs', 'PASS Weight of Largest Pocket', 'PDB Ligand CLiBE', 'Total Energy', 'Van der Waals Interaction', 'Hydrogen Bond', 'Electrostatic Interaction', 'Solvation Energy');

    if ($webpage) {
	if ($table_only) {
	    if (check_org($data)) {print gen_html("warning", ("Organism list not defined properly."));}
	    #else {print "<a href=$down_url> Download to Excel </a> <p>\n";}
	    print gen_html("start_table");
	} else {
	    print gen_html("start_html", ("Drug Targets"));
	    print gen_html("start_table");
	}
	print gen_html("header", @header); 
    } else { 
	print join("\t", @header). "\n"; 
    } 
} 

{
    my ($def_org, $def_cat, $def_tag, $def_url);

    open(FXLS, ">$fxls");
    if (\*FXLS) {
	print FXLS gen_html("start_html", ("Drug Targets")); 
	print FXLS gen_html("start_table"); 
	print FXLS gen_html("header", @header); 
    }

    open(FTXT, ">$ftxt");
    if (\*FTXT) {
	print FTXT join("\t", @header) . "\n";
    }

    
    for (my @lines = split(/\n/, $data)) {
	chomp;
	if (/^\#/) {
	    next if ($ignore_comment);
	    (/orgs=(.*\S)/i) && ($def_org = $1, $def_cat = $def_tag = $def_url = undef);
	    (/cat=(.*\S)/i)  && ($def_cat = $1);
	    (/tag=(.*\S)/i)  && ($def_tag = $1);
	    (/url=(\S+)/i)   && ($def_url = $1);
	    next;
	}
	$def_url = "http://www.ncbi.nlm.nih.gov/entrez/query.fcgi?cmd=Retrieve&db=pubmed&dopt=Abstract&list_uids=$def_url" unless ($def_url =~ /http/);

	my $org = $def_org || (print(STDERR "'$fin': No genome specified. Skipped...\n\n"), last);
	my $cat = $def_cat;
	my $tag = $def_tag;
	my $url = $def_url;

	my @cols = split(/[;\t]/);

	if (my $gene = $cols[0]) {
	    if ($gene =~ /(\S+)?\s*\,\s*(.*\S)/) {
		$gene = $1;
		$tag = $2;
	    } else {
		$gene =~ /(\S+)/;
		$gene = $1;
	    }
	    $gene =~ s/fig\|//;
	    next unless ($gene || $cols[3]);

	    # peg, url, cat
            my @pegs;
            if ($cols[3]) {
                $cols[3] =~ /(\d+\.\d+\.peg\.\d+)/;
                @pegs = ("fig|$1");
            } else {
                if ($org) {
                    @pegs = get_pegs($org, $gene);
                } else {
                    print(STDERR "'$gene': No genome specified. Skipped...\n\n");
                    next unless ($include_all);
                }
            }

	    for my $peg (@pegs) {
		($fig->function_of($peg)) || ($peg = undef); 
		unless ($include_all) {next unless $peg};

		#update to nmpdr my $peg_u = "<a href=http://theseed.uchicago.edu/FIG/protein.cgi?prot=$peg&user= target=_blank>$peg</a>" if ($peg);
		my $peg_u = "<a href=http://www.nmpdr.org/FIG/protein.cgi?prot=$peg&user=&SPROUT=1 target=_blank>$peg</a>" if ($peg);
		$gene = $tag ? "$gene, $tag" : $gene; 
		$tag = 0;
		$cat = $cols[1] ? $cols[1] : $cat;
		$url = $cols[2] ? $cols[2] : $url;
		my $gene_u = "<a href=$url>$gene</a>" if ($gene);
		
		# funtion role
		my $role = $fig->function_of($peg);
		
		# geneId
		my @aliases = $fig->feature_aliases($peg);
		my @genes = grep {$_ !~ /.*(\||\_|\:).*/ } @aliases;
		my $geneId = join (",", @genes);

		# Genebank ID
		my @gids = grep {/.*gi.*/} @aliases;
		my $gid = join(", ", @gids);
		my @gids_u = map {/gi\|(\S+)/ } @gids;	    
		map {$_ = "<a href=http://www.ncbi.nlm.nih.gov/entrez/viewer.fcgi?db=protein&val=$_ target=_blank>gi|$_</a>"} @gids_u;
		my $gid_u = join(", ", @gids_u); 
		
		# uniprot ID
		my @uniIds = grep {/.*uni.*/} @aliases; 
		my $uniId = join(", ", @uniIds);
		my @uniIds_u = map {/uni\|(\S+)/} @uniIds;
		map {$_ = "<a href=http://www.pir.uniprot.org/cgi-bin/upEntry?id=$_ target=_blank>uni|$_</a>"} @uniIds_u;
		my $uniId_u = join(", ", @uniIds_u);

		# conservation of sequences
		my $cons = get_cons($peg);

		# best pdb bound
		my ($pdb_bound, $escore_bound, $pdb_bound_url) = get_pdb($peg, "bound") if ($peg);
		my $pdb_bound_u = "<a href=$pdb_bound_url>$pdb_bound</a>" if ($pdb_bound);

		# best pdb free
		my ($pdb, $escore, $pdb_url, $pdb_title) = get_pdb($peg, "free") if ($peg);
		my $pdb_u = "<a href=$pdb_url>$pdb</a>" if ($pdb);

		# prodist 
		my ($peg_len, $pdb_len, $dist) = get_dist($peg, $pdb) if ($pdb);
		my $dist_u = "<a href=peg_pdb_align.cgi?peg=$peg&pdb=$pdb>$dist</a>" if ($dist);
		my $peg_len = $fig->translation_length($peg);

		# pass info for pdb free
		my ($pass, $pass_maxwgt, $pass_gif, $aug_pdb) = get_pass($pdb) if ($pdb);
		my $pass_u = "<a href=$aug_pdb>$pass</a>" if ($pass);
		my $pass_maxwgt_u = "<a href=$pass_gif>$pass_maxwgt</a>" if ($pass);
		($pass = $pass_u = " 0 ") unless ($pass && $aug_pdb);
		($pass_maxwgt = $pass_maxwgt_u = " 0 ") unless ($pass_maxwgt && $pass_gif);

		# CLiBE
		my ($clibe, $clibe_url, $tote, $vdwi, $hbond, $ei, $sole) = get_clibe($pdb) if ($pdb);
		my $clibe_u = "<a href=$clibe_url>$clibe</a>" if ($clibe);
		
		#@row = ($cat, $gene, $geneId, $peg, $peg_len, $gid, $uniId, $role, $cons, $pdb_bound, $escore_bound, $pdb, $escore, $pdb_title, $pdb_len, $dist, $pass, $pass_maxwgt, $clibe);

		my @row_u = ($cat, $gene_u, $geneId, $peg_u, $peg_len, $gid_u, $uniId_u, $role, $cons, $pdb_bound_u, $escore_bound, $pdb_u, $escore, $pdb_title, $pdb_len, $dist_u, $pass_u, $pass_maxwgt_u, $clibe_u, $tote, $vdwi, $hbond, $ei, $sole);
		
		#Text and link should be separated
		my $author = "";
		
		my @row_txt = ($author, $cat, $gene, $url, $geneId, $peg, $peg_len, $gid, $uniId, $role, $cons, $pdb_bound, 
			       $pdb_bound_url, $escore_bound, $pdb, $pdb_url, $escore, $pdb_title, $pdb_len, $dist, $pass, $pass_maxwgt, $clibe, $tote, 
			       $vdwi, $hbond, $ei, $sole);
		
		
		if (\*FXLS) {print FXLS gen_html("row", @row_u);}
		#if (\*FTXT) {print FTXT join("\t", @row_u) . "\n";}
		if (\*FTXT) {print FTXT join("\t", @row_txt) . "\n";}

		if ($webpage) {
		    print gen_html("row", @row_u);
		} else {
		    print join("\t", @row_u) . "\n"; 
		}
	    }
	}
    }
    if (\*FXLS) {
	print FXLS gen_html("end_table");
	print FXLS gen_html("end_html");
	close(FXLS);    
    }
    if (\*FTXT) {close(FTXT);}

}

if ($webpage) {
    print gen_html("end_table");
    print "<p> <a href=$down_url> Download to Excel </a><p>";
    print 
	$cgi->start_form(-action=>'SaveToTable.cgi'),
	$cgi->textfield(-name=>'fileName', -default=> "Name of your file"),
	$cgi->hidden(-name=> 'realFile', value=>$ftxt_name),
	$cgi->submit('Save to Working Table'),
	$cgi->end_form();
        
    print gen_html("end_html") unless $table_only;
}





#--------------------
#   sub routines
#--------------------


sub check_org {
    my ($data) = @_;
    my @lines = split(/\n/, $data);
    my $rv = 1;
    for (@lines) {
 	if ($_ =~ /^(#orgs=\s*\d+\.\d+)/) {$rv=0;last;}
	elsif ($_ =~ /^\s*([^#]\w+)/) {last;}
    }
    # return true on error
    return $rv;
}

sub get_pegs {
    my ($org, $gene) = @_;
    my ($pegs_index_data) = $fig->search_index($gene);

    my @orgs = split(/[^0-9.]/, $org);

    my @pegs = ();
    for my $g (@orgs) {
	my @hits = grep {/$g/} map {$_->[0]} @$pegs_index_data;
	if ($single_hit && $hits[0]) {@pegs = ($hits[0]); last};
	@pegs = (@pegs, @hits);
    }
    return @pegs;
}

sub get_pdb {
    my ($peg, $domain) = @_;
    my ($pdb, $escore, $pdb_url, $pdb_title) = ();
    my $best_pdb = "$FIG_Config::bin/best_pdb";
    
    $best_pdb = "perl best_pdb.pl" unless (-e $best_pdb);
    $best_pdb = $best_pdb;
    
    ($domain =~ /bound/) && ($domain = "-bound");
    
    ($pdb, $escore, $pdb_url, $pdb_title) = split(/\t/, `$best_pdb $domain '$peg'`);
    chomp($pdb_title);

    return ($pdb, $escore, $pdb_url, $pdb_title);
}

sub get_pass {
    my ($pdb) = @_;
    my ($pass, $pass_maxwgt, $pass_gif, $aug_pdb) = ();
    my $pass_pdb = "$FIG_Config::bin/pass_pdb";
    my $pdb2passinfo = "$FIG_Config::bin/pdb2passinfo";
    
    $pdb2passinfo = "perl pdb2passinfo.pl" unless (-e $pdb2passinfo);
    $pass_pdb = "perl pass_pdb.pl" unless (-e $pass_pdb);
    system "$pass_pdb $pdb";

    my $rv = `$pdb2passinfo $pdb`;
    chomp($rv);
    if ($rv =~ /^No/i) {return (undef, undef, undef, undef);}

    ($pass, $pass_maxwgt, $pass_gif, $aug_pdb) = split(/\t/, $rv);

    return ($pass, $pass_maxwgt, $pass_gif, $aug_pdb);
}

sub get_dist {
    my ($peg, $pdb) = @_;
    my ($peg_len, $pdb_len, $dist) = ();
    my $peg_pdb_dist = "$FIG_Config::bin/peg_pdb_dist";
    
    $peg_pdb_dist = "perl peg_pdb_dist.pl" unless (-e $peg_pdb_dist);

    ($peg_len, $pdb_len, $dist) = split(/\t/, `$peg_pdb_dist -len '$peg' $pdb`);
    chomp($dist);

    return ($peg_len, $pdb_len, $dist);
}

sub get_cons {
    my ($peg) = @_;
    my $get_homo = "$FIG_Config::bin/get_homologs";
    my $aln_cons = "$FIG_Config::bin/aln_conservation";

    $get_homo = "perl get_homologs.pl" unless (-e $get_homo);
    $aln_cons = "perl aln_conservation.pl" unless (-e $aln_cons);

    my $cons = `$get_homo -cons '$peg' | $aln_cons`;
    chomp($cons);

    return $cons;
}

sub get_clibe {
    my ($pdb) = @_;
    my $clibe_db = "$FIG_Config::fig/var/DrugTargets/pdb_ligand_clibe_attribute_detailed.txt";
    $clibe_db = "pdb_ligand_clibe_attribute_detailed.txt" unless (-e $clibe_db);
    my $pdb_key =  ($pdb =~/(\d\w{3})/, $1);

    my $attr = `grep $pdb_key $clibe_db|head -n1`; 
    chomp($attr);
  
    my $url;
    (undef, undef, $attr, $url) = split(/\t/, $attr);

    if ($attr =~ /(.*),TotE(.*),VDWI(.*),HBond(.*),EI(.*),SolE(.*)/) {
	return ($1, $url, $2, $3, $4, $5, $6);
    } else {
	return ();
    }
}

sub gen_html {
    my ($part, @content) = @_;
    my @html;
    if ($part =~ /start_html/i) {
	push @html, "<html>";
	push @html, $cgi->head($cgi->title($content[0]));
	push @html, $cgi->start_body();
    } elsif ($part =~ /end_html/i) {
	push @html, $cgi->end_body();
	push @html, "</html>";
    } elsif ($part =~ /start_table/i) {
	push @html, "<table ID=DrugTargets BORDER=1 width=80%>";
    } elsif ($part =~ /end_table/i) {
	push @html, "</table>";
    } elsif ($part =~ /warning/i) {
	push @html, "<h3><font color=#cc0000>Warning: $content[0]</font></h3>";
    } else {
	my @cols;
	my $s = ($part =~ /header/i) ? "th" : "td";
	push @html, "<tr>";
	for (my $i=0; $i<24; $i++) {$cols[$i] = ($content[$i]) ? $content[$i] : "N/A"};	
	map {$_ = "<$s>$_<\/$s>"} @cols;
	push @html, join(" ", @cols);
	push @html, "</tr>";
    }
    return join("\n", @html) . "\n";
}

sub gen_google_box {
    my $html = '
<table style="font-size:small" align=center>
  <tr> 
    <td rowspan=3>
     <img src="http://groups-beta.google.com/groups/img/groups_medium.gif" height=58 width=150 alt="Google Groups">
    </td>
    <td colspan=2 align=center><b>Subscribe to Microbial Drug Targets</b></td>
  </tr>
  <form action="http://groups-beta.google.com/group/Microbial-Drug-Targets/boxsubscribe">
  <tr> 
    <td>Email: <input type=text name=email></td>
    <td>
      <table>
      <tr>
        <td>
         <input type=submit name="sub" value="Subscribe">
        </td>
      </tr>
      </table>
    </td>
  </tr>
   </form>
  <tr><td colspan=2 align=center>
   <a href="http://groups-beta.google.com/group/Microbial-Drug-Targets">Browse Archives</a> at <a href="http://groups-beta.google.com/">groups-beta.google.com</a>
  </td></tr>
</table>
   ';
    return $html;
}

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3