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

Annotation of /FigWebServices/subsys_summary.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (view) (download)

1 : redwards 1.1
2 :     =pod
3 :    
4 :     =head1
5 :    
6 :     Create a summary of subsystems
7 :    
8 :     =cut
9 :    
10 :     use strict;
11 :     use FIG;
12 :     use HTML;
13 :     use raelib;
14 :     use CGI;
15 :     my $cgi=new CGI;
16 :    
17 :    
18 :     my $fig;
19 :     eval {
20 :     $fig = new FIG;
21 :     };
22 :    
23 :     if ($@ ne "")
24 :     {
25 :     my $err = $@;
26 :    
27 :     my(@html);
28 :    
29 :     push(@html, $cgi->p("Error connecting to SEED database."));
30 :     if ($err =~ /Could not connect to DBI:.*could not connect to server/)
31 :     {
32 :     push(@html, $cgi->p("Could not connect to relational database of type $FIG_Config::dbms named $FIG_Config::db on port $FIG_Config::dbport."));
33 :     }
34 :     else
35 :     {
36 :     push(@html, $cgi->pre($err));
37 :     }
38 :     &HTML::show_page($cgi, \@html, 1);
39 :     exit;
40 :     }
41 :    
42 :    
43 :    
44 :     $ENV{"PATH"} = "$FIG_Config::bin:$FIG_Config::ext_bin:" . $ENV{"PATH"};
45 :    
46 :     my $html = [];
47 :    
48 :    
49 :     if ($cgi->param('submit') eq "Summarize Subsystems")
50 :     {
51 :     summarize_ss();
52 :     }
53 :     else
54 :     {
55 :     show_initial();
56 :     }
57 :    
58 :     unshift @$html, "<TITLE>The SEED - Subsystem summarizer </TITLE>\n";
59 :     &HTML::show_page($cgi, $html, 1);
60 :     exit;
61 :    
62 :    
63 :    
64 :    
65 :    
66 :    
67 :    
68 :    
69 :    
70 :    
71 :     sub summarize_ss {
72 :     my @wants;
73 :     foreach my $w ($cgi->param('korgs')) {
74 :     $w =~ /\((\d+\.\d+)\)/;
75 :     push @wants, $1;
76 :     }
77 :    
78 :    
79 :     my @th;
80 :     if ($cgi->param('levels')) {push @th, ('Level 1', 'Level 2', 'Level 3')}
81 :     if ($cgi->param('genomes')) {push @th, ('Genomes')}
82 :     if ($cgi->param('roles')) {push @th, ('roles', @wants)}
83 :    
84 :     my $tableheader="<tr><th>". (join "</th><th>", @th) . "</th></tr>\n\n";
85 :    
86 :     my $cols=scalar @th;
87 :     my $table;
88 :     foreach my $subsys ($fig->all_subsystems) {
89 :    
90 :     # add a header
91 :     $table .= "<tr><td colspan=$cols align=center><strong>Subsystem: $subsys</strong></td></tr>\n";
92 :    
93 :     # figure out how many roles we have, as this will determine the number of rows in the table
94 :     my @roles=$fig->subsystem_to_roles($subsys);
95 :     my $rows=1;
96 :     if ($cgi->param('roles')) {$rows=scalar @roles}
97 :    
98 :     # figure out which genomes are in this subsystem
99 :     my %genomes;
100 :     foreach my $gen (@{$fig->subsystem_genomes($subsys)}) {$genomes{$gen->[0]}=$gen->[1]}
101 :    
102 :    
103 :     # get the classification if required
104 :     if ($cgi->param('levels')) {
105 :     # get the classification and make sure there are 3 columns
106 :     my $class=$fig->subsystem_classification($subsys);
107 :     unless ($class) {@$class=(' &nbsp; ','','')}
108 :     for (my $i=0; $i <=2; $i++) {unless ($$class[$i]) {$$class[$i] = " &nbsp; "}}
109 :     $table .= "<tr>\n\t<td rowspan='$rows'>" . (join "</td>\n\t<td rowspan='$rows'>", (@$class)) . "</td>";
110 :     }
111 :    
112 :     # add the genomes in the subsystem
113 :     if ($cgi->param('genomes')) {$table .= "\n\t<td rowspan='$rows'> &nbsp; " . (join "<br>\n", sort {$a cmp $b} values %genomes) . "</td>"}
114 :    
115 :     if ($cgi->param('roles')) {
116 :     # now add the roles
117 :     my $first=1;
118 :     foreach my $role (@roles) {
119 :     my $genomeroles;
120 :     foreach my $gen (@wants) {
121 :     my $cell;
122 :     if ($genomes{$gen}) {
123 :     foreach my $peg ($fig->pegs_in_subsystem_cell($subsys, $gen, $role)) {
124 :     $cell .= &HTML::fid_link($cgi,$peg) . "; ";
125 :     }
126 :     }
127 :     if ($cell) {$genomeroles .= "\n\t<td>$cell</td>"}
128 :     else {$genomeroles .= "\n\t<td> &nbsp; </td>"}
129 :     }
130 :     # because I am using rowspan to make long columns, we don't want the tr on the first of these.
131 :     if ($first) {$table .= "\n\t<td>$role</td>" . $genomeroles . "</tr>\n"; $first=0}
132 :     else {$table .= "\n\t<tr><td>$role</td>" . $genomeroles . "</tr>\n"}
133 :     }
134 :     }
135 :     else {$table .= "</tr>\n"}
136 :     }
137 :     push @$html, ("\n<table border=1>" . $tableheader . $table . "</table>\n");
138 :     }
139 :    
140 :    
141 :    
142 :    
143 :    
144 :    
145 :    
146 :    
147 :    
148 :    
149 :     sub show_initial {
150 :     #############
151 :     #
152 :     # Stolen from index.cgi
153 :     #
154 :     #
155 :    
156 :     my @display = ( 'All', 'Archaea', 'Bacteria', 'Eucarya', 'Viruses', 'Environmental samples' );
157 :    
158 :     #
159 :     # Canonical names must match the keywords used in the DBMS. They are
160 :     # defined in compute_genome_counts.pl
161 :     #
162 :     my %canonical = (
163 :     'All' => undef,
164 :     'Archaea' => 'Archaea',
165 :     'Bacteria' => 'Bacteria',
166 :     'Eucarya' => 'Eukaryota',
167 :     'Viruses' => 'Virus',
168 :     'Environmental samples' => 'Environmental Sample'
169 :     );
170 :    
171 :     my $req_dom = $cgi->param( 'domain' ) || 'All';
172 :     my @domains = $cgi->radio_group( -name => 'domain',
173 :     -default => $req_dom,
174 :     -override => 1,
175 :     -values => [ @display ]
176 :     );
177 :    
178 :     my $n_domain = 0;
179 :     my %dom_num = map { ( $_, $n_domain++ ) } @display;
180 :     my $req_dom_num = $dom_num{ $req_dom } || 0;
181 :    
182 :     #
183 :     # Viruses and Environmental samples must have completeness = All (that is
184 :     # how they are in the database). Otherwise, default is Only "complete".
185 :     #
186 :     my $req_comp = ( $req_dom_num > $dom_num{ 'Eucarya' } ) ? 'All'
187 :     : $cgi->param( 'complete' ) || 'Only "complete"';
188 :     my @complete = $cgi->radio_group( -name => 'complete',
189 :     -default => $req_comp,
190 :     -override => 1,
191 :     -values => [ 'All', 'Only "complete"' ]
192 :     );
193 :     #
194 :     # Use $fig->genomes( complete, restricted, domain ) to get org list:
195 :     #
196 :     my $complete = ( $req_comp =~ /^all$/i ) ? undef : "complete";
197 :    
198 :     my @orgs = sort map { my $org = $_; my $gs = $fig->genus_species($org); my $gc=scalar $fig->all_contigs($org); "$gs ($org) [$gc contigs]" }
199 :     $fig->genomes( $complete, undef, $canonical{ $req_dom } );
200 :    
201 :     my $n_genomes = @orgs;
202 :    
203 :     push @$html, $cgi->start_form,
204 :     $cgi->h2("Please choose one or more organisms from the list below to see in the subsystems table"),
205 :     "<TABLE>\n",
206 :     " <TR>\n",
207 :     " <TD>",
208 :     $cgi->scrolling_list( -name => 'korgs',
209 :     -size => 10,
210 :     -multiple => 1,
211 :     -values => \@orgs,
212 :     ),
213 :     $cgi->br,
214 :     "$n_genomes genomes shown ",
215 :     $cgi->submit( 'Update List' ), $cgi->reset, $cgi->submit('submit', 'Summarize Subsystems'),
216 :     "</TD>",
217 :     " <TD>",
218 :     join( "<br>", "<b>Domain(s) to show:</b>", @domains), "<br>\n",
219 :     join( "<br>", "<b>Completeness?</b>", @complete), "\n",
220 :     "</TD>",
221 :     " </TR>\n",
222 :     "</TABLE>\n",
223 :     $cgi->p,
224 :     $cgi->checkbox(-name=>"levels", -label=>"Show subsystem classification", -checked=>'on'), $cgi->p,
225 :     $cgi->checkbox(-name=>"genomes", -label=>"Show genomes in subsystem", -checked=>'on'), $cgi->p,
226 :     $cgi->checkbox(-name=>"roles", -label=>"Show roles in subsystem", -checked=>'on'), $cgi->p,
227 :     $cgi->end_form,
228 :    
229 :     }

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3