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

Diff of /FigWebServices/protein_info.cgi

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.4, Fri Jul 15 17:19:24 2005 UTC revision 1.9, Wed Sep 21 00:29:14 2005 UTC
# Line 46  Line 46 
46    
47  unshift(@$html, "<TITLE>The SEED - Protein Information</TITLE>\n");  unshift(@$html, "<TITLE>The SEED - Protein Information</TITLE>\n");
48    
49    my $ids;
50    if ($cgi->param('request')) {
51     # figure out if we have any proteins and find out what they are
52     my @proteins=$cgi->param('proteins');
53     if ($cgi->upload('fileupload'))
54     {
55       my $fh=$cgi->upload('fileupload');
56       push @proteins, (<$fh>);
57     }
58     if ($cgi->param('korgs'))
59     {
60      push @proteins, map {$fig->pegs_of($_)} $cgi->param('korgs');
61     }
62     $ids=&parse_ids(@proteins); # this does it all in one but does not allow error checking
63    }
64    
65  if ($cgi->param('proteins'))  if ($ids && $cgi->param('request') eq "Protein Information")
66  {  {
67   &show_info($fig,$cgi,$html);   &protein_info($fig,$cgi,$html,$ids);
68    }
69    elsif ($ids && $cgi->param('request') eq "Subsystem Information")
70    {
71     &subsystem_info($fig,$cgi,$html,$ids);
72  }  }
73  else  else
74  {  {
# Line 64  Line 83 
83   my ($fig,$cgi,$html)=@_;   my ($fig,$cgi,$html)=@_;
84   # generate a blank page   # generate a blank page
85   push @$html,   push @$html,
86   $cgi->start_form(),   $cgi->start_multipart_form(),
87   "<h2>Generate information and links about a series of proteins</h2>\n",   "<h2>Generate information and links about a series of proteins</h2>\n",
88   "<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",   "<p>Please generate a list of protein IDs. There are several methods provided. You can choose one or more organisms from the scrolling list, you can paste some gene or protein IDs into the box or you can upload a file of IDs. Or you can do all three. 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",
89   "<p>Typical IDs are in the following format:</p>\n",   "<p>Typical IDs are in the following format:</p>\n",
90   "<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",   "<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",
91   "<li>gi numbers &nbsp; These are just numeric, please add the characters 'gi|' to make a number like gi|16129669</li>\n",   "<li>gi numbers &nbsp; These are just numeric, please add the characters 'gi|' to make a number like gi|16129669</li>\n",
92   "<li>GenBank Accessions &nbsp; numbers and letters such as AAF12034</li>\n</ul>\n",   "<li>GenBank Accessions &nbsp; numbers and letters such as AAF12034</li>\n</ul>\n",
93   "<li><b>SwissProt, PIR, Trembl, Uniprot</b> &nbsp; a single letter and some digits</li></ol>\n",   "<li><b>SwissProt, PIR, Trembl, Uniprot</b> &nbsp; a single letter and some digits</li></ol>\n",
94   "<p>Next, please paste some accesion numbers into the box below. You can separate your accessions with spaces, returns, or commas.</p>\n",   "<p>", $cgi->submit(-name=>'request', -value=>'Protein Information'), $cgi->submit(-name=>'request', -value=>'Subsystem Information'), $cgi->reset, "</p>\n",
95   $cgi->textarea(-name=>"proteins", -rows=>10, -columns=>40), "<br>",   "<br><b>Choose one or more organisms from this list:</b><br>\n",
96   $cgi->submit, $cgi->reset, $cgi->end_form;   $raelib->scrolling_org_list($cgi, "1"),
97     "<b>Or paste some IDs here:</b><br>\n",
98     $cgi->textarea(-name=>"proteins", -rows=>10, -columns=>40), "<br>\n",
99     "<br><b>Or choose a file here:</b><br>\n",
100     $cgi->filefield(-name=>"fileupload", -size=>50), "<br>\n",
101     $cgi->submit(-name=>'request', -value=>'Protein Information'), $cgi->submit(-name=>'request', -value=>'Subsystem Information'), $cgi->reset, $cgi->end_form;
102   return $html;   return $html;
103  }  }
104    
105  sub show_info {  sub protein_info {
106   my ($fig,$cgi,$html)=@_;   my ($fig,$cgi,$html,$ids)=@_;
107     # predefine the color section for the subsys link
108   my $ids=&parse_ids($cgi->param('proteins')); # this does it all in one but does not allow error checking   my $color="&color=" . join("&color=", map {@{$ids->{$_}}} keys %$ids);
109    
110   my $tab; my @unknowns;   my $tab; my @unknowns;
111   foreach my $key (keys %$ids) {   foreach my $key (keys %$ids) {
# Line 92  Line 116 
116    my $cs="td rowspan=".scalar(@{$ids->{$key}});    my $cs="td rowspan=".scalar(@{$ids->{$key}});
117    my $first=[$key, $cs];    my $first=[$key, $cs];
118    foreach my $peg (@{$ids->{$key}}) {    foreach my $peg (@{$ids->{$key}}) {
119    
120       # OLD STYLE: Regular link into the subsystems page
121     # 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"     # 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"
122       #my $ss = join "<br>\n",
123       #            map {"<a href='subsys.cgi?&user=$user&ssa_name=". $_->[0] ."&request=show_ssa&show_clusters=1&sort=by_phylo'>" . $_->[0] . "</a>"}
124       #            (sort $fig->subsystems_for_peg($peg));
125    
126       # NEW STYLE: Link to displaysubsys.cgi
127       #display_subsys.cgi?ssa_name=Capsular_polysaccharide_biosynthesis_in_Staphylococcus&color=uni|P95695&color=uni|Q99X66&uni|Q99X65
128     my $ss = join "<br>\n",     my $ss = join "<br>\n",
129                  map {"<a href='/FIG/subsys.cgi?&user=$user&ssa_name=". $_->[0] ."&request=show_ssa&show_clusters=1&sort=by_phylo'>" . $_->[0] . "</a>"}                 map {"<a href='display_subsys.cgi?user=$user&ssa_name=". $_->[0] . "$color'>" . $_->[0] . "</a>"}
130                  (sort $fig->subsystems_for_peg($peg));                  (sort $fig->subsystems_for_peg($peg));
131    
132     unless ($ss) {$ss=" None "}     unless ($ss) {$ss=" None "}
133     my $ffp=join "", map {"<a href='/FIG/proteinfamilies.cgi?user=$user&family=$_'>" . $fig->family_function($_) . "</a><br>\n"} ($fig->families_for_protein($peg));     my $ffp=join "", map {"<a href='proteinfamilies.cgi?user=$user&family=$_'>" . $fig->family_function($_) . "</a><br>\n"} ($fig->families_for_protein($peg));
134     unless ($ffp) {$ffp=" None "}     unless ($ffp) {$ffp=" None "}
135     if ($first)     if ($first)
136     {     {
137       push @$tab, [$first, "<a href='/FIG/protein.cgi?user=$user&prot=$peg'>$peg</a>\n", scalar($fig->function_of($peg, $user)), $ss, $ffp]; undef($first)       push @$tab, [$first, "<a href='protein.cgi?user=$user&prot=$peg'>$peg</a>\n",
138            $fig->genus_species($fig->genome_of($peg)), scalar($fig->function_of($peg, $user)), $ss, $ffp]; undef($first)
139     }     }
140     else     else
141     {     {
142       push @$tab, ["<a href='/FIG/protein.cgi?user=$user&prot=$peg'>$peg</a>\n", scalar($fig->function_of($peg, $user)), $ss, $ffp]       push @$tab, ["<a href='protein.cgi?user=$user&prot=$peg'>$peg</a>\n", $fig->genus_species($fig->genome_of($peg)),
143                    scalar($fig->function_of($peg, $user)), $ss, $ffp]
144     }     }
145    }    }
146   }   }
147    
148   push @$html, &HTML::make_table(["ID", "FIG ID", "Functional Role", "Subsystems", "Protein Families"], $tab, "IDs"), "\n";   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";
149   if (scalar @unknowns)   if (scalar @unknowns)
150   {   {
151     open (OUT, ">$FIG_Config::temp/protein_info_not_found.$$.txt") || die "Can't open $FIG_Config::temp/protein_info_not_found.$$.txt";     open (OUT, ">$FIG_Config::temp/protein_info_not_found.$$.txt") || die "Can't open $FIG_Config::temp/protein_info_not_found.$$.txt";
# Line 123  Line 158 
158  }  }
159    
160    
161    sub subsystem_info {
162     my ($fig,$cgi,$html,$ids)=@_;
163     # predefine the color section for the subsys link
164     my $color="&color=" . join("&color=", map {@{$ids->{$_}}} keys %$ids);
165    
166     my $ss; my $pegcount;
167     map {
168      my $peg=$_;
169      map {$ss->{$_->[0]}->{$peg}++; $pegcount->{$peg}++}
170      $fig->subsystems_for_peg($peg);
171     }
172     map {@{$ids->{$_}}} keys %$ids;
173    
174     # generate the links to subsystems
175     push @$html, "<h3>Subsystems: # of pegs with matching expression level</h3>\n<ul>\n";
176     push @$html, map {
177      my $color="&color=" . join("&color=", keys %{$ss->{$_}});
178      $_="<li><a href='display_subsys.cgi?user=$user&ssa_name=$_$color'>$_</a> (".(scalar(keys %{$ss->{$_}})).")</li>\n";
179      }
180      sort {scalar(keys %{$ss->{$b}}) <=> scalar(keys %{$ss->{$a}})}  keys %$ss;
181     push @$html, "</ul>\n";
182    
183     # now generate the ones that don't have links
184     push @$html, "<hr>\n<h3>Pegs Not in Subsystem</h3>\n<ul>";
185     push @$html,
186      map {$_="<li><a href='protein.cgi?user=$user&prot=$_'>$_</a></li>\n"}
187      grep {!$pegcount->{$_}}
188      map {@{$ids->{$_}}}
189      sort {$a cmp $b} keys %$ids;
190     push @$html, "</ul>\n";
191    
192    }
193    
194    
195    
# Line 143  Line 210 
210   # If you look through the code, and find a really long run on line, blame GJO   # If you look through the code, and find a really long run on line, blame GJO
211   # he complained about having to delete my beautifully functional code. Perhaps he is worried about   # he complained about having to delete my beautifully functional code. Perhaps he is worried about
212   # disk space or something.   # disk space or something.
 # map {@{$want->{$_}}=$fig->by_alias($_) if ($_); s/^\s+//; s/\s+$//} map {split /[\s*\,]/, $_} @given;  
213   map {   map {
214     s/^\s+//; s/\s+$//;     s/^\s+//; s/\s+$//;
215     if (/^\d+$/) {$_="gi|".$_}     if (/^\d+$/) {$_="gi|".$_}

Legend:
Removed from v.1.4  
changed lines
  Added in v.1.9

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3