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

Diff of /FigWebServices/clust_ss.cgi

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1, Sat Feb 16 17:52:36 2008 UTC revision 1.5, Wed Apr 16 00:55:53 2008 UTC
# Line 62  Line 62 
62    
63  if (! $user)  if (! $user)
64  {  {
65      &get_user($fig,$cgi,$html);      &get_user_and_type($fig,$cgi,$html);
66  }  }
67  else  else
68  {  {
69      my $peg = &get_interesting($fig,1);      my $peg = &get_interesting($fig,$cgi,1);
70      if ($peg)      if ($peg)
71      {      {
72          my $url = "http://anno-3.nmpdr.org/anno/FIG/seedviewer.cgi?user=$user&pattern=" . $peg . "&page=SearchResult&action=check_search";          my $url = "http://anno-3.nmpdr.org/anno/FIG/seedviewer.cgi?user=$user&pattern=" . $peg . "&page=SearchResult&action=check_search";
# Line 82  Line 82 
82  &HTML::show_page($cgi,$html);  &HTML::show_page($cgi,$html);
83    
84  sub get_interesting {  sub get_interesting {
85      my($fig,$retry) = @_;      my($fig,$cgi,$retry) = @_;
86    
87        my $just_hypo = $cgi->param('just_hypo');
88        my $restrict  = $cgi->param('restrict');
89      if (open(INTERESTING,"<$FIG_Config::global/interesting.pegs"))      if (open(INTERESTING,"<$FIG_Config::global/interesting.pegs"))
90      {      {
91          my @pegs = <INTERESTING>;          my @pegs = <INTERESTING>;
92          chomp @pegs;          chomp @pegs;
93          close(INTERESTING);          close(INTERESTING);
94    
95          my $tries = 5;          if ($restrict)
96            {
97                @pegs = map  { $_->[0] }
98                        grep { $_->[1] =~ /$restrict/i }
99                        map  { [$_,$fig->genus_species(&FIG::genome_of($_))] }
100                        @pegs;
101            }
102    
103            my $tries = 30;
104          my $peg;          my $peg;
105          while ((! $peg) && $tries)          while ((! $peg) && $tries)
106          {          {
# Line 103  Line 113 
113                  {                  {
114                      $peg = undef;                      $peg = undef;
115                  }                  }
116                    if ($just_hypo && &coupled_to_nonhypo($fig,$peg))
117                    {
118                        $peg = undef;
119                    }
120              }              }
121              $tries--;              $tries--;
122          }          }
# Line 110  Line 124 
124          if ((! $peg) && $retry)          if ((! $peg) && $retry)
125          {          {
126              &clean_interesting($fig);              &clean_interesting($fig);
127              return &get_interesting($fig,0);              return &get_interesting($fig,$cgi,0);
128          }          }
129          else          else
130          {          {
# Line 120  Line 134 
134      return undef;      return undef;
135  }  }
136    
137    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  sub clean_interesting {  sub clean_interesting {
154      my($fig) = @_;      my($fig) = @_;
155    
# Line 130  Line 160 
160          chomp @pegs;          chomp @pegs;
161          close(INTERESTING);          close(INTERESTING);
162    
163          @pegs = grep { &not_in_sub($_) } @pegs;          @pegs = grep { &not_in_sub($fig,$_) } @pegs;
164          open(INTERESTING,">$FIG_Config::global/interesting.pegs")          open(INTERESTING,">$FIG_Config::global/interesting.pegs")
165              || die "could not open $FIG_Config::global/interesting.pegs";              || die "could not open $FIG_Config::global/interesting.pegs";
166          print INTERESTING join("\n",@pegs),"\n";          print INTERESTING join("\n",@pegs),"\n";
# Line 138  Line 168 
168      }      }
169  }  }
170    
171  sub get_user {  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    sub get_user_and_type {
180      my($fig,$cgi,$html) = @_;      my($fig,$cgi,$html) = @_;
181    
182      push(@$html, $cgi->start_form(-action => "clust_ss.cgi",      push(@$html, $cgi->start_form(-action => "clust_ss.cgi",
183                                    -method => 'post'),                                    -method => 'post'),
184                   'User: ',                   'User: ',
185                   $cgi->textfield(-name => "user", -size => 10, -value => ''),                   $cgi->textfield(-name => "user", -size => 10, -value => ''),
186                   $cgi->br,                   "<br>Restrict to genomes matching the pattern: ",
187                     $cgi->textfield(-name => "restrict", -size => 20, -value => ''),
188                     $cgi->br,$cgi->br,
189                     $cgi->checkbox(-name => 'just_hypo', -value => "", -checked => 0, -label => 'just hypothetical'),
190                     $cgi->br,$cgi->br,
191                   $cgi->submit( 'Get PEG to Look at' ),                   $cgi->submit( 'Get PEG to Look at' ),
192                   $cgi->end_form                   $cgi->end_form
193           );           );

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.5

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3