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

Annotation of /FigWebServices/select.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.15 - (view) (download)

1 : overbeek 1.1
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 :     ### start
20 :    
21 :     use FIG;
22 :     use FIG_CGI;
23 :     use CGI::Carp qw(fatalsToBrowser); # this makes debugging a lot easier by throwing errors out to the browser
24 :    
25 :     use strict;
26 :     use Tracer;
27 :     use FIGjs qw( toolTipScript );
28 :     use HTML;
29 :    
30 :     my($fig, $cgi, $user);
31 :    
32 :     eval {
33 :     ($fig, $cgi, $user) = FIG_CGI::init(debug_save => 0,
34 :     debug_load => 0,
35 :     print_params => 0);
36 :     };
37 : parrello 1.15
38 : overbeek 1.1 if ($@ ne "")
39 :     {
40 :     my $err = $@;
41 :    
42 :     my(@html);
43 :    
44 :     push(@html, $cgi->p("Error connecting to SEED database."));
45 :     if ($err =~ /Could not connect to DBI:.*could not connect to server/)
46 :     {
47 :     push(@html, $cgi->p("Could not connect to relational database of type $FIG_Config::dbms named $FIG_Config::db on port $FIG_Config::dbport."));
48 :     }
49 :     else
50 :     {
51 :     push(@html, $cgi->pre($err));
52 :     }
53 :     &HTML::show_page($cgi, \@html, 1);
54 :     exit;
55 :     }
56 :    
57 :     Trace("Connected to FIG.") if T(2);
58 :    
59 :     my $html = [];
60 :     unshift @$html, "<TITLE>The SEED Selected Collections</TITLE>\n";
61 :     my $userhtml;
62 :     if ($user) {$userhtml=$cgi->hidden(-name=>"user")} else {$userhtml=$cgi->p("Please enter your username: ", $cgi->textfield(-name=>"user", -size=>30))}
63 :    
64 : overbeek 1.2 my $allss; # a global variable that has all subsystems and genomes so we don't have to reload them each time
65 : overbeek 1.1 if ($cgi->param("add_and_delete"))
66 :     {
67 :     $html=&add_and_delete($cgi, $html);
68 :     $html=choose_genomes($cgi, $html);
69 :     }
70 :     elsif ($cgi->param("choose_genomes"))
71 :     {
72 :     $html=choose_genomes($cgi, $html);
73 :     }
74 :     else
75 :     {
76 :     $html=&show_initial($cgi, $html);
77 :     }
78 :    
79 :     &HTML::show_page($cgi,$html,1);
80 :     exit;
81 :    
82 :     sub choose_genomes {
83 :     my ($cgi, $html)=@_;
84 :    
85 :     my $collection=&collection($cgi);
86 :    
87 : parrello 1.14 # Get the objects in this collection.
88 : overbeek 1.1 my %got;
89 : parrello 1.14 my %gotss;
90 :     my @data = $fig->get_attributes(undef, 'collection', $collection);
91 :     for my $dataRow (@data) {
92 :     if ($dataRow->[0] =~ /^\d+\.\d+$/) {
93 :     $got{$dataRow->[0]} = 1;
94 :     } else {
95 :     $gotss{$dataRow->[0]} = 1;
96 :     }
97 :     }
98 : overbeek 1.1 # now find all other genomes
99 :     my @missinggenomes=grep {!$got{$_}} $fig->genomes("Complete");
100 :     my $gs;
101 :     map {$gs->{$_}=$fig->genus_species($_)} @missinggenomes, keys %got;
102 :    
103 : parrello 1.14 # now define the subsystems that we want
104 : overbeek 1.1 my @missingss = grep {!$gotss{$_}} $fig->all_subsystems;
105 :    
106 :     my $sslabels;
107 :     map {$sslabels->{$_}=$_; $sslabels->{$_}=~s/\_/ /g} @missingss, keys %gotss;
108 :    
109 : parrello 1.14 Trace(join(" :: ", "GOT SS HAS KEYS", keys %gotss, "\nVALUES\n", values %gotss, "\n")) if T(3);
110 : overbeek 1.1
111 :     push @$html,
112 :     $cgi->start_form(),
113 :     $cgi->hidden(-name=>"selection"),
114 :     $userhtml,
115 :     $cgi->h2("Selected Genomes For ", &collection_name($cgi)),
116 :     $cgi->p("These are the genomes and subsystems that are currently chosen for <b>", &collection_name($cgi), "</b>:"),
117 :     $cgi->div({class=>"help"}, "The lists on the left show the selected genomes and subsystems, and the lists on the right show the remaining ones. To remove from the selected lists, highlight one or more genomes and/or subsystems on the left and click the \"Add and Delete Genomes and Subsystems\" button. To add genomes, highlight one or more genomes and/or subsystems on the right, and click the same button."),
118 :     "<table>\n<tr>\n<th>Selected Genomes (", scalar(keys %got), " total)</th><th>Remaining Genomes (", scalar(@missinggenomes), " total)</th></tr>",
119 :     "<tr><td>\n",
120 :     $cgi->scrolling_list( -name => 'got_genomes',
121 :     -values => [sort {$gs->{$a} cmp $gs->{$b}} keys %got],
122 :     -labels => $gs,
123 :     -size => 10,
124 :     -multiple => 1,
125 :     -defaults => [],
126 :     ), "\n</td><td>\n",
127 :     $cgi->scrolling_list( -name => 'other_genomes',
128 :     -values => [sort {$gs->{$a} cmp $gs->{$b}} @missinggenomes],
129 :     -labels => $gs,
130 :     -size => 10,
131 :     -multiple => 1,
132 :     -defaults => [],
133 :     ), "\n",
134 :     "</td></tr>\n",
135 :     "<tr><th>Selected Subsystems (", scalar(keys %gotss), " total)</th><th>Remaining Subsystems (", scalar(@missingss), " total)</th></tr>\n",
136 :     "<tr><td>\n",
137 :     $cgi->scrolling_list( -name => 'got_subsystems',
138 : overbeek 1.7 -values => [sort {uc($sslabels->{$a}) cmp uc($sslabels->{$b})} keys %gotss],
139 : overbeek 1.1 -labels => $sslabels,
140 :     -size => 10,
141 :     -multiple => 1,
142 :     -defaults => [],
143 :     ), "\n</td><td>\n",
144 :     $cgi->scrolling_list( -name => 'other_subsystems',
145 : overbeek 1.7 -values => [sort {uc($sslabels->{$a}) cmp uc($sslabels->{$b})} @missingss],
146 : overbeek 1.1 -labels => $sslabels,
147 :     -size => 10,
148 :     -multiple => 1,
149 :     -defaults => [],
150 :     ), "\n</td></tr>\n</table>",
151 :     $cgi->p, $cgi->submit("update", "Return to Table"), $cgi->submit("add_and_delete", "Add and Delete Genomes and Subsystems"), $cgi->reset,
152 :     $cgi->end_form;
153 :    
154 :     return $html;
155 :     }
156 :    
157 :    
158 :    
159 :    
160 :     sub add_and_delete {
161 :     my ($cgi, $html)=@_;
162 :     foreach my $genome ($cgi->param("got_genomes"))
163 :     {
164 :     # these are the ones to DELETE
165 : parrello 1.14 $fig->delete_attribute($genome, 'collection', &collection($cgi));
166 : overbeek 1.1 push @$html, $cgi->h3("Genome ". $fig->genus_species($genome) . " ($genome) was <i>DELETED FROM</i> the Selected list\n");
167 :     }
168 :     foreach my $genome ($cgi->param("other_genomes"))
169 :     {
170 :     # these are the ones to ADD
171 : parrello 1.14 $fig->add_attribute($genome, 'collection', &collection($cgi));
172 : overbeek 1.1 push @$html, $cgi->h3("Genome ". $fig->genus_species($genome) . " ($genome) was <i>ADDED TO</i> the Selected list\n");
173 :     }
174 :     foreach my $subsystem ($cgi->param("got_subsystems"))
175 :     {
176 :     # these are the ones to DELETE
177 : overbeek 1.8 next unless ($subsystem);
178 : redwards 1.12 my $coll=&collection($cgi);
179 :     next unless ($coll);
180 : parrello 1.14 $fig->delete_attribute($subsystem, 'collection', $coll);
181 : overbeek 1.1 push @$html, $cgi->h3("Subsystem $subsystem was <i>DELETED FROM</i> the Selected list\n");
182 :     }
183 :     foreach my $subsystem ($cgi->param("other_subsystems"))
184 :     {
185 :     # these are the ones to ADD
186 : overbeek 1.8 next unless ($subsystem);
187 : redwards 1.12 my $coll=&collection($cgi);
188 :     next unless ($coll);
189 : parrello 1.14 $fig->add_attribute($subsystem, 'collection', $coll);
190 : overbeek 1.1 push @$html, $cgi->h3("Subsystem $subsystem was <i>ADDED TO</i> the Selected list\n");
191 :     }
192 :    
193 :     return $html;
194 :     }
195 :    
196 :    
197 :     sub show_initial {
198 :     my ($cgi, $html)=@_;
199 :    
200 :     # what are our genomes and our subsystems?
201 :     my %genomes;
202 :     my %ss;
203 : parrello 1.14 my $collection = &collection($cgi);
204 :     Trace("Searching for $collection.") if T(3);
205 :     my @data = $fig->get_attributes(undef, 'collection', $collection);
206 :     Trace(scalar(@data) . " rows found for collection attribute $collection.") if T(3);
207 :     for my $dataRow (@data) {
208 :     if ($dataRow->[0] =~ /^\d+\.\d+$/) {
209 :     $genomes{$dataRow->[0]} = 1;
210 :     } else {
211 :     # there is a weird problem where sometimes the keys have spaces in their names, which of course they should not
212 :     # so in this klutz, I convert them all the real ss names without spaces, and then I make a hash with those where
213 :     # the values are the names with underscores converted back to spaces. oy.
214 :     my $ssName = $dataRow->[0];
215 :     $ssName =~ s/\s+/_/g;
216 :     my $ssKey = $ssName;
217 :     $ssName =~ s/\_/ /g;
218 :     $ss{$ssKey} = $ssName;
219 :     }
220 :     }
221 :     Trace("Sorting genomes.") if T(3);
222 : overbeek 1.1 my @genomes=sort {$fig->genus_species($a) cmp $fig->genus_species($b)} keys %genomes;
223 :    
224 :     my $result;
225 : parrello 1.14 Trace("Formatting table.") if T(3);
226 : overbeek 1.1 my $tab=[];
227 :     my $colhdrs=["Subsystem", map {$fig->genus_species($_). " ($_)"} @genomes];
228 : redwards 1.13 for (my $i=21; $i<=@$colhdrs; $i+=20) {splice(@$colhdrs, $i, 0, "<b>Subsystem</b>"); $i++}
229 : overbeek 1.4 my $in_table_hdrs;
230 :     map {push @$in_table_hdrs, [$_, "th "]} @$colhdrs;
231 :     my $rowcount=0;
232 : parrello 1.14 my $displayby = $cgi->param("displayby");
233 : overbeek 1.1 foreach my $sub (sort {$ss{$a} cmp $ss{$b}} keys %ss)
234 :     {
235 : parrello 1.14 Trace("Reading $sub.") if T(3);
236 :     my $subObject = ($displayby ? $fig->get_subsystem($sub) : undef);
237 :     Trace("Processing row $rowcount.") if T(3);
238 : overbeek 1.1 my $row=[&HTML::sub_link($cgi, $sub)];
239 :     my %gss;
240 : parrello 1.14 Trace("GSS Loop for subsystem $sub.") if T(3);
241 : overbeek 1.1 foreach my $sg ($fig->subsystem_genomes($sub, 1)) {map {$gss{$_->[0]}=1} @$sg}
242 : parrello 1.14 Trace("Genome Loop.") if T(3);
243 : overbeek 1.1 foreach my $genome (@genomes)
244 :     {
245 : overbeek 1.2 my $rolecount;
246 : parrello 1.14 Trace("Processing $genome.") if T(3);
247 : overbeek 1.2 if ($gss{$genome})
248 :     {
249 : parrello 1.14 if ($displayby eq "frs") {$rolecount=&rolecount($subObject, $genome)}
250 :     elsif ($displayby eq "pegs") {$rolecount=&pegcount($subObject, $genome)}
251 : overbeek 1.2 else {$rolecount=&variantcode($sub, $genome)}
252 : overbeek 1.1 }
253 : overbeek 1.10 if (defined $rolecount && $rolecount) {push @$row, $rolecount}
254 :     elsif (defined $rolecount) {push @$row, [$rolecount, "td bgcolor='#FFCCCC'"]}
255 :     else {push @$row, [" &nbsp; ", "td bgcolor='#CCCCFF'"]}
256 : overbeek 1.1 }
257 : parrello 1.14 Trace("Splice Loop.") if T(3);
258 : overbeek 1.5 # splice in the row breaks every 20 horizontal positions
259 :     for (my $i=21; $i<=@$row; $i+=20) {splice(@$row, $i, 0, &HTML::sub_link($cgi, $sub)); $i++}
260 : overbeek 1.1 push @$tab, $row;
261 : overbeek 1.4 $rowcount++;
262 :     unless ($rowcount % 20) {push @$tab, $in_table_hdrs}
263 : overbeek 1.1 }
264 : parrello 1.14 Trace("$rowcount rows processed.") if T(3);
265 : overbeek 1.2 my %displayby=(
266 :     "frs" => "Number of Functional Roles",
267 :     "pegs" => "Number of pegs",
268 :     "vc" => "Variant code",
269 :     );
270 : overbeek 1.8
271 :    
272 :     my %excelfile;
273 :     if ($cgi->param('create_excel')) {$excelfile{excelfile}=&collection($cgi)}
274 : parrello 1.14 Trace("Creating html.") if T(3);
275 : overbeek 1.1 push @$html,
276 :     $cgi->h2("Subsystem coverage for selected genomes and subsystems"),
277 :     $cgi->p("The table below shows the number of <i>functional roles</i> each genome has in each subsystem<br />\n",
278 :     "(i.e. the number of cells that have one or more pegs in them)."),
279 :     $cgi->start_form,
280 : overbeek 1.2 $cgi->p($userhtml),
281 :     $cgi->p("Please choose a collection to manage: ", &select_collection($cgi)),
282 :     $cgi->p("Please choose the output to display: ", $cgi->popup_menu(-name=>"displayby", -values=>[keys %displayby], -labels=>\%displayby, -default=>"vc")),
283 :     $cgi->submit("update", "Update Table"), $cgi->submit("add_and_delete", "Add and Delete Genomes or Subsystems"),
284 : overbeek 1.8 &HTML::make_table($colhdrs, $tab, "Number of Roles Per Genome", %excelfile),
285 : overbeek 1.11 $cgi->submit("create_excel", "Create excel file"), $cgi->submit("update", "Update Table"), $cgi->submit("add_and_delete", "Add and Delete Genomes or Subsystems"),
286 : overbeek 1.1 $cgi->div({class=>"diagnostic"}, $result),
287 :     $cgi->end_form();
288 :    
289 :     return $html;
290 :     }
291 :    
292 :    
293 :     =head2 collection()
294 :    
295 :     Get or set the current selection that we are using. If selection is provided we will use that.
296 :    
297 :     =cut
298 :    
299 :     sub collection {
300 :     my ($cgi, $sel)=@_;
301 :    
302 :     if ($sel) {$cgi->param("selection", $sel)}
303 :    
304 :     $sel=$cgi->param("selection");
305 :     unless ($sel) {$sel="hundred_hundred"}
306 :     return $sel;
307 :     }
308 :    
309 : overbeek 1.6 sub options {
310 : overbeek 1.1 my %options=(
311 : overbeek 1.6 "higher_plants" => "Higher Plants",
312 :     "eukaryotic_ps" => "Photosynthetic Eukaryotes",
313 :     "nonoxygenic_ps" => "Anoxygenic Phototrophs",
314 :     "hundred_hundred" => "Hundred by a hundred",
315 :     "functional_coupling_paper" => "Functional Coupling Paper",
316 : overbeek 1.9 "ecoli_essentiality_paper" => "E. coli Essentiality Paper",
317 : overbeek 1.6 );
318 : overbeek 1.1 }
319 :    
320 :     sub collection_name {
321 :     my ($cgi)=@_;
322 :     my $sel=&collection($cgi);
323 : overbeek 1.6 my %options=&options();
324 : overbeek 1.1 return $options{$sel}
325 :     }
326 :    
327 : overbeek 1.6 sub select_collection {
328 :     my ($cgi)=@_;
329 :     my %options=&options;
330 :     return $cgi->popup_menu(-name=>"selection", -values=>[keys %options], -default=>&collection($cgi), -labels=>\%options);
331 :     }
332 :    
333 : overbeek 1.1
334 : overbeek 1.2 sub rolecount {
335 :     my ($sub, $genome)=@_;
336 :     my $rolecount=0;
337 : parrello 1.14 foreach my $role ($sub->get_roles())
338 : overbeek 1.2 {
339 : parrello 1.14 my @roles = grep { ! $fig->is_deleted_fid($_) } $sub->get_pegs_from_cell($genome, $role);
340 :     $rolecount++ if (@roles);
341 : overbeek 1.2 }
342 :     return $rolecount;
343 :     }
344 :    
345 :    
346 :     sub pegcount {
347 :     my ($sub, $genome)=@_;
348 :     my $rolecount=0;
349 : parrello 1.14 foreach my $role ($sub->get_roles())
350 : overbeek 1.2 {
351 : parrello 1.14 my @roles = grep { ! $fig->is_deleted_fid($_) } $sub->get_pegs_from_cell($genome, $role);
352 :     $rolecount+= scalar(@roles);
353 : overbeek 1.2 }
354 :     return $rolecount;
355 :     }
356 :    
357 : overbeek 1.1
358 : overbeek 1.2 sub variantcode {
359 :     my ($sub, $genome)=@_;
360 : parrello 1.14 my $retVal;
361 :     if (defined $allss->{$genome}) {
362 :     $retVal = $allss->{$genome}->{$sub};
363 :     } else {
364 :     Trace("Active subsystem search for $genome.") if T(3);
365 :     $allss->{$genome} = $fig->active_subsystems($genome, 1);
366 :     $retVal = $allss->{$genome}->{$sub};
367 :     }
368 :     Trace("Returning \"$retVal\" for $genome in $sub.") if T(3);
369 :     return $retVal;
370 : overbeek 1.2 }

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3