[Bio] / FigWebServices / clust_ss.cgi Repository:
ViewVC logotype

Annotation of /FigWebServices/clust_ss.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.5 - (view) (download)

1 : overbeek 1.1 # -*- perl -*-
2 :     #
3 :     # Copyright (c) 2003-2006 University of Chicago and Fellowship
4 :     # for Interpretations of Genomes. All Rights Reserved.
5 :     #
6 :     # This file is part of the SEED Toolkit.
7 :     #
8 :     # The SEED Toolkit is free software. You can redistribute
9 :     # it and/or modify it under the terms of the SEED Toolkit
10 :     # Public License.
11 :     #
12 :     # You should have received a copy of the SEED Toolkit Public License
13 :     # along with this program; if not write to the University of Chicago
14 :     # at info@ci.uchicago.edu or the Fellowship for Interpretation of
15 :     # Genomes at veronika@thefig.info or download a copy from
16 :     # http://www.theseed.org/LICENSE.TXT.
17 :     #
18 :    
19 :    
20 :     use FIG;
21 :     my $fig = new FIG;
22 :    
23 :     use HTML;
24 :     use strict;
25 :    
26 :     use CGI;
27 :     my $cgi = new CGI;
28 :    
29 :     if (0)
30 :     {
31 :     my $VAR1;
32 :     eval(join("",`cat /tmp/clust_ss_parms`));
33 :     $cgi = $VAR1;
34 :     # print STDERR &Dumper($cgi);
35 :     }
36 :    
37 :     if (0)
38 :     {
39 :     print $cgi->header;
40 :     my @params = $cgi->param;
41 :     print "<pre>\n";
42 :     foreach $_ (@params)
43 :     {
44 :     print "$_\t:",join(",",$cgi->param($_)),":\n";
45 :     }
46 :    
47 :     if (0)
48 :     {
49 :     if (open(TMP,">/tmp/clust_ss_parms"))
50 :     {
51 :     print TMP &Dumper($cgi);
52 :     close(TMP);
53 :     }
54 :     }
55 :     exit;
56 :     }
57 :    
58 :     my $html = [];
59 :     unshift @$html, "<TITLE>Generate Cluster-Based Subsystems</TITLE>\n";
60 :    
61 :     my $user = $cgi->param('user');
62 :    
63 :     if (! $user)
64 :     {
65 : overbeek 1.2 &get_user_and_type($fig,$cgi,$html);
66 : overbeek 1.1 }
67 :     else
68 :     {
69 : overbeek 1.2 my $peg = &get_interesting($fig,$cgi,1);
70 : overbeek 1.1 if ($peg)
71 :     {
72 :     my $url = "http://anno-3.nmpdr.org/anno/FIG/seedviewer.cgi?user=$user&pattern=" . $peg . "&page=SearchResult&action=check_search";
73 :     print $cgi->redirect($url);
74 :     exit;
75 :     }
76 :     else
77 :     {
78 :     push(@$html,$cgi->h1('Could not get a PEG to work on'));
79 :     }
80 :     }
81 :    
82 :     &HTML::show_page($cgi,$html);
83 :    
84 :     sub get_interesting {
85 : overbeek 1.2 my($fig,$cgi,$retry) = @_;
86 : overbeek 1.1
87 : overbeek 1.2 my $just_hypo = $cgi->param('just_hypo');
88 : overbeek 1.3 my $restrict = $cgi->param('restrict');
89 : overbeek 1.1 if (open(INTERESTING,"<$FIG_Config::global/interesting.pegs"))
90 :     {
91 :     my @pegs = <INTERESTING>;
92 :     chomp @pegs;
93 :     close(INTERESTING);
94 : overbeek 1.3
95 :     if ($restrict)
96 :     {
97 :     @pegs = map { $_->[0] }
98 : overbeek 1.5 grep { $_->[1] =~ /$restrict/i }
99 : overbeek 1.3 map { [$_,$fig->genus_species(&FIG::genome_of($_))] }
100 :     @pegs;
101 :     }
102 : overbeek 1.1
103 : overbeek 1.2 my $tries = 30;
104 : overbeek 1.1 my $peg;
105 :     while ((! $peg) && $tries)
106 :     {
107 :     my $i = int(rand() * @pegs);
108 :     if (($i < @pegs) && $fig->is_real_feature($pegs[$i]))
109 :     {
110 :     $peg = $pegs[$i];
111 :     my @subs = grep { $fig->usable_subsystem($_) } $fig->peg_to_subsystems($peg);
112 :     if (@subs > 0)
113 :     {
114 :     $peg = undef;
115 :     }
116 : overbeek 1.2 if ($just_hypo && &coupled_to_nonhypo($fig,$peg))
117 :     {
118 :     $peg = undef;
119 :     }
120 : overbeek 1.1 }
121 :     $tries--;
122 :     }
123 :    
124 :     if ((! $peg) && $retry)
125 :     {
126 :     &clean_interesting($fig);
127 : overbeek 1.5 return &get_interesting($fig,$cgi,0);
128 : overbeek 1.1 }
129 :     else
130 :     {
131 :     return $peg;
132 :     }
133 :     }
134 :     return undef;
135 :     }
136 :    
137 : overbeek 1.2 sub coupled_to_nonhypo {
138 :     my($fig,$peg) = @_;
139 :     my $i;
140 :    
141 :     my @coupled = $fig->coupled_to($peg);
142 :     for ($i=0; ($i < @coupled) && &is_hypo($fig,$coupled[$i]->[0]); $i++) {}
143 :     return ($i < @coupled);
144 :     }
145 :    
146 :     sub is_hypo {
147 :     my($fig,$peg) = @_;
148 :    
149 :     my $func = $fig->function_of($peg);
150 :     return &FIG::hypo($func);
151 :     }
152 :    
153 : overbeek 1.1 sub clean_interesting {
154 :     my($fig) = @_;
155 :    
156 :     if ((-s "$FIG_Config::global/interesting.pegs") &&
157 :     open(INTERESTING,"<$FIG_Config::global/interesting.pegs"))
158 :     {
159 :     my @pegs = <INTERESTING>;
160 :     chomp @pegs;
161 :     close(INTERESTING);
162 :    
163 : overbeek 1.4 @pegs = grep { &not_in_sub($fig,$_) } @pegs;
164 : overbeek 1.1 open(INTERESTING,">$FIG_Config::global/interesting.pegs")
165 :     || die "could not open $FIG_Config::global/interesting.pegs";
166 :     print INTERESTING join("\n",@pegs),"\n";
167 :     close(INTERESTING);
168 :     }
169 :     }
170 :    
171 : overbeek 1.4 sub not_in_sub {
172 :     my($fig,$peg) = @_;
173 :    
174 :     my @tmp = grep { $fig->usable_subsystem($_) } $fig->peg_to_subsystems($peg);
175 :     return (@tmp == 0);
176 :     }
177 :    
178 :    
179 : overbeek 1.2 sub get_user_and_type {
180 : overbeek 1.1 my($fig,$cgi,$html) = @_;
181 :    
182 :     push(@$html, $cgi->start_form(-action => "clust_ss.cgi",
183 :     -method => 'post'),
184 :     'User: ',
185 :     $cgi->textfield(-name => "user", -size => 10, -value => ''),
186 : overbeek 1.3 "<br>Restrict to genomes matching the pattern: ",
187 :     $cgi->textfield(-name => "restrict", -size => 20, -value => ''),
188 : overbeek 1.2 $cgi->br,$cgi->br,
189 :     $cgi->checkbox(-name => 'just_hypo', -value => "", -checked => 0, -label => 'just hypothetical'),
190 :     $cgi->br,$cgi->br,
191 : overbeek 1.1 $cgi->submit( 'Get PEG to Look at' ),
192 :     $cgi->end_form
193 :     );
194 :    
195 :     }

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3