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

Annotation of /FigWebServices/list_subsys.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (view) (download)

1 : olson 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 FIG;
21 :     use FIG_Config;
22 :     use FIGjs; # mouseover()
23 :     use GD;
24 :     use MIME::Base64;
25 :    
26 :     my $fig = new FIG;
27 :    
28 :     use Subsystem;
29 :    
30 :     use URI::Escape; # uri_escape()
31 :     use HTML;
32 :     use strict;
33 :     use tree_utilities;
34 :    
35 :     use CGI;
36 :     use CGI::Carp qw(fatalsToBrowser); # this makes debugging a lot easier by throwing errors out to the browser
37 :    
38 :     my $cgi = new CGI;
39 :    
40 :     $ENV{"PATH"} = "$FIG_Config::bin:$FIG_Config::ext_bin:" . $ENV{"PATH"};
41 :    
42 :     if (0)
43 :     {
44 :     my $VAR1;
45 :     eval(join("",`cat /tmp/ssa_parms`));
46 :     $cgi = $VAR1;
47 :     # print STDERR &Dumper($cgi);
48 :     }
49 :    
50 :     if (0)
51 :     {
52 :     print $cgi->header;
53 :     my @params = $cgi->param;
54 :     print "<pre>\n";
55 :     foreach $_ (@params)
56 :     {
57 :     print "$_\t:",join(",",$cgi->param($_)),":\n";
58 :     }
59 :    
60 :     if (0)
61 :     {
62 :     if (open(TMP,">/tmp/ssa_parms"))
63 :     {
64 :     print TMP &Dumper($cgi);
65 :     close(TMP);
66 :     }
67 :     }
68 :     exit;
69 :     }
70 :    
71 :     my $html = [];
72 :     push @$html, "<TITLE>SEED Subsystems</TITLE>\n"; # RAE: every page deserves a title
73 :    
74 :     my $user = $cgi->param('user');
75 :    
76 :     $fig->set_user($user);
77 :    
78 :     &show_initial($fig,$cgi,$html);
79 :    
80 :     &HTML::show_page($cgi,$html);
81 :     exit;
82 :    
83 :     sub show_initial {
84 :     # a new first page written by Rob
85 :     my($fig,$cgi,$html) = @_;
86 :    
87 :     # we get this information here and set things so that when we create the links later everything is already set.
88 :     my $sort = $cgi->param('sortby');
89 :     unless ($sort) {$sort="Classification"}
90 :     my $show_clusters=$cgi->param('show_clusters');
91 :     my $sort_ss=$cgi->param('sort');
92 :     my $minus=$cgi->param('show_minus1');
93 :     my $show_genomes=$cgi->param('showgenomecounts');
94 :    
95 :    
96 :     # now set the values into $cgi so that we have them for later
97 :     $cgi->param('sortby', $sort); # this is the table sort
98 :     $cgi->param('show_clusters', $show_clusters); # whether or not to show the clusters
99 :     $cgi->param('sort', $sort_ss); # this is the sort of the organisms in display
100 :     $cgi->param('show_minus1', $minus); # whether to show -1 variants
101 :     $cgi->param('showgenomecounts', $show_genomes); # whether to show genomes on the first page
102 :    
103 :     my @ssa = map {
104 :     my $ss=$_;
105 :     my ($version, $curator, $pedigree, $roles)=$fig->subsystem_info($ss->[0]);
106 :     push @$ss, scalar(@$roles), $version;
107 :     push @$ss, scalar(@{$fig->subsystem_genomes($ss->[0])}) if ($cgi->param('showgenomecounts'));
108 :     $fig->subsystem_classification($ss->[0], [$cgi->param($ss->[0].".class1"), $cgi->param($ss->[0].".class2")]) if ($cgi->param($ss->[0].".class1"));
109 :     unshift @$ss, @{$fig->subsystem_classification($ss->[0])};
110 :     if ($ss->[3] eq $user) {$ss->[3] = [$ss->[3], "td style='background-color: #BA55D3'"]}
111 :     $_=$ss;
112 :     }
113 :     &existing_subsystem_annotations($fig);
114 :    
115 :     # sort the cells
116 :     if ($sort eq "Classification") {@ssa=sort {uc($a->[0]) cmp uc($b->[0]) || uc($a->[1]) cmp uc($b->[1]) || uc($a->[2]) cmp uc($b->[2])} @ssa}
117 :     elsif ($sort eq "Subsystem") {@ssa=sort {uc($a->[2]) cmp uc($b->[2])} @ssa}
118 :     elsif ($sort eq "Curator") {@ssa=sort {uc($a->[3]) cmp uc($b->[3])} @ssa}
119 :     elsif ($sort eq "Number of Roles") {@ssa=sort {$a->[4] <=> $b->[4]} @ssa}
120 :     elsif ($sort eq "Version") {@ssa=sort {$a->[5] <=> $b->[5]} @ssa}
121 :    
122 :     ##### Add the ability to change empty classifications
123 :    
124 :     # get the complete list of classifications
125 :     my %class1=(""=>1); my %class2=(""=>1);
126 :     map {$class1{$_->[0]}++; $class2{$_->[1]}++} @ssa;
127 :    
128 :    
129 :     # replace empty classifications with the popup_menus and create links
130 :     # Disabled this because it is causing the page to load _very_ slowly as the browser has to render all the menus
131 :     # two alternatives: put only a popup for the first field if both are empty and then a popup for the second if neither are empty
132 :     # or put textfields to allow people to cut/paste.
133 :    
134 :     map {
135 :     my $ss=$_;
136 :     unless (1 || $ss->[0]) # remove the '1 ||' from this line to reinstate the menus
137 :     {
138 :     $ss->[0] = $cgi->popup_menu(-name=>$ss->[2].".class1", -values=>[sort {$a cmp $b} keys %class1]);
139 :     $ss->[1] = $cgi->popup_menu(-name=>$ss->[2].".class2", -values=>[sort {$a cmp $b} keys %class2]);
140 :     }
141 :     $ss->[2]=&ssa_link($fig, $ss->[2], $user);
142 :     $_=$ss;
143 :     } @ssa;
144 :    
145 :     my $col_hdrs=[["Classification", "th colspan=2 style='text-align: center'"], "Subsystem", "Curator", "Number of Roles", "Version"];
146 :     push @$col_hdrs, "Number of Genomes" if ($cgi->param('showgenomecounts'));
147 :    
148 :     my $tab=HTML->merge_table_rows(\@ssa);
149 :     my $url = &FIG::cgi_url . "/subsys.cgi?user=$user&request=manage_ss";
150 :     my $target = "window$$";
151 :    
152 :     my %sortmenu=(
153 :     unsorted=>"None",
154 :     alphabetic=>"Alphabetical",
155 :     by_pattern=>"Patterns",
156 :     by_phylo=>"Phylogeny",
157 :     by_tax_id=>"Taxonomy",
158 :     by_variant=>"Variant Code",
159 :     );
160 :    
161 :     push(@$html,
162 :     $cgi->start_form(-action => "subsys.cgi"),
163 :     "<div class='ssinstructions'>\n",
164 :     "Please choose one of the subsystems from this list, or begin working on your own by entering a name in the box at the bottom of the page. ",
165 :     "We suggest that you take some time to look at the subsystems others have developed before working on your own.",
166 :     "<ul><li>Please do not ever edit someone else's spreadsheet</li>\n<li>Please do not open multiple windows to process the same spreadsheet.</li>",
167 :     "<li>Feel free to open a subsystem spreadsheet and then open multiple other SEED windows to access data and modify annotations.</li>",
168 :     "<li>You can access someone else's subsystem spreadsheet using your ID</li>",
169 :     "<li>To change the classification of an unclassified subsystem, choose the desired classification from the menus and click Update Table View</li>");
170 :    
171 :     push @$html, "<li>You can <a href='$url&manage=mine'>manage your subsystems</a></li>" if ($user);
172 :     push(@$html,
173 :     "<li>You can <a href='$url'>manage all subsystems</a></li>",
174 :     "</ul></div>",
175 :     "<div class='page_settings' style='width: 75%; margin-left: auto; margin-right: auto'>Please enter your username: ", $cgi->textfield(-name=>"user"), "\n",
176 :     "<table border=1>\n",
177 :     "<tr><th>Settings for this page</th><th>Settings for the links to the next page.<br>Change these and click Update Table View.</th></tr>\n",
178 :     "<tr><td>",
179 :     "<table><tr>",
180 :     "<td valign=center>Sort table by</td><td valign=center>",
181 :     $cgi->popup_menu(-name=>'sortby', -values=>['Classification', 'Subsystem', 'Curator', 'Number of Roles', 'Version'], -default=>$sort), "</td></tr></table\n",
182 :     "</td>\n<td>",
183 :     "<table><tr>",
184 :     "<td valign=center>Show clusters</td><td valign=center>", $cgi->checkbox(-name=>'show_clusters', -label=>''), "</td>\n",
185 :     "<td valign=center>Default Spreadsheet Sorted By:</td><td valign=center>",
186 :     $cgi->popup_menu(-name => 'sort', -values => [keys %sortmenu], -labels=>\%sortmenu),
187 :     "</td></tr></table>\n",
188 :     "</td></tr></table>\n",
189 :     $cgi->submit('Update Table View'), $cgi->reset, $cgi->p,
190 :     "</div>\n",
191 :     &HTML::make_table($col_hdrs,$tab,"Subsystems"),
192 :     $cgi->end_form(),
193 :    
194 :    
195 :     # $cgi->h3('To start a new subsystem'), $cgi->p("Please enter the name of the subsystem that you would like to start. You will be provided with a blank",
196 :     # " form that you can fill in with the roles and genomes to create a subsystem like those above."),
197 :     # $cgi->start_form(-action => "subsys.cgi",
198 :     # -target => $target,
199 :     # -method => 'post'),
200 :     # $cgi->hidden(-name => 'user', -value => $user, -override => 1),
201 :     # $cgi->hidden(-name => 'request', -value => 'new_ssa', -override => 1),
202 :     # "Name of New Subsystem: ",
203 :     # $cgi->textfield(-name => "ssa_name", -size => 50),
204 :     # $cgi->hidden(-name => 'can_alter', -value => 1, -override => 1),
205 :     # $cgi->br,
206 :     #
207 :     # $cgi->submit('start new subsystem'),
208 :     );
209 :    
210 :     }
211 :     # RAE: I think this should be placed as a method in
212 :     # Subsystems.pm and called subsystems I know about or something.
213 :     # Cowardly didn't do though :-)
214 :     sub existing_subsystem_annotations {
215 :     my($fig) = @_;
216 :     my($ssa,$name);
217 :     my @ssa = ();
218 :     if (opendir(SSA,"$FIG_Config::data/Subsystems"))
219 :     {
220 :     @ssa = map { $ssa = $_; $name = $ssa; $ssa =~ s/[ \/]/_/g; [$name,&subsystem_curator($ssa)] } grep { $_ !~ /^\./ } readdir(SSA);
221 :     closedir(SSA);
222 :     }
223 :     # RAE Adding sort of current subsystems
224 :     if ($cgi->param('colsort') && $cgi->param('colsort') eq "curator")
225 :     {
226 :     # sort by the ss curator
227 :     return sort { (lc $a->[1]) cmp (lc $b->[1]) || (lc $a->[0]) cmp (lc $b->[0]) } @ssa;
228 :     }
229 :     else
230 :     {
231 :     return sort { (lc $a->[0]) cmp (lc $b->[0]) } @ssa;
232 :     }
233 :     }
234 :    
235 :     sub ssa_link {
236 :     my($fig,$ssa,$user) = @_;
237 :     my $name = $ssa; $name =~ s/_/ /g;
238 :     my $target = "window$$";
239 :     if ($name =~ /([a-zA-Z]{3})/)
240 :     {
241 :     $target .= ".$1";
242 :     }
243 :    
244 :     my $esc_ssa = uri_escape($ssa);
245 :     my $show_clusters = 1;
246 :     my $minus = 0;
247 :    
248 :     my $url = &FIG::cgi_url . "/display_subsys.cgi?ssa_name=$esc_ssa&show_clusters=$show_clusters&show_minus1=$minus";
249 :     return "<a href=$url target=$target>$name</a>";
250 :     }
251 :    
252 :     sub subsystem_curator {
253 :     my($ssa) = @_;
254 :    
255 :     my $curator = $fig->subsystem_curator($ssa);
256 :    
257 :     if ($curator !~ /^master:/) { $curator = "master:$curator" }
258 :     return $curator;
259 :     }

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3