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

Annotation of /FigWebServices/status_of_model.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.5 - (view) (download)

1 : overbeek 1.1 # -*- perl -*-
2 : olson 1.5 #
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 : overbeek 1.1
20 :     # This is in a highly-unfinished state. I will work on it more
21 :     # once people become available to make their desires known.
22 :    
23 :     use FIG;
24 :     my $fig = new FIG;
25 :     my $cgi = new CGI;
26 :     use HTML;
27 :    
28 : overbeek 1.2 if (0) {
29 : overbeek 1.1 my $VAR1;
30 :     eval(join("",`cat /tmp/som_parms`));
31 :     $cgi = $VAR1;
32 :     # print STDERR &Dumper($cgi);
33 :     }
34 :    
35 :     if (0) {
36 :     print $cgi->header;
37 :     my @params = $cgi->param;
38 :     print "<pre>\n";
39 :     foreach $_ (@params) {
40 :     print "$_\t:",join(",",$cgi->param($_)),":\n";
41 :     }
42 :    
43 :     if (0) {
44 :     if (open(TMP,">/tmp/som_parms")) {
45 :     print TMP &Dumper($cgi);
46 :     close(TMP);
47 :     }
48 :     }
49 :     exit;
50 :     }
51 :    
52 :     my $html = [];
53 :    
54 :     my $model = $cgi->param('model');
55 : overbeek 1.3 if ($model && ($model =~ /(\d+\.\d+)/) && ($model = $1) && (-s "$FIG_Config::global/Models/$model"))
56 : overbeek 1.1 {
57 :     &som($fig,$cgi,$html,$model);
58 :     }
59 :     else
60 :     {
61 :     &poss_models($fig,$cgi,$html);
62 :     }
63 :     &HTML::show_page($cgi,$html);
64 :    
65 :     sub poss_models {
66 :     my($fig,$cgi,$html) = @_;
67 :    
68 :     my $user = $cgi->param('user');
69 :     if (opendir(MODELS,"$FIG_Config::global/Models") &&
70 :     (@models = grep { ($_ !~ /^\./) && (-s "$FIG_Config::global/Models/$_") } readdir(MODELS)) &&
71 :     (@models > 0))
72 :     {
73 :     my @orgs = sort map { $_ =~ /^(\d+\.\d+)/;
74 :     my $org = $1;
75 :     my $gs = $fig->genus_species($org);
76 :     "$gs ($org)"
77 :     } @models;
78 :     push(@$html,$cgi->hr,
79 :     $cgi->start_form(-action => "status_of_model.cgi"),
80 :     $cgi->hidden(-name => 'user', -value => $user),
81 :     $cgi->scrolling_list( -name => 'model',
82 :     -values => [ @orgs ],
83 :     -size => 10,
84 :     ), $cgi->br,
85 :     $cgi->submit('Status of Model'),
86 :     $cgi->end_form
87 :     );
88 :     }
89 :     else
90 :     {
91 :     push(@$html,$cgi->h1('Sorry, no PEGs for Models in this SEED'));
92 :     }
93 :     }
94 :    
95 :    
96 :     # I accumulate all the connections and then do nothing
97 :     # with them. I will end up using them, I think
98 :    
99 :     sub som {
100 :     my($fig,$cgi,$html,$model) = @_;
101 :     my(@pegs,$genome,$peg,@in,$tuple,$subsys,$role,@poss,$subsystem,$variant);
102 :     my($reactions,$reaction,%peg2react,%react2peg);
103 :    
104 :     @pegs = map { ($_ =~ /(fig\|\d+\.\d+\.peg\.\d+)/) ? $1 : () } `cat $FIG_Config::global/Models/$model`;
105 :     if (@pegs < 1)
106 :     {
107 :     push(@$html,$cgi->h1("Too few PEGs in model for $model"));
108 :     }
109 :     else
110 :     {
111 :     $genome = &FIG::genome_of($pegs[0]);
112 :    
113 :     foreach $peg (@pegs)
114 :     {
115 :     @in = $fig->peg_to_roles_in_subsystems($peg);
116 :     foreach $tuple (@in)
117 :     {
118 :     ($subsys,$role) = @$tuple;
119 :     push(@poss,[$peg,$subsys,$role]);
120 :     $to_check{$subsys}->{$role} = 1;
121 :     }
122 :     }
123 :    
124 :     foreach $subsys (keys(%to_check))
125 :     {
126 :     if (($subsystem = new Subsystem($subsys,$fig,0)) &&
127 :     ($variant = $subsystem->get_variant_code_for_genome($genome)) &&
128 :     ($variant && ($variant ne "-1")))
129 :     {
130 :     if ($reactions = $subsystem->get_reactions)
131 :     {
132 :     foreach $role (keys(%{$to_check{$subsys}}))
133 :     {
134 :     if (($reactions->{$role}))
135 :     {
136 :     my @pegs = $subsystem->get_pegs_from_cell($genome,$role);
137 :     foreach $reaction (@{$reactions->{$role}})
138 :     {
139 :     foreach $peg (@pegs)
140 :     {
141 :     $peg2react{$peg}->{$reaction} = 1;
142 :     push(@{$react2peg{$reaction}->{$peg}},[$subsys,$role]);
143 :     }
144 :     }
145 :     }
146 :     }
147 :     }
148 :     }
149 :     }
150 :     &display_connections($fig,$cgi,$html,\@pegs,\%peg2react,\%react2peg);
151 :     }
152 :     }
153 :    
154 :     sub display_connections {
155 :     my($fig,$cgi,$html,$pegs,$peg2react,$react2peg) = @_;
156 :     my($peg,$func);
157 :    
158 : overbeek 1.2 my $col_hdrs = ["PEG","function","Curator","Subsystem","Role"];
159 : overbeek 1.1 my $tab = [];
160 : overbeek 1.2 my $tot = @$peg;
161 :    
162 :     my $unconnected = 0;
163 :    
164 : overbeek 1.1 foreach $peg (sort { &FIG::by_fig_id($a,$b) } @$pegs)
165 :     {
166 : overbeek 1.2 $tot++;
167 : overbeek 1.1 if (! $peg2react->{$peg})
168 :     {
169 : overbeek 1.2 $unconnected++;
170 : overbeek 1.1 $func = $fig->function_of($peg);
171 : overbeek 1.2 @in = $fig->peg_to_roles_in_subsystems($peg);
172 :     if ($tuple = shift @in)
173 :     {
174 :     ($subsys,$role) = @$tuple;
175 :     $cur = $fig->subsystem_curator($subsys);
176 :     }
177 :     else
178 :     {
179 :     $cur = $subsys = $role = "&nbsp;";
180 :     }
181 : dejongh 1.4 push(@$tab,[&HTML::fid_link($cgi,$peg),$func,$cur,$subsys,$role]);
182 : overbeek 1.2
183 :     foreach $tuple (@in)
184 :     {
185 :     ($subsys,$role) = @$tuple;
186 :     push(@$tab,["","",$fig->subsystem_curator($subsys),$subsys,$role]);
187 :     }
188 : overbeek 1.1 }
189 :     }
190 :     push(@$html,&HTML::make_table($col_hdrs,$tab,"PEGs that do not yet connect"));
191 : overbeek 1.2 $connected = $tot - $unconnected;
192 :     push(@$html,"<hr><b>total PEGs=$tot<br>unconnected=$unconnected<br>connected=$connected<br><hr>");
193 : overbeek 1.1 }
194 :    

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3