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

Annotation of /FigWebServices/diagram.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (view) (download)

1 : paarmann 1.1 #
2 :     # Copyright (c) 2003-2006 University of Chicago and Fellowship
3 :     # for Interpretations of Genomes. All Rights Reserved.
4 :     #
5 :     # This file is part of the SEED Toolkit.
6 :     #
7 :     # The SEED Toolkit is free software. You can redistribute
8 :     # it and/or modify it under the terms of the SEED Toolkit
9 :     # Public License.
10 :     #
11 :     # You should have received a copy of the SEED Toolkit Public License
12 :     # along with this program; if not write to the University of Chicago
13 :     # at info@ci.uchicago.edu or the Fellowship for Interpretation of
14 :     # Genomes at veronika@thefig.info or download a copy from
15 :     # http://www.theseed.org/LICENSE.TXT.
16 :     #
17 :    
18 : paarmann 1.2 # $Id$
19 :    
20 : paarmann 1.1 use strict;
21 :     use warnings;
22 :    
23 :     use FIG_CGI;
24 :     use FIG_Config;
25 :     use CGI;
26 :    
27 :     use Diagram;
28 :    
29 :     eval {
30 :     &main;
31 :     };
32 :    
33 :     if ($@)
34 :     {
35 :     my $cgi = new CGI();
36 :    
37 :     print $cgi->header();
38 :     print $cgi->start_html();
39 :     print "<pre>$@</pre>";
40 :     print $cgi->end_html();
41 :    
42 :     }
43 :    
44 :     sub main {
45 :    
46 :     my ($fig, $cgi, $user) = FIG_CGI::init(debug_save => 0, debug_load => 0, print_params => 0);
47 :    
48 :     my $css = qq~body {
49 :     font-family: Verdana, Arial, sans-serif;
50 :     font-size: 12px;
51 :     font-weight: normal;
52 :     color: #000;
53 :     background-color: #FFFFFF;
54 :     }~;
55 :    
56 :     # print out the page
57 :     print $cgi->header();
58 :     print $cgi->start_html(-title => 'The SEED - Subsystem Diagram',
59 :     -style => { -code => $css }
60 :     );
61 :    
62 :     print &get_Diagram($fig, $cgi);
63 :    
64 : paarmann 1.2 print $cgi->end_html;
65 :    
66 : paarmann 1.1 }
67 :    
68 :    
69 :     sub get_Diagram {
70 :     # get parameters
71 :     my ($fig, $cgi) = @_;
72 :    
73 :     unless ($cgi->param('subsystem_name') and
74 :     $cgi->param('diagram')) {
75 :     return '<p>CGI Parameter missing.</p>';
76 :     }
77 :    
78 :     my $subsystem_name = $cgi->param('subsystem_name');
79 :     my $diagram_id = $cgi->param('diagram');
80 :    
81 :     my $subsystem_pretty = $subsystem_name;
82 :     $subsystem_pretty =~ s/_/ /g;
83 :    
84 :     my $subsystem = $fig->get_subsystem($subsystem_name);
85 :     my @genomes = $subsystem->get_genomes();
86 :     my $genome = $cgi->param('genome_id');
87 :     my %genome_labels = map { $_ => $fig->genus_species($_)." ( $_ )" } @genomes;
88 :    
89 :     # generate the content
90 :     my $content = '<p>No subsystem name given.</p>';
91 :     if ($subsystem) {
92 :    
93 :     $content = "<h1>Subsystem: $subsystem_pretty</h1>";
94 :     $content .= '<hr/>';
95 :    
96 :     unless ($subsystem->is_new_diagram($diagram_id)) {
97 :     $content .= "<p><em>Diagram '$diagram_id' is not a new diagram.</em><p>";
98 :     return $content;
99 :     }
100 :    
101 :     $content .= $cgi->start_form();
102 :     $content .= $cgi->hidden( -name => 'subsystem_name',
103 :     -value => $subsystem_name );
104 :     $content .= $cgi->hidden( -name => 'diagram',
105 :     -value => $diagram_id );
106 :     $content .= $cgi->popup_menu( -name => 'genome_id',
107 :     -values => \@genomes,
108 :     -default => $genome,
109 :     -labels => \%genome_labels,
110 :     );
111 :     $content .= $cgi->submit( -name => 'Color diagram' );
112 :     $content .= $cgi->end_form();
113 :    
114 :     # initialise a status string (log)
115 :     my $status = '';
116 :    
117 :     # fetch the diagram
118 :     my $diagram_dir = $subsystem->{dir}."/diagrams/$diagram_id/";
119 :     my $d = Diagram->new($subsystem_name, $diagram_dir);
120 :    
121 :    
122 :     # DEBUG: test all items of the diagram against the subsystem
123 :     # (for debug purposes during introduction of new diagrams)
124 :     # (remove when no longer needed)
125 :     my $types = [ 'role', 'role_and', 'role_or' ];
126 :     foreach my $t (@$types) {
127 :     foreach my $id (@{$d->item_ids_of_type($t)}) {
128 :     unless ($subsystem->get_role_from_abbr($id) or
129 :     scalar($subsystem->get_subsetC_roles($id))) {
130 :     $status .= "Diagram item '$t' = '$id' not found in the subsystem.\n";
131 :     }
132 :     }
133 :     }
134 :     # END
135 :    
136 :     if ($genome) {
137 :    
138 :     my @roles = $subsystem->get_roles_for_genome($genome);
139 :    
140 :     # build a lookup hash, make one entry for each role_and and role_or item
141 :     # the index references to the inner hash of the role_and/role_or hash
142 :     # to set a value there use $lookup->{role_abbr}->{role_abbr} = 1;
143 :     my $lookup = {};
144 :    
145 :     # find out about role_and
146 :     my $role_and = {};
147 :     if (scalar(@{$d->item_ids_of_type('role_and')})) {
148 :     foreach my $subset (@{$d->item_ids_of_type('role_and')}) {
149 :    
150 :     $role_and->{$subset} = {};
151 :    
152 :     foreach my $r ($subsystem->get_subsetC_roles($subset)) {
153 :     my $r_abbr = $subsystem->get_abbr_for_role($r);
154 :     unless ($r_abbr) {
155 :     die "Unable to get the abbreviation for role '$r'.";
156 :     }
157 :    
158 :     $lookup->{$r_abbr} = $role_and->{$subset};
159 :     $role_and->{$subset}->{$r_abbr} = 0;
160 :     }
161 :     }
162 :     }
163 :    
164 :     # find out about role_or
165 :     my $role_or = {};
166 :     if (scalar(@{$d->item_ids_of_type('role_or')})) {
167 :     foreach my $subset (@{$d->item_ids_of_type('role_or')}) {
168 :    
169 :     $role_or->{$subset} = {};
170 :    
171 :     foreach my $r ($subsystem->get_subsetC_roles($subset)) {
172 :     my $r_abbr = $subsystem->get_abbr_for_role($r);
173 :     unless ($r_abbr) {
174 :     die "Unable to get the abbreviation for role '$r'.";
175 :     }
176 :    
177 :     $lookup->{$r_abbr} = $role_and->{$subset};
178 :     $role_or->{$subset}->{$r_abbr} = 0;
179 :     }
180 :     }
181 :     }
182 :    
183 :    
184 :     # check if genome is present in subsystem
185 :     # genomes not present, unfortunately return @roles = ( undef )
186 :     if (scalar(@roles) == 0 or
187 :     (scalar(@roles) and !defined($roles[0]))) {
188 :     $content .= "<p><em>Genome '$genome' is not present in this subsystem.</em><p>";
189 :     shift(@roles);
190 :     }
191 :     else {
192 :     $content .= "<p><em>Showing colours for genome: $genome.</em><p>";
193 :     }
194 :    
195 :    
196 :     # iterate over all roles present in a subsystem:
197 :     # -> map roles to abbr in the foreach loop
198 :     # -> color simple roles present
199 :     # -> tag roles being part of a logical operator in $lookup
200 :     foreach (map { $subsystem->get_abbr_for_role($_) } @roles) {
201 :    
202 :     # color normal roles
203 :     if ($d->has_item('role', $_)) {
204 :     $d->color_item('role',$_,'green');
205 :     next;
206 :     }
207 :    
208 :     # try to find role_and / role_or
209 :     if (exists($lookup->{$_})) {
210 :     $lookup->{$_}->{$_} = 1;
211 :     next;
212 :     }
213 :    
214 :     $status .= "Role '$_' not found in the diagram.\n";
215 :     }
216 :    
217 :     # use Data::Dumper;
218 :     # $content .= "<pre>".Data::Dumper->Dump([ $lookup ])."</pre>";
219 :    
220 :     # check if to color any role_and
221 :     foreach my $id_role_and (keys(%$role_and)) {
222 :     my $result = 1;
223 :     foreach (keys(%{$role_and->{$id_role_and}})) {
224 :     $result = 0 unless ($role_and->{$id_role_and}->{$_});
225 :     }
226 :     $d->color_item('role_and', $id_role_and, 'green') if ($result);
227 :     }
228 :     }
229 :     else {
230 :     $content .= '<p><em>You have not provided a genome id to color the diagram with.</em><p>';
231 :     }
232 :    
233 :     $content .= $d->html;
234 :     $content .= '<hr/><p><em>Below follows a status message to help test the new diagrams:</em><p>'.
235 :     "<pre>$status</pre>" if ($status);
236 :    
237 :     }
238 :    
239 :     return $content;
240 :     }
241 :    
242 :    

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3