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

Annotation of /FigWebServices/protein_sets_2.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (view) (download)

1 : mkubal 1.1 # -*- perl -*-
2 : olson 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 : mkubal 1.1
20 :     =pod
21 :    
22 :     =head1 proteininfo.cgi
23 :    
24 :     Get some information about a bunch of proteins.
25 :    
26 :     =cut
27 :    
28 :     #use strict;
29 :     use FIG;
30 :     use HTML;
31 :     use raelib;
32 :     my $raelib=new raelib;
33 :     use CGI;
34 :     my $cgi=new CGI;
35 :     use LWP::Simple qw(!head); # see the caveat in perldoc LWP about importing two head methods.
36 :    
37 :     my $fig;
38 :     eval {
39 :     $fig = new FIG;
40 :     };
41 :    
42 :    
43 :     my $html = [];
44 :     my $user = $cgi->param('user');
45 :    
46 :     unshift(@$html, "<TITLE>The SEED - Protein Information</TITLE>\n");
47 :    
48 :     my $tag_to_id;
49 :     my $inputs;
50 :     if ($cgi->param('request') && $cgi->param('korgs') )
51 :     {
52 :     my $input =$cgi->param('proteins');
53 :     my @inputs = split("\n",$input);
54 :     push @orgs, $cgi->param('korgs');
55 :     $org = $orgs[0];
56 :    
57 :     if ($cgi->upload('fileupload'))
58 :     {
59 :     my $fh=$cgi->upload('fileupload');
60 :     @inputs = <$fh> ;
61 :     }
62 :    
63 :     push(@inputs,$org);
64 :     $given = [@inputs];
65 :     $tag_to_id = &parse_inputs($fig,$given);
66 :     my @ks = keys(%{$tag_to_id});
67 :     $key = $ks[0];
68 :     $key2 = $ks[1];
69 :     $values =$tag_to_id->{$key};
70 :     $values2 =$tag_to_id->{$key2};
71 :     ##print STDERR "valuesof1stkey:@$values[0]\n";
72 :     #print STDERR "valuesof2ndkey:@$values2[0]\n";
73 :    
74 :     }
75 :    
76 :     if ($tag_to_id && $cgi->param('request') eq "Subsystem Information")
77 :     {
78 :     &subsystem_info($fig,$cgi,$html,$tag_to_id);
79 :     }
80 :     else
81 :     {
82 :    
83 :     &show_initial($fig,$cgi,$html);
84 :     &HTML::show_page($cgi,$html,1);
85 :     exit;
86 :    
87 :     }
88 :    
89 :    
90 :    
91 :     sub show_initial {
92 :     my ($fig,$cgi,$html)=@_;
93 :     # generate a blank page
94 :     push @$html,
95 :     $cgi->start_multipart_form(),
96 :     "<p>Select an Organism from the list.\n Enter list of tag and id pairs where the tag represents an expression level in a microarray experiment or an isolate from a complete genome hybridization experiment and the id is a gene/protein id or alias</p>\n",
97 :     "<p>",
98 :     "<br><b>Choose one or more organisms from this list:</b><br>\n",
99 :     $raelib->scrolling_org_list($cgi, "1"),
100 :    
101 :     "<b>Paste tag ID pairs here:</b><br>\n",
102 :     $cgi->textarea(-name=>"proteins", -rows=>10, -columns=>40), "<br>\n",
103 :     "<br><b>Or choose a file here:</b><br>\n",
104 :     $cgi->filefield(-name=>"fileupload", -size=>50), "<br>\n",
105 :     $cgi->submit(-name=>'request', -value=>'Subsystem Information'),
106 :     $cgi->submit(-name=>'request', -value=>'Paint Subsystem Network Diagram'),
107 :     $cgi->reset, $cgi->end_form;
108 :     return $html;
109 :     }
110 :    
111 :     sub subsystem_info
112 :     {
113 :     my ($fig,$cgi,$html,$tag_to_id)=@_;
114 :    
115 :     my $html = [];
116 :     my $table = [];
117 :     my @headers = keys(%{$tag_to_id});
118 :     my $ss_counter;
119 :     my @all_subsystems;
120 :     my @pegs_with_no_ss;
121 :    
122 :     push (@$html,"<br><br>");
123 :     foreach my $h (@headers)
124 :     {
125 :     print STDERR "header:$h\n";
126 :     my $p = $tag_to_id->{$h};
127 :     my @pegs = @$p;
128 :     foreach my $peg (@pegs)
129 :     {
130 :     print STDERR "peg:$peg\n";
131 :     if ($peg =~/(fig\|\d+.\d+.peg.\d+)/){ $peg = $1};
132 :     my @subsystems = $fig->subsystems_for_peg($peg);
133 :     if(@subsystems){print STDERR "OUCH\n"};
134 :    
135 :     if(!$subsystems[0]){push(@pegs_with_no_ss,$peg)};
136 :     foreach my $ssr (@subsystems)
137 :     {
138 :     $ss = $ssr->[0];
139 :     print STDERR "found ss:$ss\n";
140 :     my $key = $ss."_".$h;
141 :     if($ss_counter{$key}){$ss_counter{$key} = $ss_counter{$key} + 1}
142 :     else{$ss_counter{$key} = 1}
143 :     my $add = 1;
144 :     foreach my $s (@all_subsystems){if($s eq $ss){$add= 0}}
145 :     if($add){print STDERR "put in all list:$ss\n"; push(@all_subsystems,$ss)}
146 :     }
147 :     }
148 :     }
149 :    
150 :     my $prefix = &FIG::cgi_url() . "/subsys.cgi?user=&ssa_name=";
151 :     my $suffix = "&request=show_ssa";
152 :     push(@$table,"<TABLE><TR><TH>Subsystems</TH>");
153 :     foreach my $h (@headers)
154 :     {
155 :     push(@$table,"<TH>\t$h\t</TH>");
156 :     }
157 :     push(@$table,"</TR>");
158 :    
159 :     foreach my $ss (@all_subsystems)
160 :     {
161 :     print STDERR "each ss: $ss\n";
162 :     my $url = "<a href="."$prefix"."$ss"."$suffix>$ss</a>";
163 :     push(@$table,"<TR><TD>$url</TD>");
164 :     foreach my $h (@headers)
165 :     {
166 :     $key = $ss."_".$h;
167 :     if(!$ss_counter{$key}){$cell = "0"}else{$cell=$ss_counter{$key}}
168 :     push(@$table,"<TD>$cell</TD>");
169 :     }
170 :     push(@$table,"</TR>");
171 :    
172 :     }
173 :    
174 :     push(@$table,"</TABLE>");
175 :     push @$html, &HTML::make_table($table), "\n";
176 :    
177 :     push(@$html,$cgi->h3("Pegs Not in Subsystem"));
178 :     push(@$html,"<TABLE>");
179 :    
180 :     foreach my $p (@pegs_with_no_ss)
181 :     {
182 :     my $cgi = &FIG::cgi_url();
183 :     my $url =qq(<a href="$cgi/protein.cgi?prot=$p&user=">$p</a>);
184 :     push(@$html,"<TR><TD>$url</TD></TR>");
185 :     }
186 :    
187 :     push(@$html,"</TABLE>");
188 :    
189 :     &HTML::show_page($cgi,$html);
190 :    
191 :     }
192 :    
193 :     =head2 parse_inputs
194 :    
195 :     Given a list of of tab-separated tags and protein ids
196 :     return a hash with the tag as key and the value is a list of values
197 :     =cut
198 :    
199 :     sub parse_inputs
200 :     {
201 :    
202 :     my ($fig,$given) =@_;
203 :     my $org = pop(@$given);
204 :     my $hash;
205 :    
206 :     foreach my $g (@$given)
207 :     {
208 :    
209 :     print STDERR "org:$org\n";
210 :     my $id ="";
211 :     print STDERR "given:$g\n";
212 :     if ($g =~/(\w+)\s+(.*)/)
213 :     {
214 :     $tag = $1;
215 :     $temp_id = $2;
216 :    
217 :     if($temp_id !~/fig/)
218 :     {
219 :     ($peg_index_data,undef) = $fig->search_index($temp_id);
220 :     foreach $peg (map { $_->[0] } @$peg_index_data)
221 :     {
222 :     if ($peg =~ /$org/ )
223 :     {
224 :     $id = $peg;
225 :     }
226 :     }
227 :     }
228 :     else
229 :     {
230 :     $id = $temp_id;
231 :     }
232 :    
233 :     if($id)
234 :     {
235 :     if($hash{$tag})
236 :     {
237 :     $list = $hash{$tag};
238 :     @temp_list = @$list;
239 :     push(@temp_list,$id);
240 :     $hash{$tag} = [@temp_list];
241 :     }
242 :     else
243 :     {
244 :     @temp_list = ();
245 :     push(@temp_list,$id);
246 :     ##print STDERR "first value for $g:$2\n";
247 :     $hash{$tag} = [@temp_list];
248 :     }
249 :     }
250 :     }
251 :     }
252 :    
253 :     return \%hash;
254 :     }
255 :    

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3