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

Annotation of /FigWebServices/protein_info.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (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 :     "<h2>Protein Info</h2>\n",
68 :     "<p>Please enter some protein ID's. We will try and map them</p>",
69 :     $cgi->start_form(),
70 :     $cgi->textarea(-name=>"proteins", -rows=>20, -columns=>100), "<br>",
71 :     $cgi->submit, $cgi->reset, $cgi->end_form;
72 :     return $html;
73 :     }
74 :    
75 :     sub show_info {
76 :     my ($fig,$cgi,$html)=@_;
77 :    
78 :     my $ids=&parse_ids($cgi->param('proteins'));
79 :     my $tab; my @unknowns;
80 :     foreach my $key (keys %$ids) {
81 :     unless (scalar(@{$ids->{$key}})) {
82 :     push @unknowns, $key;
83 :     next;
84 :     }
85 :     my $cs="td rowspan=".scalar(@{$ids->{$key}});
86 :     my $first=[$key, $cs];
87 :     foreach my $peg (@{$ids->{$key}}) {
88 :     # 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"
89 :     my $ss = join "<br>\n",
90 :     map {"<a href='/FIG/subsys.cgi?&user=$user&ssa_name=". $_->[0] ."&request=show_ssa&show_clusters=1&sort=by_phylo'>" . $_->[0] . "</a> (" . $_->[1] . ")"}
91 :     (sort $fig->subsystems_for_peg($peg));
92 :     #my $ss=$raelib->ss_by_id($peg);
93 :     unless ($ss) {$ss=" None "}
94 :     my $ffp=join ", ", map {$fig->family_function($_) . " ($_)"} ($fig->families_for_protein($peg));
95 :     unless ($ffp) {$ffp=" None "}
96 :     # push @row, $peg, $ss, $ffp;
97 :     $peg = "<a href='/FIG/protein.cgi?user=$user&prot=$peg'>$peg</a>\n";
98 :     if ($first) {push @$tab, [$first, $peg, $ss, $ffp]; undef($first)} else {push @$tab, [$peg, $ss, $ffp]}
99 :     }
100 :     }
101 :    
102 :     my $list=join "</li>\n<li>", @unknowns;
103 :     push @$html, &HTML::make_table(["ID", "FIG ID", "Subsystems this is in", "Protein Families this is in"], $tab, "IDs"), "\n",
104 :     "<p>We do not know about the following IDs. Sorry.</p><ul><li>$list</li></ul>\n";
105 :    
106 :     }
107 :    
108 :    
109 :    
110 :    
111 :    
112 :    
113 :     =head2 parse_ids
114 :    
115 :     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.
116 :    
117 :     =cut
118 :    
119 :     sub parse_ids {
120 :     my @given=@_;
121 :    
122 :    
123 :     # here were are going to parse out what we were given. We will split on whitespace and commas
124 :    
125 :     my $want;
126 :     # If you look through the code, and find a really long run on line, blame GJO
127 :     # he complained about having to delete my beautifully functional code. Perhaps he is worried about
128 :     # disk space or something.
129 :     map {@{$want->{$_}}=$fig->by_alias($_) if ($_); s/^\s+//; s/\s+$//} map {split /[\s*\,]/, $_} @given;
130 :     return $want;
131 :     }
132 :    
133 :    

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3