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

View of /FigWebServices/feature.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.4 - (download) (annotate)
Fri Oct 8 19:20:38 2004 UTC (15 years, 9 months ago) by disz
Branch: MAIN
CVS Tags: merge-trunktag-bobdev_news-2, Root-bobdev_news, merge-bobdev_news-1, merge-trunktag-bobdev_news-1, merge-bodev_news-3, merge-bobdev_news-2, merge-trunktag-bodev_news-3
Branch point for: Branch-bobdev_news
Changes since 1.3: +0 -19 lines
Feature page works with pi

use FIG;
my $fig = new FIG;

use HTML;
use strict;
use GenoGraphics;
use CGI;
my $cgi = new CGI;

if (0)
{
    my $VAR1;
    eval(join("",`cat /tmp/protein_parms`));
    $cgi = $VAR1;
#   print STDERR &Dumper($cgi);
}

if (0)
{
    print $cgi->header;
    my @params = $cgi->param;
    print "<pre>\n";
    foreach $_ (@params)
    {
	print "$_\t:",join(",",$cgi->param($_)),":\n";
    }

    if (0)
    {
	if (open(TMP,">/tmp/protein_parms"))
	{
	    print TMP &Dumper($cgi);
	    close(TMP);
	}
    }
    exit;
}

my $html = [];
unshift @$html, "<TITLE>The SEED Feature Page</TITLE>\n";

my $feature = $cgi->param('feature');
if (! $feature)
{
    unshift @$html, "<TITLE>The SEED: Feature Page</TITLE>\n";
    push(@$html,"<h1>Sorry, you need to specify a feature</h1>\n");
    &HTML::show_page($cgi,$html);
    exit;
}

if ($feature !~ /^fig\|/)
{
    if ($_ = $fig->by_alias($feature))
    {
	$feature = $_;
    }
    else
    {
	unshift @$html, "<TITLE>The SEED: Feature Page</TITLE>\n";
	push(@$html,"<h1>Sorry, $feature appears not to have a FIG id at this point</h1>\n");
	&HTML::show_page($cgi,$html);
	exit;
    }
}

my $request = $cgi->param("request") || "";

if ($request eq "view_annotations")       { &view_annotations($fig,$cgi,$html,$feature); }
elsif ($request eq "view_all_annotations")   { &view_all_annotations($fig,$cgi,$html,$feature); }
elsif ($request eq "dna_sequence")           { &dna_sequence($fig,$cgi,$html,$feature); }
else                                         { &show_initial($fig,$cgi,$html,$feature); }


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


#==============================================================================
#  view_annotations
#==============================================================================

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

    unshift @$html, "<TITLE>The SEED: eature Annotations</TITLE>\n";
    my $col_hdrs = ["who","when","annotation"];
    my $tab = [ map { [$_->[2],$_->[1],"<pre>" . $_->[3] . "<\/pre>"] } $fig->feature_annotations($feature) ];
    if (@$tab > 0)
    {
	push(@$html,&HTML::make_table($col_hdrs,$tab,"Annotations for $feature"));
    }
    else
    {
	push(@$html,"<h1>No Annotations for $feature</h1>\n");
    }
}

sub view_all_annotations {
    my($fig,$cgi,$html,$peg) = @_;
    my($ann);

    unshift @$html, "<TITLE>The SEED: Protein Annotations</TITLE>\n";
    if ($fig->is_real_feature($peg))
    {
	my $col_hdrs = ["who","when","PEG","genome","annotation"];
	my @related  = $fig->related_by_func_sim($peg,$cgi->param('user'));
	push(@related,$peg);

	my @annotations = $fig->merged_related_annotations(\@related);

	my $tab = [ map { $ann = $_; 
			  [$ann->[2],$ann->[1],&HTML::fid_link($cgi,$ann->[0]),
			   $fig->genus_species(&FIG::genome_of($ann->[0])),
			   "<pre>" . $ann->[3] . "</pre>"
			   ] } @annotations];
	if (@$tab > 0)
	{
	    push(@$html,&HTML::make_table($col_hdrs,$tab,"All Related Annotations for $peg"));
	}
	else
	{
	    push(@$html,"<h1>No Annotations for $peg</h1>\n");
	}
    }
}


#==============================================================================
#  show_initial
#==============================================================================

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

    unshift @$html, "<TITLE>The SEED: Feature Page</TITLE>\n";
    my $gs = $fig->org_of($feature);
	if (! $fig->is_real_feature($feature))
	{
	    push(@$html,"<h1>Sorry, $feature is an unknown identifier</h1>\n");
	}
	else
	{
	    push(@$html,"<h1>Feature $feature: $gs</h1>\n");
	    my $url = $cgi->self_url();
	    &display_peg($fig,$cgi,$html,$feature);
	}
}

#==============================================================================
#  display_peg
#==============================================================================

sub display_peg {
    my($fig,$cgi,$html,$peg) = @_;
    my $loc;

    my $half_sz = 5000;

    if ($loc = $fig->feature_location($peg))
    {
	my($contig,$beg,$end) = &FIG::boundaries_of($loc);
	my $min = &FIG::max(0,&FIG::min($beg,$end) - $half_sz);
	my $max = &FIG::max($beg,$end) + $half_sz;
	my($feat,$min,$max) = $fig->genes_in_region(&FIG::genome_of($peg),$contig,$min,$max);

	&print_context($fig,$cgi,$html,$peg,$feat,$min,$max);
    }

    #&print_assignments($fig,$cgi,$html,$peg);
    my @links = $fig->peg_links($peg);
    if (@links > 0)
    {
        my $col_hdrs = [1,2,3,4,5];
        my $title    = "Links to Related Entries in Other Sites";
        my $tab = [];
        my ($n,$i);
        for ($i=0; ($i < @links); $i += 5)
        {
            $n = (($i + (5-1)) < @links) ? $i+(5-1) : $i+(@links - $i);
            push(@$tab,[@links[$i..$n]]);
        }
        push(@$html,&HTML::make_table($col_hdrs,$tab,$title));
    }
    push(@$html,$cgi->hr);
    my $link1 = $cgi->self_url() . "&request=view_annotations";
    my $link2 = $cgi->self_url() . "&request=view_all_annotations";
    push(@$html,"<br><a href=$link1>To View Annotations</a>/<a href=$link2>To View All Related Annotations</a>\n");


    my $link = $cgi->self_url() . "&request=dna_sequence";
    push(@$html,"<br><a href=$link>DNA Sequence</a>\n");

    $link = $cgi->url();
    $link =~ s/protein.cgi/fid_checked.cgi/;
    my $user = $cgi->param('user');
    if (! $user) 
    { 
	$user = "";
    }
    else
    {
	$link = $link . "?fid=$feature&user=$user&checked=$feature&assign/annotate=assign/annotate";
	push(@$html,"<br><a href=$link target=checked_window>To Make an Annotation</a>\n");
    }

    my $has_translation = $fig->translatable($peg);


}




################# Context on the Chromosome ############################

sub print_context {
    my($fig,$cgi,$html,$peg,$feat,$beg,$end) = @_;
    my($contig1,$beg1,$end1,$strand,$max_so_far,$comment, $aliases);
    my($fid1,$sz,$color,$map,$gg,$n,$link);


    my $user = $cgi->param('user');
    push(@$html,$cgi->start_form(-action => &FIG::cgi_url . "/chromosomal_clusters.cgi"),
		$cgi->hidden(-name => "feature", -value => $peg),
	        $cgi->hidden(-name => "user", -value => $user));

    my $col_hdrs = ["fid","starts","ends","size","","comment","aliases"];
    my($tab) = [];
    my $genes = [];
    
    #my $peg_function = &trans_function_of($cgi,$fig,$peg,$user);

    #my($role,$role1,%related_roles);
    #foreach $role (&FIG::roles_of_function($peg_function))
    #{
#	foreach $role1 ($fig->neighborhood_of_role($role))
#	{
#	    $related_roles{$role1} = 1;
#	}
#    }

    foreach $fid1 (@$feat)
    {
	$aliases = join( ', ', $fig->feature_aliases($fid1) );
	($contig1,$beg1,$end1) = $fig->boundaries_of(scalar $fig->feature_location($fid1));;
	$strand = ($beg1 < $end1) ? "+" : "-";

	if     ($fid1 eq $peg)    { $color = "green" }
	else                      { $color = "red" }

	if ($fid1 =~ /peg\.(\d+)$/)
	{
	    $n = $1;
	    $link = $cgi->url() . "?feature=$fid1&user=$user";
	}
	elsif ($fid1 =~ /\.([a-z]+)\.\d+$/)
	{
	    $n = uc $1;
	    $link = "";
	}
	else
	{
	    $n ="";
	    $link = "";
	}
	    
	push(@$genes,[&FIG::min($beg1,$end1),&FIG::max($beg1,$end1),($strand eq "+") ? "rightArrow" : "leftArrow", $color,$n,$link]);
	$max_so_far = &FIG::max($beg1,$end1);
	
	
	if (&FIG::ftype($fid1) eq "peg")
	{
	    $comment = &trans_function_of($cgi,$fig,$fid1,$user);
	}
	else
	{
	    $comment = "";
	}
	$comment = &set_map_links($fig,&FIG::genome_of($fid1),$comment);
	if ($fid1 eq $peg)
	{
	    $comment = "\@bgcolor=\"#00FF00\":$comment";
	}
	$sz = abs($end1-$beg1)+1;


	push(@$tab,[&HTML::fid_link($cgi,$fid1,"local"),$beg1,$end1,$sz,$strand,
                    $comment,&HTML::set_prot_links($cgi,$aliases)]);
    }
    $map = ["",$beg,$end,$genes];
    $gg = [$map];
    push(@$html,&HTML::make_table($col_hdrs,$tab,"Context on contig $contig1"));
#    push(@$html,$cgi->br,$cgi->submit('pin with checked genes'),$cgi->end_form,$cgi->br);
    push(@$html,@{ &GenoGraphics::render($gg,700,4,0,1) });
    return;
}

sub set_map_links {
    my($fig,$org,$func) = @_;

    if ($func =~ /^(.*)(\d+\.\d+\.\d+\.\d+)(.*)$/)
    {
	my $before = $1;
	my $ec     = $2;
	my $after  = $3;
	return &set_map_links($fig,$org,$before) . &set_ec_to_maps($fig,$org,$ec) . &set_map_links($fig,$org,$after);
    }
    return $func;
}

sub set_ec_to_maps {
    my($fig,$org,$ec) = @_;

    my @maps = $fig->ec_to_maps($ec);
    if (@maps > 0)
    {
	$cgi->delete('request');
	my $url  = $cgi->self_url() . "&request=ec_to_maps&ec=$ec&org=$org";
	my $link = "<a href=\"$url\">$ec</a>";
	return $link;
    }
    return $ec;
}

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

    my $ec = $cgi->param('ec');
    if (! $ec)
    {
	push(@$html,$cgi->h1("Missing EC number"));
	return;
    }

    my @maps = $fig->ec_to_maps($ec);
    if (@maps > 0)
    {
	my $col_hdrs = ["map","metabolic topic"];
	my $map;
	my $tab      = [map { $map = $_; [&map_link($cgi,$map),$fig->map_name($map)] } @maps];
	push(@$html,&HTML::make_table($col_hdrs,$tab,"$ec: " . $fig->ec_name($ec)));
    }
}

sub map_link {
    my($cgi,$map) = @_;

    $cgi->delete('request');
    my $url  = $cgi->self_url() . "&request=link_to_map&map=$map";
    my $link = "<a href=\"$url\">$map</a>";
    return $link;
}

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

    my $map = $cgi->param('map');
    if (! $map)
    {
	push(@$html,$cgi->h1("Missing Map"));
	return;
    }

    my $org = $cgi->param('org');
    if (! $org)
    {
	push(@$html,$cgi->h1("Missing Org Parameter"));
	return;
    }
    my$user = $cgi->param('user');
    $user = $user ? $user : "";

    $ENV{"REQUEST_METHOD"} = "GET";
    $ENV{"QUERY_STRING"} = "user=$user&map=$map&org=$org";
    my @out = `./show_kegg_map.cgi`;
    &HTML::trim_output(\@out);
    push(@$html,@out);
}
	    

sub dna_sequence {
    my($fig,$cgi,$html,$fid) = @_;
    my($seq,$func,$i);

    unshift @$html, "<TITLE>The SEED: Nucleotide Sequence</TITLE>\n";
    if ($seq = $fig->dna_seq($fig->genome_of($fid),scalar $fig->feature_location($fid)))
    {
	$func = $fig->function_of($feature,$cgi->param('user'));
	push(@$html,$cgi->pre,">$fid $func\n");
	for ($i=0; ($i < length($seq)); $i += 60)
	{
	    if ($i > (length($seq) - 60))
	    {
		push(@$html,substr($seq,$i) . "\n");
	    }
	    else
	    {
		push(@$html,substr($seq,$i,60) . "\n");
	    }
	}
	push(@$html,$cgi->end_pre);
    }
    else
    {
	push(@$html,$cgi->h1("No DNA sequence available for $fid"));
    }
}
	             



sub in {
    my($x,$xL) = @_;
    my($i);

    for ($i=0; ($i < @$xL) && ($x != $xL->[$i]); $i++) {}
    return ($i < @$xL);
}

sub in_bounds {
    my($min,$max,$x) = @_;

    if     ($x < $min)     { return $min }
    elsif  ($x > $max)     { return $max }
    else                   { return $x   }
}

sub decr_coords {
    my($genes,$min) = @_;
    my($gene);

    foreach $gene (@$genes)
    {
	$gene->[0] -= $min;
	$gene->[1] -= $min;
    }
    return $genes;
}

sub flip_map {
    my($genes,$min,$max) = @_;
    my($gene);
    
    foreach $gene (@$genes)
    {
	($gene->[0],$gene->[1]) = ($max - $gene->[1],$max - $gene->[0]);
	$gene->[2] = ($gene->[2] eq "rightArrow") ? "leftArrow" : "rightArrow";
    }
    return $genes;
}

sub cluster_genes {
    my($all_pegs,$peg) = @_;
    my(%seen,$i,$j,$k,$x,$cluster,$conn,$pegI,$red_set);

    my @color_sets = ();

    $conn = &get_connections_by_similarity($all_pegs);
    for ($i=0; ($i < @$all_pegs); $i++)
    {
	if ($all_pegs->[$i] eq $peg) { $pegI = $i }
	if (! $seen{$i})
	{
	    $cluster = [$i];
	    $seen{$i} = 1;
	    for ($j=0; ($j < @$cluster); $j++)
	    {
		$x = $conn->{$cluster->[$j]};
		foreach $k (@$x)
		{
		    if (! $seen{$k})
		    {
			push(@$cluster,$k);
			$seen{$k} = 1;
		    }
		}
	    }

	    if ((@$cluster > 1) || ($cluster->[0] eq $pegI))
	    {
		push(@color_sets,$cluster);
	    }
	}
    }
    for ($i=0; ($i < @color_sets) && (! &in($pegI,$color_sets[$i])); $i++) {}
    $red_set = $color_sets[$i];
    splice(@color_sets,$i,1);
    @color_sets = sort { @$b <=> @$a } @color_sets;
    unshift(@color_sets,$red_set);

    my $color_sets = {};
    for ($i=0; ($i < @color_sets); $i++)
    {
	foreach $x (@{$color_sets[$i]})
	{
	    $color_sets->{$all_pegs->[$x]} = $i;
	}
    }
    return $color_sets;
}

sub get_connections_by_similarity {
    my($all_pegs) = @_;
    my($i,$j,$tmp,$peg,%pos_of);
    my($sim,%conn,$x,$y);

    for ($i=0; ($i < @$all_pegs); $i++)
    {
	$tmp = $fig->maps_to_id($all_pegs->[$i]);
	push(@{$pos_of{$tmp}},$i);             # map the representative in nr to subscript in all_pegs
	if ($tmp ne $all_pegs->[$i])
	{
	    push(@{$pos_of{$all_pegs->[$i]}},$i);
	}
    }

    foreach $y (keys(%pos_of))
    {
	$x = $pos_of{$y};
	for ($i=0; ($i < @$x); $i++)
	{
	    for ($j=$i+1; ($j < @$x); $j++)
	    {
		push(@{$conn{$x->[$i]}},$x->[$j]);
		push(@{$conn{$x->[$j]}},$x->[$i]);
	    }
	}
    }

    for ($i=0; ($i < @$all_pegs); $i++)
    {
	foreach $sim ($fig->sims($all_pegs->[$i],500,1.0e-5,"raw"))
	{
	    if (defined($x = $pos_of{$sim->id2}))
	    {
		foreach $y (@$x)
		{
		    push(@{$conn{$i}},$y);
		}
	    }
	}
    }
    return \%conn;
}

sub set_colors_text_and_links {
    my($gg,$all_pegs,$color_sets) = @_;
    my($map,$gene,$peg,$color);

    foreach $map (@$gg)
    {
	foreach $gene (@{$map->[3]})
	{
	    $peg = $gene->[5];
	    if (defined($color = $color_sets->{$peg}))
	    {
		$gene->[3] = ($color == 0) ? "red" : "color$color";
		$gene->[4] = $color + 1;
	    }
	    $gene->[5] = &peg_url($cgi,$peg);
	}
    }
}

sub peg_url {
    my($cgi,$peg) = @_;

    my $prot = $cgi->param('prot');
    $cgi->delete('prot');
    my $url  = $cgi->self_url() . "&prot=$peg&compare_region=1";
    $cgi->delete('prot');
    $cgi->param(-name => 'prot', -value => $prot);

    return $url;
}    

sub trans_function_of {
    my($cgi,$fig,$peg,$user) = @_;

    if (wantarray())
    {
	my $x;
	my @funcs = $fig->function_of($peg);
	if ($cgi->param('translate'))
	{
	    @funcs = map { $x = $_; $x->[1] = $fig->translate_function($x->[1]); $x } @funcs;
	}
	return @funcs;
    }
    else
    {
	my $func = $fig->function_of($peg,$user);
	if ($cgi->param('translate'))
	{
	    $func = $fig->translate_function($func);
	}
	return $func;
    }
}


MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3