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

View of /FigWebServices/protein_info.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.7 - (download) (annotate)
Tue Sep 20 17:29:31 2005 UTC (14 years, 8 months ago) by overbeek
Branch: MAIN
Changes since 1.6: +2 -0 lines
adding some help text

# -*- 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') || $cgi->param('fileupload'))
{
 &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, 
 $cgi->start_multipart_form(),
 "<h2>Generate information and links about a series of proteins</h2>\n",
 "<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",
 "<p>Typical IDs are in the following format:</p>\n",
 "<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",
 "<li>gi numbers &nbsp; These are just numeric, please add the characters 'gi|' to make a number like gi|16129669</li>\n",
 "<li>GenBank Accessions &nbsp; numbers and letters such as AAF12034</li>\n</ul>\n",
 "<li><b>SwissProt, PIR, Trembl, Uniprot</b> &nbsp; a single letter and some digits</li></ol>\n",
 "<b>Paste some IDs here:</b><br>",
 $cgi->textarea(-name=>"proteins", -rows=>10, -columns=>40), "<br>\n", 
 "<br><b>Or choose a file here</b><br>",
 $cgi->filefield(-name=>"fileupload", -size=>50), "<br>\n",
 $cgi->submit, $cgi->reset, $cgi->end_form;
 return $html;
}

sub show_info {
 my ($fig,$cgi,$html)=@_;
 
 if ($cgi->upload('fileupload'))
 {
  my $fh=$cgi->upload('fileupload');
  $cgi->param(-name=>'proteins', -value=>[(<$fh>)]);
 }

 my $ids=&parse_ids($cgi->param('proteins')); # this does it all in one but does not allow error checking

 # predefine the color section for the subsys link
 my $color="&color=" . join("&color=", map {@{$ids->{$_}}} keys %$ids);
 
 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}}) {
   
   # OLD STYLE: Regular link into the subsystems page
   # 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='subsys.cgi?&user=$user&ssa_name=". $_->[0] ."&request=show_ssa&show_clusters=1&sort=by_phylo'>" . $_->[0] . "</a>"} 
   #		(sort $fig->subsystems_for_peg($peg));

   # NEW STYLE: Link to displaysubsys.cgi
   #display_subsys.cgi?ssa_name=Capsular_polysaccharide_biosynthesis_in_Staphylococcus&color=uni|P95695&color=uni|Q99X66&uni|Q99X65
   my $ss = join "<br>\n", 
               map {"<a href='display_subsys.cgi?user=$user&ssa_name=". $_->[0] . "$color'>" . $_->[0] . "</a>"}
	       (sort $fig->subsystems_for_peg($peg));
   
   unless ($ss) {$ss=" None "}
   my $ffp=join "", map {"<a href='proteinfamilies.cgi?user=$user&family=$_'>" . $fig->family_function($_) . "</a><br>\n"} ($fig->families_for_protein($peg));
   unless ($ffp) {$ffp=" None "}
   if ($first) 
   {
     push @$tab, [$first, "<a href='protein.cgi?user=$user&prot=$peg'>$peg</a>\n", 
     	$fig->genus_species($fig->genome_of($peg)), scalar($fig->function_of($peg, $user)), $ss, $ffp]; undef($first)
   } 
   else 
   {
     push @$tab, ["<a href='protein.cgi?user=$user&prot=$peg'>$peg</a>\n", $fig->genus_species($fig->genome_of($peg)), 
     		scalar($fig->function_of($peg, $user)), $ss, $ffp]
   }
  }
 }
 
 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";
 if (scalar @unknowns) 
 {
   open (OUT, ">$FIG_Config::temp/protein_info_not_found.$$.txt") || die "Can't open $FIG_Config::temp/protein_info_not_found.$$.txt";
   print OUT join "\n", "For request from ", $cgi->remote_host, " couldn't find the following IDs", @unknowns, '';
   close OUT;
   my $list=join "</li>\n<li>", @unknowns;
   push @$html, "<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 {
   s/^\s+//; s/\s+$//;
   if (/^\d+$/) {$_="gi|".$_}
   elsif (/^[A-Z]\d+$/) {$_="uni|".$_}
   @{$want->{$_}}=$fig->by_alias($_) if ($_); 
   }
   map {split /[\s*\,]/, $_} 
   @given;
   
 return $want;
}
 

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3