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

View of /FigWebServices/protein_info.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (download) (annotate)
Thu Jul 14 22:36:03 2005 UTC (14 years, 10 months ago) by redwards
Branch: MAIN
Initial commit of protein_info.cgi

# -*- perl -*-

=pod

=head1 proteininfo.cgi

Get some information about a bunch of proteins. 

=cut

use strict;
use FIG;
use HTML;
use raelib;
my $raelib=new raelib;
use CGI;
my $cgi=new CGI;
use LWP::Simple qw(!head); # see the caveat in perldoc LWP about importing two head methods.

my $fig;
eval {
    $fig = new FIG;
};  

if ($@ ne "")
{
    my $err = $@;
    
    my(@html);
    
    push(@html, $cgi->p("Error connecting to SEED database."));
    if ($err =~ /Could not connect to DBI:.*could not connect to server/)
    {
        push(@html, $cgi->p("Could not connect to relational database of type $FIG_Config::dbms named $FIG_Config::db on port $FIG_Config::dbport."));
    }   
    else
    {
        push(@html, $cgi->pre($err));
    }   
    &HTML::show_page($cgi, \@html, 1);
    exit;
}   
    
my $html = [];
my $user = $cgi->param('user');

unshift(@$html, "<TITLE>The SEED - Protein Information</TITLE>\n");


if ($cgi->param('proteins'))
{
 &show_info($fig,$cgi,$html);
}
else
{
  &show_initial($fig,$cgi,$html);
}

&HTML::show_page($cgi,$html,1);
exit;


sub show_initial {
 my ($fig,$cgi,$html)=@_;
 # generate a blank page
 push @$html, 
 "<h2>Protein Info</h2>\n",
 "<p>Please enter some protein ID's. We will try and map them</p>",
 $cgi->start_form(), 
 $cgi->textarea(-name=>"proteins", -rows=>20, -columns=>100), "<br>", 
 $cgi->submit, $cgi->reset, $cgi->end_form;
 return $html;
}

sub show_info {
 my ($fig,$cgi,$html)=@_;

 my $ids=&parse_ids($cgi->param('proteins'));
 my $tab; my @unknowns;
 foreach my $key (keys %$ids) {
  unless (scalar(@{$ids->{$key}})) {
   push @unknowns, $key;
   next;
  }
  my $cs="td rowspan=".scalar(@{$ids->{$key}});
  my $first=[$key, $cs];
  foreach my $peg (@{$ids->{$key}}) {
   # 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"
   my $ss = join "<br>\n", 
     		map {"<a href='/FIG/subsys.cgi?&user=$user&ssa_name=". $_->[0] ."&request=show_ssa&show_clusters=1&sort=by_phylo'>" . $_->[0] . "</a> (" . $_->[1] . ")"}
   		(sort $fig->subsystems_for_peg($peg));
   #my $ss=$raelib->ss_by_id($peg);
   unless ($ss) {$ss=" None "}
   my $ffp=join ", ", map {$fig->family_function($_) . " ($_)"} ($fig->families_for_protein($peg));
   unless ($ffp) {$ffp=" None "}
   # push @row, $peg, $ss, $ffp;
   $peg = "<a href='/FIG/protein.cgi?user=$user&prot=$peg'>$peg</a>\n";
   if ($first) {push @$tab, [$first, $peg, $ss, $ffp]; undef($first)} else {push @$tab, [$peg, $ss, $ffp]}
  }
 }
 
 my $list=join "</li>\n<li>", @unknowns;
 push @$html, &HTML::make_table(["ID", "FIG ID", "Subsystems this is in", "Protein Families this is in"], $tab, "IDs"), "\n",
 "<p>We do not know about the following IDs. Sorry.</p><ul><li>$list</li></ul>\n";
 
}






=head2 parse_ids

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.

=cut

sub parse_ids {
 my @given=@_;
 
 
 # here were are going to parse out what we were given. We will split on whitespace and commas
 
 my $want;
 # If you look through the code, and find a really long run on line, blame GJO
 # he complained about having to delete my beautifully functional code. Perhaps he is worried about
 # disk space or something.
 map {@{$want->{$_}}=$fig->by_alias($_) if ($_); s/^\s+//; s/\s+$//} map {split /[\s*\,]/, $_} @given;
 return $want;
}
 


MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3