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

Annotation of /FigWebServices/protein_info.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.6 - (view) (download)

1 : redwards 1.1 # -*- perl -*-
2 :    
3 :     =pod
4 :    
5 :     =head1 proteininfo.cgi
6 :    
7 :     Get some information about a bunch of proteins.
8 :    
9 :     =cut
10 :    
11 :     use strict;
12 :     use FIG;
13 :     use HTML;
14 :     use raelib;
15 :     my $raelib=new raelib;
16 :     use CGI;
17 :     my $cgi=new CGI;
18 :     use LWP::Simple qw(!head); # see the caveat in perldoc LWP about importing two head methods.
19 :    
20 :     my $fig;
21 :     eval {
22 :     $fig = new FIG;
23 :     };
24 :    
25 :     if ($@ ne "")
26 :     {
27 :     my $err = $@;
28 :    
29 :     my(@html);
30 :    
31 :     push(@html, $cgi->p("Error connecting to SEED database."));
32 :     if ($err =~ /Could not connect to DBI:.*could not connect to server/)
33 :     {
34 :     push(@html, $cgi->p("Could not connect to relational database of type $FIG_Config::dbms named $FIG_Config::db on port $FIG_Config::dbport."));
35 :     }
36 :     else
37 :     {
38 :     push(@html, $cgi->pre($err));
39 :     }
40 :     &HTML::show_page($cgi, \@html, 1);
41 :     exit;
42 :     }
43 :    
44 :     my $html = [];
45 :     my $user = $cgi->param('user');
46 :    
47 :     unshift(@$html, "<TITLE>The SEED - Protein Information</TITLE>\n");
48 :    
49 :    
50 : redwards 1.6 if ($cgi->param('proteins') || $cgi->param('fileupload'))
51 : redwards 1.1 {
52 :     &show_info($fig,$cgi,$html);
53 :     }
54 :     else
55 :     {
56 :     &show_initial($fig,$cgi,$html);
57 :     }
58 :    
59 :     &HTML::show_page($cgi,$html,1);
60 :     exit;
61 :    
62 :    
63 :     sub show_initial {
64 :     my ($fig,$cgi,$html)=@_;
65 :     # generate a blank page
66 :     push @$html,
67 : redwards 1.6 $cgi->start_multipart_form(),
68 : redwards 1.2 "<h2>Generate information and links about a series of proteins</h2>\n",
69 : redwards 1.6 "<p>Please paste some gene or protein IDs into this box or upload a file of IDs. We will then try and map the IDs that you find onto FIG IDs. If we are able to map them you will see a table of results. If we are unable to map some we'll let you know which ones. You can separate your accessions with spaces, returns, or commas.</p>\n",
70 : redwards 1.2 "<p>Typical IDs are in the following format:</p>\n",
71 :     "<ol>\n<li><b>FIG</b>: &nbsp; fig|83333.1.peg.1697</li>\n<li><b>Genbank</b><ul><li>Refseq: &nbsp; begin with NP_ or NC_</li>\n",
72 :     "<li>gi numbers &nbsp; These are just numeric, please add the characters 'gi|' to make a number like gi|16129669</li>\n",
73 :     "<li>GenBank Accessions &nbsp; numbers and letters such as AAF12034</li>\n</ul>\n",
74 :     "<li><b>SwissProt, PIR, Trembl, Uniprot</b> &nbsp; a single letter and some digits</li></ol>\n",
75 : redwards 1.6 $cgi->textarea(-name=>"proteins", -rows=>10, -columns=>40), "<br>\n",
76 :     $cgi->filefield(-name=>"fileupload", -size=>50), "<br>\n",
77 : redwards 1.1 $cgi->submit, $cgi->reset, $cgi->end_form;
78 :     return $html;
79 :     }
80 :    
81 :     sub show_info {
82 :     my ($fig,$cgi,$html)=@_;
83 : redwards 1.6
84 :     if ($cgi->upload('fileupload'))
85 :     {
86 :     my $fh=$cgi->upload('fileupload');
87 :     $cgi->param(-name=>'proteins', -value=>[(<$fh>)]);
88 :     }
89 : redwards 1.1
90 : redwards 1.2 my $ids=&parse_ids($cgi->param('proteins')); # this does it all in one but does not allow error checking
91 :    
92 : redwards 1.6 # predefine the color section for the subsys link
93 :     my $color="&color=" . join("&color=", map {@{$ids->{$_}}} keys %$ids);
94 :    
95 : redwards 1.1 my $tab; my @unknowns;
96 :     foreach my $key (keys %$ids) {
97 :     unless (scalar(@{$ids->{$key}})) {
98 :     push @unknowns, $key;
99 :     next;
100 :     }
101 :     my $cs="td rowspan=".scalar(@{$ids->{$key}});
102 :     my $first=[$key, $cs];
103 :     foreach my $peg (@{$ids->{$key}}) {
104 : redwards 1.6
105 :     # OLD STYLE: Regular link into the subsystems page
106 : redwards 1.1 # link to ss is: subsys.cgi?can_alter=$can_alter&SPROUT=$sprout&user=$user&ssa_name=$esc_sub&request=show_ssa&show_clusters=1&sort=by_phylo"
107 : redwards 1.6 #my $ss = join "<br>\n",
108 :     # map {"<a href='subsys.cgi?&user=$user&ssa_name=". $_->[0] ."&request=show_ssa&show_clusters=1&sort=by_phylo'>" . $_->[0] . "</a>"}
109 :     # (sort $fig->subsystems_for_peg($peg));
110 :    
111 :     # NEW STYLE: Link to displaysubsys.cgi
112 :     #display_subsys.cgi?ssa_name=Capsular_polysaccharide_biosynthesis_in_Staphylococcus&color=uni|P95695&color=uni|Q99X66&uni|Q99X65
113 : redwards 1.1 my $ss = join "<br>\n",
114 : redwards 1.6 map {"<a href='display_subsys.cgi?user=$user&ssa_name=". $_->[0] . "$color'>" . $_->[0] . "</a>"}
115 :     (sort $fig->subsystems_for_peg($peg));
116 :    
117 : redwards 1.1 unless ($ss) {$ss=" None "}
118 : redwards 1.6 my $ffp=join "", map {"<a href='proteinfamilies.cgi?user=$user&family=$_'>" . $fig->family_function($_) . "</a><br>\n"} ($fig->families_for_protein($peg));
119 : redwards 1.1 unless ($ffp) {$ffp=" None "}
120 : redwards 1.2 if ($first)
121 :     {
122 : redwards 1.6 push @$tab, [$first, "<a href='protein.cgi?user=$user&prot=$peg'>$peg</a>\n",
123 : redwards 1.5 $fig->genus_species($fig->genome_of($peg)), scalar($fig->function_of($peg, $user)), $ss, $ffp]; undef($first)
124 : redwards 1.2 }
125 :     else
126 :     {
127 : redwards 1.6 push @$tab, ["<a href='protein.cgi?user=$user&prot=$peg'>$peg</a>\n", $fig->genus_species($fig->genome_of($peg)),
128 : redwards 1.5 scalar($fig->function_of($peg, $user)), $ss, $ffp]
129 : redwards 1.2 }
130 : redwards 1.1 }
131 :     }
132 :    
133 : redwards 1.6 push @$html, &HTML::make_table(["ID", "FIG ID<br><small>Link goes to protein page</small>", "Genus Species", "Functional Role", "Subsystems<br><small>Link will color subsystem with all pegs</small>", "Protein Families<br><small>Link will explore Protein Family</small>"], $tab, "IDs"), "\n";
134 : redwards 1.2 if (scalar @unknowns)
135 :     {
136 :     open (OUT, ">$FIG_Config::temp/protein_info_not_found.$$.txt") || die "Can't open $FIG_Config::temp/protein_info_not_found.$$.txt";
137 :     print OUT join "\n", "For request from ", $cgi->remote_host, " couldn't find the following IDs", @unknowns, '';
138 :     close OUT;
139 :     my $list=join "</li>\n<li>", @unknowns;
140 :     push @$html, "<p>We do not know about the following IDs. Sorry.</p><ul><li>$list</li></ul>\n";
141 :     }
142 : redwards 1.1
143 :     }
144 :    
145 :    
146 :    
147 :    
148 :    
149 :    
150 :     =head2 parse_ids
151 :    
152 :     Given an array or list of IDs in any format separated from each other by spaces or commas, this will return a reference to a hash. The key is the ID, and the value is a reference to an arrays of the FIG IDs that match.
153 :    
154 :     =cut
155 :    
156 :     sub parse_ids {
157 :     my @given=@_;
158 :    
159 :    
160 :     # here were are going to parse out what we were given. We will split on whitespace and commas
161 :    
162 :     my $want;
163 :     # If you look through the code, and find a really long run on line, blame GJO
164 :     # he complained about having to delete my beautifully functional code. Perhaps he is worried about
165 :     # disk space or something.
166 : redwards 1.3 map {
167 :     s/^\s+//; s/\s+$//;
168 :     if (/^\d+$/) {$_="gi|".$_}
169 : redwards 1.4 elsif (/^[A-Z]\d+$/) {$_="uni|".$_}
170 : redwards 1.3 @{$want->{$_}}=$fig->by_alias($_) if ($_);
171 :     }
172 :     map {split /[\s*\,]/, $_}
173 :     @given;
174 :    
175 : redwards 1.1 return $want;
176 :     }
177 :    

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3