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

Annotation of /FigWebServices/comp_MR.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.3 - (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 HTML;
21 :     use strict;
22 :    
23 :     use CGI;
24 :     my $cgi = new CGI;
25 :    
26 :     if (0)
27 :     {
28 :     my $VAR1;
29 :     eval(join("",`cat /tmp/compMR_parms`));
30 :     $cgi = $VAR1;
31 :     # print STDERR &Dumper($cgi);
32 :     }
33 :    
34 :     if (0)
35 :     {
36 :     print $cgi->header;
37 :     my @params = $cgi->param;
38 :     print "<pre>\n";
39 :     foreach $_ (@params)
40 :     {
41 :     print "$_\t:",join(",",$cgi->param($_)),":\n";
42 :     }
43 :    
44 :     if (0)
45 :     {
46 :     if (open(TMP,">/tmp/compMR_parms"))
47 :     {
48 :     print TMP &Dumper($cgi);
49 :     close(TMP);
50 :     }
51 :     }
52 :     exit;
53 :     }
54 :    
55 :     my $genome1 = $cgi->param('genome1');
56 :     my $genome2 = $cgi->param('genome2');
57 :     my $request = $cgi->param('request');
58 :    
59 :     use CompareMR;
60 :     use FIG;
61 :     use FIGV;
62 :    
63 : overbeek 1.2 my($fig,$use_figV);
64 : overbeek 1.1 if ($genome1 =~ /^\d+\.\d+/)
65 :     {
66 :     $fig = new FIG;
67 : overbeek 1.2 $use_figV = 0;
68 : overbeek 1.1 }
69 :     elsif (($genome1 =~ /\d+\.\d+$/) && (-d $genome1))
70 :     {
71 :     my $tmp = new FIG;
72 :     $fig = new FIGV($genome1,$tmp);
73 : overbeek 1.2 $use_figV = 1;
74 : overbeek 1.1 }
75 :    
76 :     my($common,$in1_not2,$in2_not1) = &CompareMR::compare_genomes_MR($genome1,$genome2);
77 :    
78 :     my $html = [];
79 :    
80 :     if ($request eq "common")
81 :     {
82 : paarmann 1.3 push @$html, "<h2>Showing common pegs between $genome1 and $genome2</h2>";
83 : overbeek 1.2 &process_data($fig,$cgi,$html,$common,$use_figV);
84 :     }
85 :     elsif ($request eq "in1_not2")
86 :     {
87 : paarmann 1.3 push @$html, "<h2>Showing pegs in $genome1, but not in $genome2</h2>";
88 : overbeek 1.2 &process_data($fig,$cgi,$html,$in1_not2,$use_figV);
89 :     }
90 :     elsif ($request eq "in2_not1")
91 :     {
92 : paarmann 1.3 push @$html, "<h2>Showing pegs in $genome2, but not in $genome1</h2>";
93 : overbeek 1.2 &process_data($fig,$cgi,$html,$in2_not1,0);
94 : overbeek 1.1 }
95 : paarmann 1.3 elsif ($request eq "find_similar_pegs") {
96 :     &find_similar_pegs($fig, $cgi, $html,$use_figV);
97 :     }
98 : overbeek 1.1 unshift @$html, "<TITLE>Compare Metabolic Reconstructions</TITLE>\n";
99 :    
100 :     &HTML::show_page($cgi,$html);
101 :    
102 : overbeek 1.2 sub process_data {
103 :     my($fig,$cgi,$html,$data,$use_figV) = @_;
104 : overbeek 1.1 my($tuple,$sub,$role,$pegs1,$pegs2,$classification,$class1,$class2);
105 :     my($key,%subH,$subH1,$subH2,$subH3,@roles,$subL,$pegL,$peg);
106 :    
107 : overbeek 1.2 foreach $tuple (@$data)
108 : overbeek 1.1 {
109 : overbeek 1.2 ($sub,$role,$pegs1) = @$tuple;
110 : overbeek 1.1 $classification = $fig->subsystem_classification($sub);
111 :     $class1 = $classification->[0] || "Unclassified";
112 :     $class2 = $classification->[1] || "Unclassified";
113 :     $subH{$class1}->{$class2}->{$sub}->{$role} = [$pegs1,$pegs2];
114 :     }
115 :    
116 :     foreach $class1 (sort keys(%subH))
117 :     {
118 :     $subH1 = $subH{$class1};
119 :     push(@$html,"<h1>$class1</h1>\n");
120 :     foreach $class2 (sort keys(%$subH1))
121 :     {
122 :     $subH2 = $subH1->{$class2};
123 :     push(@$html,"<h2>$class2</h2>\n");
124 :     foreach $sub (sort keys(%$subH2))
125 :     {
126 : overbeek 1.2 if ($use_figV)
127 :     {
128 :     $subL = &sub_P1K_link($cgi,$sub);
129 :     }
130 :     else
131 :     {
132 :     $subL = &HTML::sub_link($cgi,$sub);
133 :     }
134 : overbeek 1.1 $subH3 = $subH2->{$sub};
135 :     push(@$html,"<h3>$subL</h3>\n");
136 :     push(@$html,"<ul>\n");
137 :     foreach $role (sort keys(%$subH3))
138 :     {
139 :     push(@$html,"<li>$role\n");
140 :     ($pegs1,$pegs2) = @{$subH3->{$role}};
141 :     push(@$html,"<ul>\n");
142 :    
143 :     foreach $peg (sort { &FIG::by_fig_id($a,$b) } @$pegs1)
144 :     {
145 : paarmann 1.3 $pegL = &peg_P1K_link($cgi,$fig,$peg, $use_figV);
146 :    
147 :     push(@$html,"<li>$pegL\n");
148 :    
149 :     if ($cgi->param('request') eq 'in1_not2' or
150 :     $cgi->param('request') eq 'in2_not1') {
151 :     push(@$html, &peg_find_similar_link($cgi,$fig, $peg));
152 : overbeek 1.2 }
153 : paarmann 1.3
154 : overbeek 1.1 }
155 :     push(@$html,"</ul>\n");
156 :     }
157 :     push(@$html,"</ul>\n");
158 :     }
159 :     }
160 :     }
161 :     }
162 :    
163 : paarmann 1.3 sub peg_link {
164 :     my ($cgi, $fig, $use_figV, $peg) = @_;
165 :     if ($use_figV) {
166 :     return &peg_P1K_link($cgi,$fig,$peg);
167 :     }
168 :     else {
169 :     return &HTML::fid_link($cgi,$peg);
170 :     }
171 :     }
172 :    
173 :     sub peg_find_similar_link {
174 :     my($cgi,$fig,$peg) = @_;
175 :     return '&nbsp; <a target="find_similar_pegs" href="?genome1='.$cgi->param('genome1').
176 :     '&genome2='.$cgi->param('genome2').'&request=find_similar_pegs&peg='.
177 :     $peg.'">find similar pegs</a>';
178 :     }
179 :    
180 : overbeek 1.2 sub peg_P1K_link {
181 :     my($cgi,$fig,$peg) = @_;
182 : overbeek 1.1
183 : paarmann 1.3 $fig->organism_directory =~ /(\d+)\/rp\/\d+\.\d+$/;
184 :     return "<a target='seedviewer' href='".$FIG_Config::seedviewer_url.
185 :     "?action=ShowAnnotation&prot=$peg&job=$1'>$peg</a>";
186 :    
187 : overbeek 1.2 }
188 :    
189 :     sub sub_P1K_link {
190 :     my($cgi,$sub) = @_;
191 : paarmann 1.3
192 :     $fig->organism_directory =~ /(\d+)\/rp\/\d+\.\d+$/;
193 :     return "<a target='seedviewer' href='".$FIG_Config::seedviewer_url.
194 :     "?action=ShowSubsystem&subsystem_name=$sub&job=$1'>$sub</a>";
195 :    
196 : overbeek 1.2 return $sub;
197 :     }
198 : paarmann 1.3
199 :    
200 :     sub find_similar_pegs {
201 :     my ($fig, $cgi, $html, $use_figV) = @_;
202 :    
203 :     my $peg = $cgi->param('peg');
204 :     my @sims = $fig->sims($peg, 50, 1.0e-20, 'fig');
205 :    
206 :     $cgi->param('genome1') =~ /(\d+\.\d+)/;
207 :     my $genome1 = $1;
208 :     $cgi->param('genome2') =~ /(\d+\.\d+)/;
209 :     my $genome2 = $1;
210 :    
211 :     $peg =~ /fig\|(\d+\.\d+)\./;
212 :     my $source = $1;
213 :     my $target = ($genome1 eq $source) ? $genome2 : $genome1;
214 :    
215 :     push(@$html, "<h2>Showing similar pegs from $target for $peg</h2>");
216 :     my @table;
217 :     foreach (@sims) {
218 :     $_->[1] =~ /fig\|(\d+\.\d+)\./;
219 :     if ($1 eq $target) {
220 :    
221 :     unless (@table) {
222 :     push @table, [ &peg_link($cgi, $fig, $use_figV, $peg),
223 :     $fig->function_of($peg), '100.00', 'n/a', 'n/a' ];
224 :     }
225 :     push @table, [ &peg_link($cgi, $fig, $use_figV, $_->[1]),
226 :     $fig->function_of($_->[1]), $_->[2], $_->[10], $_->[11] ];
227 :     last if (scalar(@table) == 3);
228 :     }
229 :     }
230 :     if (scalar(@table)) {
231 :     push @$html, &HTML::make_table( ['Id', 'Function', '% Identity', 'E-value', 'Bitscore' ], \@table );
232 :     }
233 :     else {
234 :     push @$html, '<p>No similar pegs found.</p>';
235 :     }
236 :     }

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3