[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.4 - (view) (download)

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3