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

Annotation of /FigWebServices/genomebrowser.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.8 - (view) (download)

1 : redwards 1.1 # -*- perl -*-
2 : olson 1.6 #
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 : redwards 1.1
20 :     =pod
21 :    
22 :     =head1
23 :    
24 :     A genome browser to view different things in genomes
25 :    
26 :     =cut
27 :    
28 :     use strict;
29 : overbeek 1.7 use CGI;
30 :     use CGI::Carp qw(fatalsToBrowser); # this makes debugging a lot easier by throwing errors out to the browser
31 : redwards 1.1 use FIG;
32 :     use HTML;
33 :     use raedraw;
34 :     my $cgi=new CGI;
35 :     my $fig;
36 :     eval {
37 :     $fig = new FIG;
38 :     };
39 :    
40 :     if ($@ ne "")
41 :     {
42 :     my $err = $@;
43 :    
44 :     my(@html);
45 :    
46 :     push(@html, $cgi->p("Error connecting to SEED database."));
47 :     if ($err =~ /Could not connect to DBI:.*could not connect to server/)
48 :     {
49 :     push(@html, $cgi->p("Could not connect to relational database of type $FIG_Config::dbms named $FIG_Config::db on port $FIG_Config::dbport."));
50 :     }
51 :     else
52 :     {
53 :     push(@html, $cgi->pre($err));
54 :     }
55 :     &HTML::show_page($cgi, \@html, 1);
56 :     exit;
57 :     }
58 :    
59 :    
60 :     $ENV{"PATH"} = "$FIG_Config::bin:$FIG_Config::ext_bin:" . $ENV{"PATH"};
61 :    
62 :     my $html = [];
63 :     my $user = $cgi->param('user');
64 :     my $err;
65 :    
66 : redwards 1.5
67 :     foreach (@ARGV) {
68 :     my ($k, $v)=split /\=/;
69 :     if ($k eq "compare_to") {my @arr=split /\,/, $v; $v=\@arr}
70 :     $cgi->param(-name=>$k, -value=>$v);
71 :     }
72 :    
73 : redwards 1.1 if ($cgi->param('genome')) {
74 :     # draw the image
75 : redwards 1.2 unshift @$html, "<TITLE>The SEED - Genome Browser </TITLE>\n";
76 : redwards 1.1
77 :     my %imagefns;
78 :     foreach my $kw
79 : redwards 1.5 (qw[width margin top_marg bottom_marg box_height rows box_no_score box_score show_function tick_mark_height genome_lines abbrev stopshort
80 :     maxn maxp bluescale stopshort user])
81 : redwards 1.1 {
82 :     $imagefns{"-".$kw}=$cgi->param($kw);
83 :     }
84 :    
85 :     $cgi->param('genome') =~ /\((\d+\.\d+)\)/; $imagefns{'-genome'}=$1;
86 :     # this should be an array!!!
87 :    
88 :     foreach my $ct ($cgi->param('compare_to')) {
89 :     $ct =~ /\((\d+\.\d+)\)/;
90 :     push @{$imagefns{'-compare_to'}}, $1;
91 :     }
92 : redwards 1.5 if ($cgi->param('subsystems')) {push @{$imagefns{'-compare_to'}}, "subsystems"}
93 : redwards 1.3 if ($cgi->param('pirsf')) {push @{$imagefns{'-compare_to'}}, ['tagvalue', 'pirsf']}
94 :     #
95 :     # remember that we also need to pass in scalefactor here if we have one. This should be a tuple of 'pirsf' and the factor
96 :    
97 : redwards 1.5 if ($ARGV[0]) {
98 :     print STDERR "These are the compare to's: \n", join "\n", @{$imagefns{'-compare_to'}}, '';
99 :     }
100 : redwards 1.1
101 :     my $image=raedraw->new(%imagefns);
102 : redwards 1.3
103 :    
104 : redwards 1.1 my $filename = "$FIG_Config::temp/genomebrowser_$$.svg";
105 :     my $url = &FIG::temp_url . "/genomebrowser_$$.svg";
106 :    
107 :    
108 : redwards 1.2 my ($width, $height)=$image->write_image($filename);
109 : redwards 1.1
110 : redwards 1.5
111 : redwards 1.2 push @$html, $cgi->div({class=>"image"}, $cgi->object({class=>"genomebrowser", data=>"$url", width=>"$width", height=>"$height",
112 : redwards 1.1 standby=>"Loading genome browser image, please be patient"},
113 :     "There should have been an SVG graphic comparing the genomes that you have chosen here, however, you probably need to download ",
114 :     "the SVG viewer from <a href=\"http://www.adobe.com/svg/viewer/install/main.html\">Adobe</a> (yes, it is free)."),"\n",);
115 :     }
116 :    
117 :    
118 :    
119 :    
120 :     else {
121 : redwards 1.2 unshift @$html, "<TITLE>The SEED - Genome Browser </TITLE>\n";
122 : redwards 1.1 &show_initial($fig,$cgi,$html);
123 :     }
124 :    
125 : redwards 1.5 push @$err, "Computing this image took " . int((time-$^T)/0.6)/100 . " minutes\n";
126 : redwards 1.3 push @$html, $cgi->div({class=>"errors", style=>"font-size: smaller"}, $cgi->h3("Errors/Diagnoses we caught:"), @$err);
127 : redwards 1.1 &HTML::show_page($cgi,$html,1);
128 :     exit;
129 :    
130 :    
131 :    
132 :    
133 :    
134 :     sub show_initial {
135 :     my ($fig,$cgi,$html)=@_;
136 :     # generate a blank page
137 :     # we want a list of all functions that have >= 1 peg unless we want all
138 :    
139 :     push (@$html, $cgi->start_form(-action => "genomebrowser.cgi"),
140 :     $cgi->h2("Please choose some factors for your image"),
141 :     "First, please enter a username: ", $cgi->textfield(-name=>"user"), $cgi->p,
142 :     $cgi->h2("Please choose a <strong>single</strong> genome as the baseline:"), $cgi->p,
143 :     &genome_lists("domain1", "complete1", "genome", 0), $cgi->p,
144 :     $cgi->h2("Please choose one or more genomes as the comparators:"), $cgi->p,
145 :     &genome_lists("domain2", "complete2", "compare_to", 'true'), $cgi->p,
146 :     $cgi->submit(-label=>"Draw Genomes"), $cgi->reset);
147 :    
148 :    
149 :     my %options=(
150 :     width => [800, 'width'],
151 :     margin => [100, 'margin'],
152 :     top_marg => [20, 'top margin'],
153 :     bottom_marg => [20, 'bottom margin'],
154 :     box_height => [10, 'height of the boxes around the pegs'],
155 : redwards 1.4 rows => [10, 'split the image into rows'],
156 : redwards 1.1 show_function=> [3, 'show function every n pegs'],
157 :     tick_mark_height=> [3, 'height of the tick marks on the genome line'],
158 : redwards 1.5 maxn => [5, "Max sims"],
159 : redwards 1.3 maxp => [1e-5, "Max E-val"],
160 : redwards 1.5 stopshort => [500, "Stop after drawing this many pegs"],
161 : redwards 1.1 );
162 :    
163 :     my %checkbox=(
164 :     box_no_score => [0, "draw boxes around empty cells"],
165 :     box_score => [1, "draw boxes around cells with content"],
166 : redwards 1.3 bluescale => [1, "make the darkest color blue (if checked) or red (if not checked)"],
167 : redwards 1.1 genome_lines => [1, "draw lines where the genomes are"],
168 :     abbrev => [1, "abbreviate genome names"],
169 :     );
170 :    
171 :     my $advanced;
172 :     foreach my $opt (sort {$a cmp $b} keys %options) {
173 :     $advanced .= "\n" . $cgi->Tr($cgi->td([$options{$opt}->[1]. ":", $cgi->textfield(-name=>$opt, -default=>$options{$opt}->[0], -size=>4)]));
174 :     }
175 :     foreach my $opt (sort {$a cmp $b} keys %checkbox) {
176 :     $advanced .= "\n" . $cgi->Tr($cgi->td([$checkbox{$opt}->[1], $cgi->checkbox(-name=>$opt, -label=>'', -checked=>$checkbox{$opt}->[0])]));
177 :     }
178 :    
179 : redwards 1.3 push @$html, "\n" , $cgi->p, $cgi->div({class=>"advanced"}, $cgi->table($advanced));
180 : redwards 1.5
181 :     push @$html, $cgi->h3("Subsystems"), $cgi->table($cgi->Tr(
182 :     $cgi->td([$cgi->checkbox(-name=>'subsystems', -label=>'') . " &nbsp; highlight PEGs in subsystems"])));
183 : redwards 1.3
184 :     # now add the table for tag value pairs:
185 :     push @$html, $cgi->h3("Tag value pairs"), $cgi->table($cgi->Tr(
186 :     $cgi->td([$cgi->checkbox(-name=>'pirsf', -label=>'') . " &nbsp; PIR superfamilies", ''])));
187 :    
188 :     push @$html, $cgi->submit(-label=>"Draw Genomes"), $cgi->reset, $cgi->end_form;
189 :    
190 : redwards 1.1 }
191 :    
192 :    
193 :    
194 :    
195 :    
196 :    
197 :    
198 :    
199 :    
200 :    
201 :    
202 :     # generate the genome lists as needed.
203 :    
204 :     sub genome_lists {
205 :     my ($domain,$complete, $listname, $multiple)=@_;
206 :    
207 :     #############
208 :     #
209 :     # Stolen from index.cgi
210 :     #
211 :     #
212 :    
213 :     my @display = ( 'All', 'Archaea', 'Bacteria', 'Eucarya', 'Viruses', 'Environmental samples' );
214 :    
215 :     #
216 :     # Canonical names must match the keywords used in the DBMS. They are
217 :     # defined in compute_genome_counts.pl
218 :     #
219 :     my %canonical = (
220 :     'All' => undef,
221 :     'Archaea' => 'Archaea',
222 :     'Bacteria' => 'Bacteria',
223 :     'Eucarya' => 'Eukaryota',
224 :     'Viruses' => 'Virus',
225 :     'Environmental samples' => 'Environmental Sample'
226 :     );
227 :    
228 :     my $req_dom = $cgi->param( $domain ) || 'All';
229 :     my @domains = $cgi->radio_group( -name => $domain,
230 :     -default => $req_dom,
231 :     -override => 1,
232 :     -values => [ @display ]
233 :     );
234 :    
235 :     my $n_domain = 0;
236 :     my %dom_num = map { ( $_, $n_domain++ ) } @display;
237 :     my $req_dom_num = $dom_num{ $req_dom } || 0;
238 :    
239 :     #
240 :     # Viruses and Environmental samples must have completeness = All (that is
241 :     # how they are in the database). Otherwise, default is Only "complete".
242 :     #
243 :     my $req_comp = ( $req_dom_num > $dom_num{ 'Eucarya' } ) ? 'All'
244 : redwards 1.8 : $cgi->param( $complete ) || 'Only "complete"';
245 : redwards 1.1 my @complete = $cgi->radio_group( -name => $complete,
246 :     -default => $req_comp,
247 :     -override => 1,
248 :     -values => [ 'All', 'Only "complete"' ]
249 :     );
250 :     #
251 :     # Use $fig->genomes( complete, restricted, domain ) to get org list:
252 :     #
253 :     my $complete = ( $req_comp =~ /^all$/i ) ? undef : "complete";
254 :    
255 :     my @orgs = sort map { my $org = $_; my $gs = $fig->genus_species($org); my $gc=scalar $fig->all_contigs($org); "$gs ($org) [$gc contigs]" }
256 :     $fig->genomes( $complete, undef, $canonical{ $req_dom } );
257 :    
258 :     my $n_genomes = @orgs;
259 :    
260 :     return "<TABLE>\n",
261 :     " <TR>\n",
262 :     " <TD>",
263 :     $cgi->scrolling_list( -name => $listname,
264 :     -size => 10,
265 :     -multiple => $multiple,
266 :     -values => \@orgs,
267 :     ),
268 :     $cgi->br,
269 :     "$n_genomes genomes shown ",
270 :     $cgi->submit( 'Update List' ), $cgi->reset,
271 :     "</TD>",
272 :     " <TD>",
273 :     join( "<br>", "<b>Domain(s) to show:</b>", @domains), "<br>\n",
274 :     join( "<br>", "<b>Completeness?</b>", @complete), "\n",
275 :     "</TD>",
276 :     " </TR>\n",
277 :     "</TABLE>\n",
278 :     $cgi->br,
279 :    
280 :     }

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3