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

Annotation of /FigWebServices/protein_info.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.5 - (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 :     if ($cgi->param('proteins'))
51 :     {
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 :     $cgi->start_form(),
68 : redwards 1.2 "<h2>Generate information and links about a series of proteins</h2>\n",
69 :     "<p>Please paste some gene or protein IDs into this box. 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.</p>\n",
70 :     "<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 :     "<p>Next, please paste some accesion numbers into the box below. You can separate your accessions with spaces, returns, or commas.</p>\n",
76 :     $cgi->textarea(-name=>"proteins", -rows=>10, -columns=>40), "<br>",
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 :    
84 : redwards 1.2 my $ids=&parse_ids($cgi->param('proteins')); # this does it all in one but does not allow error checking
85 :    
86 : redwards 1.1 my $tab; my @unknowns;
87 :     foreach my $key (keys %$ids) {
88 :     unless (scalar(@{$ids->{$key}})) {
89 :     push @unknowns, $key;
90 :     next;
91 :     }
92 :     my $cs="td rowspan=".scalar(@{$ids->{$key}});
93 :     my $first=[$key, $cs];
94 :     foreach my $peg (@{$ids->{$key}}) {
95 :     # 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"
96 :     my $ss = join "<br>\n",
97 : redwards 1.2 map {"<a href='/FIG/subsys.cgi?&user=$user&ssa_name=". $_->[0] ."&request=show_ssa&show_clusters=1&sort=by_phylo'>" . $_->[0] . "</a>"}
98 : redwards 1.1 (sort $fig->subsystems_for_peg($peg));
99 :     unless ($ss) {$ss=" None "}
100 : redwards 1.2 my $ffp=join "", map {"<a href='/FIG/proteinfamilies.cgi?user=$user&family=$_'>" . $fig->family_function($_) . "</a><br>\n"} ($fig->families_for_protein($peg));
101 : redwards 1.1 unless ($ffp) {$ffp=" None "}
102 : redwards 1.2 if ($first)
103 :     {
104 : redwards 1.5 push @$tab, [$first, "<a href='/FIG/protein.cgi?user=$user&prot=$peg'>$peg</a>\n",
105 :     $fig->genus_species($fig->genome_of($peg)), scalar($fig->function_of($peg, $user)), $ss, $ffp]; undef($first)
106 : redwards 1.2 }
107 :     else
108 :     {
109 : redwards 1.5 push @$tab, ["<a href='/FIG/protein.cgi?user=$user&prot=$peg'>$peg</a>\n", $fig->genus_species($fig->genome_of($peg)),
110 :     scalar($fig->function_of($peg, $user)), $ss, $ffp]
111 : redwards 1.2 }
112 : redwards 1.1 }
113 :     }
114 :    
115 : redwards 1.5 push @$html, &HTML::make_table(["ID", "FIG ID", "Genus Species", "Functional Role", "Subsystems", "Protein Families"], $tab, "IDs"), "\n";
116 : redwards 1.2 if (scalar @unknowns)
117 :     {
118 :     open (OUT, ">$FIG_Config::temp/protein_info_not_found.$$.txt") || die "Can't open $FIG_Config::temp/protein_info_not_found.$$.txt";
119 :     print OUT join "\n", "For request from ", $cgi->remote_host, " couldn't find the following IDs", @unknowns, '';
120 :     close OUT;
121 :     my $list=join "</li>\n<li>", @unknowns;
122 :     push @$html, "<p>We do not know about the following IDs. Sorry.</p><ul><li>$list</li></ul>\n";
123 :     }
124 : redwards 1.1
125 :     }
126 :    
127 :    
128 :    
129 :    
130 :    
131 :    
132 :     =head2 parse_ids
133 :    
134 :     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.
135 :    
136 :     =cut
137 :    
138 :     sub parse_ids {
139 :     my @given=@_;
140 :    
141 :    
142 :     # here were are going to parse out what we were given. We will split on whitespace and commas
143 :    
144 :     my $want;
145 :     # If you look through the code, and find a really long run on line, blame GJO
146 :     # he complained about having to delete my beautifully functional code. Perhaps he is worried about
147 :     # disk space or something.
148 : redwards 1.3 # map {@{$want->{$_}}=$fig->by_alias($_) if ($_); s/^\s+//; s/\s+$//} map {split /[\s*\,]/, $_} @given;
149 :     map {
150 :     s/^\s+//; s/\s+$//;
151 :     if (/^\d+$/) {$_="gi|".$_}
152 : redwards 1.4 elsif (/^[A-Z]\d+$/) {$_="uni|".$_}
153 : redwards 1.3 @{$want->{$_}}=$fig->by_alias($_) if ($_);
154 :     }
155 :     map {split /[\s*\,]/, $_}
156 :     @given;
157 :    
158 : redwards 1.1 return $want;
159 :     }
160 :    

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3