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

View of /FigWebServices/index.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.46 - (download) (annotate)
Tue Sep 7 02:54:16 2004 UTC (15 years, 6 months ago) by overbeek
Branch: MAIN
Changes since 1.45: +8 -6 lines
add new subsystem interface

use FIG;
my $fig = new FIG;

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

my($map,@orgs,$user,$map,$org,$made_by,$from_func,$to_func);

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

$ENV{"PATH"} = "$FIG_Config::bin:$FIG_Config::ext_bin:" . $ENV{"PATH"};

my $html = [];


my($pattern,$seq_pat,$tool,$ids);
my $user = $cgi->param('user');
if (! $user) { $user = "" }

if ($cgi->param('Search for Genes Matching an Occurrence Profile or Common to a Set of Organisms'))
{
    unshift @$html, "<TITLE>The SEED: Phylogenetic Signatures</TITLE>\n";
    my $url = $cgi->url;
    $ENV{"REQUEST_METHOD"} = "GET";
    $ENV{"QUERY_STRING"} = "user=$user";
    my @out = `./sigs.cgi`;
    &HTML::trim_output(\@out);
    push(@$html,@out);
}
#-----------------------------------------------------------------------
#  Align Sequences
#-----------------------------------------------------------------------
elsif ($cgi->param('Align Sequences'))
{
    my $seqs = $cgi->param('seqids');
    $seqs =~ s/^\s+//;
    $seqs =~ s/\s+$//;
    my @seq_ids = split(/[ \t,;]+/,$seqs);
    if (@seq_ids < 2)
    {
	print $cgi->header;
	print $cgi->h1("Sorry, you need to specify at least two sequence IDs");
    }
    else
    {
	$ENV{"REQUEST_METHOD"} = "GET";
	$_ = join('&checked=',@seq_ids);
	$ENV{"QUERY_STRING"} = "user=$user&align=1&checked=" . $_;
	my @out = `./fid_checked.cgi`;
	print join("",@out);
    }
    exit;
}
#-----------------------------------------------------------------------
#  Search (text) || Find Genes in Org that Might Play the Role
#-----------------------------------------------------------------------
elsif (($pattern = $cgi->param('pattern')) && ($cgi->param('Search') || $cgi->param('Find Genes in Org that Might Play the Role')))
{
    #  Remove leading and trailing spaces from pattern -- GJO:
    $pattern =~ s/^\s+//;
    $pattern =~ s/\s+$//;
    if ($cgi->param('Find Genes in Org that Might Play the Role') &&
	(@orgs = $cgi->param('korgs')) && (@orgs == 1))
    {
	unshift @$html, "<TITLE>The SEED: Genes in that Might Play Specific Role</TITLE>\n";
	@orgs = map { $_ =~ /\((\d+\.\d+)\)/; $1 } @orgs;
	$ENV{"REQUEST_METHOD"} = "GET";
	$ENV{"QUERY_STRING"} = "user=$user&request=find_in_org&role=$pattern&org=$orgs[0]";
	my @out = `./pom.cgi`;
	print join("",@out);
	exit;
    }
    else
    {
	unshift @$html, "<TITLE>The SEED: Search Results</TITLE>\n";
	&show_indexed_objects($fig, $cgi, $html, $pattern);
    }
}
#-----------------------------------------------------------------------
#  Metabolic Overview
#-----------------------------------------------------------------------
elsif (($map = $cgi->param('kmap')) && $cgi->param('Metabolic Overview'))
{
    if ($map =~ /\(([^)]*)\)$/)
    {
	$map = $1;
    }
    else
    {
	# ??? Gary ???
    }

    #$map =~ s/^.*\((MAP\d+)\).*$/$1/;
    @orgs = $cgi->param('korgs');
    @orgs = map { $_ =~ /\((\d+\.\d+)\)/; $1 } @orgs;
    $ENV{"REQUEST_METHOD"} = "GET";
    if (@orgs > 0)
    {
	$ENV{"QUERY_STRING"} = "user=$user&map=$map&org=$orgs[0]";
    }
    else
    {
	$ENV{"QUERY_STRING"} = "user=$user&map=$map";
    }

    unshift @$html, "<TITLE>The SEED: Metabolic Overview</TITLE>\n";
    my @out = `./show_map.cgi`;
    &HTML::trim_output(\@out);
    push( @$html, "<br>\n", @out );
}

#-----------------------------------------------------------------------
#  Search for Matches (sequence or pattern)
#-----------------------------------------------------------------------
elsif (($seq_pat = $cgi->param('seq_pat')) && 
       ($tool = $cgi->param('Tool')) &&
       $cgi->param('Search for Matches'))
{
    @orgs = $cgi->param('korgs');
    if (@orgs > 0)
    {
	@orgs = map { $_ =~ /\((\d+\.\d+)\)/; $1 } @orgs;
    }
    else
    {
	@orgs = ("");
    }

    if ($tool =~ /blast/)
    {
	unshift @$html, "<TITLE>The SEED: BLAST Search Results</TITLE>\n";
	&run_blast($fig,$cgi,$html,$orgs[0],$tool,$seq_pat);
    }
    elsif ($tool =~ /Protein scan_for_matches/)
    {
	unshift @$html, "<TITLE>The SEED: Protein Pattern Match Results</TITLE>\n";
	&run_prot_scan_for_matches($fig,$cgi,$html,$orgs[0],$seq_pat);
    }
    elsif ($tool =~ /DNA scan_for_matches/)
    {
	unshift @$html, "<TITLE>The SEED: Nucleotide Pattern Match Results</TITLE>\n";
	&run_dna_scan_for_matches($fig,$cgi,$html,$orgs[0],$seq_pat);
    }
}
elsif (($made_by = $cgi->param('made_by')) && $cgi->param('Extract Assignments'))
{
    &export_assignments($fig,$cgi,$html,$made_by);
}
elsif ($cgi->param('Generate Assignments via Translation') &&
       ($from_func = $cgi->param('from_func')) &&
       ($to_func = $cgi->param('to_func')))
{
    &translate_assignments($fig,$cgi,$html,$from_func,$to_func);
}
elsif ($cgi->param('Extract Matched Sequences') && ($ids = $cgi->param('ids')))
{
    my @ids = split(/,/,$ids);
    my($list_to,$i);
    if ($list_to = $cgi->param('list_to'))
    {
	for ($i=0; ($i < @ids) && ($ids[$i] ne $list_to); $i++) {}
	if ($i < @ids)
	{
	    $#ids = $i;
	}
    }

    my($id,$seq,$i,$func);
    push(@$html,$cgi->pre);

    foreach $id (@ids)
    {
	if ($seq = $fig->get_translation($id))
	{
	    $func = $fig->function_of($id);
	    push(@$html,">$id $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);
}

#-----------------------------------------------------------------------
#  Initial search page
#-----------------------------------------------------------------------
else
{
    unshift @$html, "<TITLE>The SEED: Entry Page</TITLE>\n";
    &show_initial($fig,$cgi,$html);
}
&HTML::show_page($cgi,$html,1);


#==============================================================================
#  Initial page (alias search)
#==============================================================================

sub show_initial {
    my($fig,$cgi,$html) = @_;
    my($map,$name,$olrg,$gs);

    my($a,$b,$e,$v) = $fig->genome_counts;
    push(@$html,$cgi->h2("Contains $a archaeal, $b bacterial, $e eukaryotic, and $v viral genomes"));
    my($a,$b,$e,$v) = $fig->genome_counts("complete");
    push(@$html,$cgi->h2("Of these, $a archaeal, $b bacterial, and $e eukaryotic genomes are more-or-less complete"),$cgi->hr);
    
    my @maps = sort map { $map = $_; $name = $fig->map_name($map); "$name ($map)" } $fig->all_maps;
    my @orgs = sort map { $org = $_; $gs = $fig->genus_species($org); "$gs ($org)" } $fig->genomes("complete",undef);

    push(@$html,
	 $cgi->h2('Work on Subsystems'),
	 $cgi->start_form(-action => "ssa2.cgi"),
	 "Enter user: ",
	 $cgi->textfield(-name => "user", -size => 20),
	 $cgi->submit('Work on Subsystems'),
	 $cgi->end_form,

	 $cgi->h2('Work on Subsystems Using New, Experimental Code'),
	 "You should try this only if you know how to back yourself up.  This code is new and will be officially released soon.",
	 $cgi->start_form(-action => "subsys.cgi"),
	 "Enter user: ",
	 $cgi->textfield(-name => "user", -size => 20),
	 $cgi->submit('Work on Subsystems'),
	 $cgi->end_form,
	 $cgi->hr,
	);

    push(@$html,
	        $cgi->start_form(-action => "index.cgi"),
	        $cgi->h2('Searching for Genes or Functional Roles Using Text'),
	        "<table><tr>",
                "<td>Search Pattern: </td><td>",
	        $cgi->textfield(-name => "pattern", -size => 65),
	        "</td></tr><tr>",
	        "<td>User ID:</td><td>",
	        $cgi->textfield(-name => "user", -size => 20),
	        " [optional] ",
                "&nbsp; &nbsp; Max Genes: ",
	        $cgi->textfield(-name => "maxpeg",  -size => 6, -value => 100),
                "&nbsp; &nbsp; Max Roles: ",
	        $cgi->textfield(-name => "maxrole", -size => 6, -value => 100),
	        "</td></td></table>",
	        $cgi->submit('Search'),
	        $cgi->reset('Clear'));

    push(@$html, $cgi->hr, 
	        $cgi->h2('If You Need to Pick an Organism for Options Below'),
	        $cgi->scrolling_list(-name => 'korgs',
                                     -values => [@orgs],
				     -size => 10
                                    ),
	        $cgi->hr,

	        $cgi->h2('Finding Candidates for a Functional Role'),
	        "Make sure that you type the functional role you want to search for in the Search Pattern above",
	        $cgi->br,
	        $cgi->submit('Find Genes in Org that Might Play the Role'),
	        $cgi->hr,

	        $cgi->h2('Metabolic Overviews and Subsystem Maps (via KEGG & SEED) - Choose Map'),
	        $cgi->submit('Metabolic Overview'),
	        $cgi->br,
	        $cgi->br,
	        $cgi->scrolling_list(-name => 'kmap',
                                     -values => [@maps],
				     -size => 10
                                    ),
	        $cgi->hr,

	        $cgi->h2('Searching DNA or Protein Sequences (in a selected organism)'),
	        "<TABLE>\n",
	        "    <TR>\n",
	        "        <TD>Sequence/Pattern: </TD>",
	        "        <TD Colspan=3>", $cgi->textarea(-name => 'seq_pat', -rows => 10, -cols => 70), "</TD>\n",
	        "    </TR>\n",
	        "    <TR>\n",
	        "        <TD>Search Program: </TD>",
	        "        <TD>", $cgi->popup_menu(-name => 'Tool', -values => ['blastp', 'blastx', 'blastn', 'tblastn', 'blastp against complete genomes', 'Protein scan_for_matches', 'DNA scan_for_matches'], -default => 'blastp'), " </TD>",
	        "        <TD> Program Options:</TD>",
	        "        <TD>", $cgi->textfield( -name => "blast_options", -size => 27 ), "</TD>",
	        "    </TR>\n",
	        "</TABLE>\n",
	        $cgi->submit('Search for Matches'),
	        $cgi->hr);

    #
    # Make assignment export tbl.
    #

    my @atbl;
    push(@atbl, ["Extract assignments made by ",
		 $cgi->textfield(-name => "made_by", -size => 50)]);
    push(@atbl, ["Save as user: ",
	        $cgi->textfield(-name => "save_user", -size => 50)]);
    push(@atbl, ["After date (MM/DD/YYYY) ",
		$cgi->textfield(-name => "after_date", -size => 15)]);

    push(@$html, 
	 $cgi->h2('Exporting Assignments'),
	 &HTML::make_table(undef, \@atbl, '', border => 0),
	        $cgi->checkbox(-label => 'tab-delimited Spreadsheet: ', -name => 'tabs', -value => 1),
		$cgi->br,
	        $cgi->checkbox(-label => 'Save Assignments: ', -name => 'save_assignments', -value => 1),
	        $cgi->br,
	        $cgi->submit('Extract Assignments'),
	        $cgi->br, $cgi->br,
	        "Alternatively, you can generate a set of assignments as translations of existing assignments.",
	        $cgi->br,
		"From: ",$cgi->textfield(-name => "from_func", -size => 60),
	        $cgi->br,
		"To:&nbsp;&nbsp;&nbsp;&nbsp; ",$cgi->textfield(-name => "to_func", -size => 60), 
	        $cgi->br,
	        $cgi->submit('Generate Assignments via Translation'),
	        $cgi->hr,
	        $cgi->h2('Searching for Interesting Genes'),
	        $cgi->submit('Search for Genes Matching an Occurrence Profile or Common to a Set of Organisms'),
                $cgi->end_form
	 );

    push(@$html,
	        $cgi->hr,
	        $cgi->h2('Process Saved Assignments Sets'),
	        $cgi->start_form(-action => "assignments.cgi"),
	        "Enter user: ",
	        $cgi->textfield(-name => "user", -size => 20),
	        $cgi->submit('Process Assignment Sets'),
                $cgi->end_form
	 );

    push(@$html,
	        $cgi->hr,
	        $cgi->h2('Align Sequences'),
	        $cgi->start_form(-action => "index.cgi"),
	        "Enter user: ",
	        $cgi->textfield(-name => "user", -size => 20), $cgi->br,
	        $cgi->submit('Align Sequences'),": ",
	        $cgi->textfield(-name => "seqids", -size => 100),
                $cgi->end_form
	 );
}


#==============================================================================
#  Indexed objects (text search)
#==============================================================================

sub show_indexed_objects {
    my($fig, $cgi, $html, $pattern) = @_;
    my($msg, $i);

    if ($pattern =~ /^\s*(fig\|\d+\.\d+\.peg\.\d+)\s*$/)
    {
	my $peg = $1;
	my $user = $cgi->param('user');
	$user = $user ? $user : "";
	$ENV{'REQUEST_METHOD'} = "GET";
	$ENV{"QUERY_STRING"} = "prot=$peg\&user=$user";
	$ENV{"REQUEST_URI"} =~ s/index.cgi/protein.cgi/;
	my @prot_out = `./protein.cgi`;
	print @prot_out;
	exit;
    }

    push( @$html, $cgi->br );
    my( $peg_index_data, $role_index_data ) = $fig->search_index($pattern);
    my $maxpeg  = defined( $cgi->param("maxpeg")  ) ? $cgi->param("maxpeg")  : 100;
    my $maxrole = defined( $cgi->param("maxrole") ) ? $cgi->param("maxrole") : 100;
    my $check_all = $cgi->param('Select all') || 0;

    if ($maxpeg > 0)
    {
	push( @$html, $cgi->start_form(-action => "index.cgi"),
	              $cgi->hidden(-name => 'user',    -value => $user),
	              $cgi->hidden(-name => 'pattern', -value => $pattern),
	              $cgi->hidden(-name => 'maxpeg',  -value => $maxpeg),
	              $cgi->hidden(-name => 'maxrole', -value => $maxrole),
	              $cgi->hidden(-name => 'Search',  -value => 'Search'),
	              $cgi->submit( $check_all ? 'Deselect all' : 'Select all'),
                      $cgi->end_form
            );

	push( @$html, $cgi->start_form( -method => 'post',
	                                -target => "window$$",
	                                -action => 'fid_checked.cgi'
	                              ),
	              $cgi->hidden(-name => 'user', -value => $user),
	              "For Selected (checked) sequences: ",
	              $cgi->submit('get sequences'),
	              $cgi->submit('view annotations'),
	              $cgi->submit('assign/annotate'),
	              $cgi->br, $cgi->br
	    );

	my $n = @$peg_index_data;
	if ($n > $maxpeg)
	{
	    $msg = "Showing First $maxpeg Out of $n PEGs";
	    $#{$peg_index_data} = $maxpeg-1;
	}
	else
	{
	    $msg = "Showing $n PEGs";
	}

	my $col_hdrs = ["Sel","PEG","Organism","Aliases","Function","Who"];
	my $tab = [ map { &format_peg_entry($fig,$cgi,$_,$check_all) } @$peg_index_data ];
	push( @$html, &HTML::make_table($col_hdrs,$tab,$msg),
	              $cgi->br,
	              "For SELECTed (checked) sequences: ",
	              $cgi->submit('get sequences'),
	              $cgi->submit('view annotations'),
	              $cgi->br,
	              $cgi->end_form
	    );
    }

    if ($maxrole > 0)
    {
	my $n = @$role_index_data;
	if ($n > $maxrole)
	{
	    $msg = "Showing First $maxrole Out of $n Roles";
	    $#{$role_index_data} = $maxrole - 1;
	}
	else
	{
	    $msg = "Showing $n Roles";
	}

	if ( $maxpeg > 0 ) { push( @$html, $cgi->hr ) }
	my $col_hdrs = ["Role"];
	my $tab = [ map { &format_role_entry($fig,$cgi,$_) } @$role_index_data ];
	push( @$html, &HTML::make_table($col_hdrs,$tab,$msg) );
    }
}

sub format_peg_entry {
    my( $fig, $cgi, $entry, $checked) = @_;
    my($i,$function,$who);

    my($peg,$gs,$aliases,@funcs) = @$entry;

    $gs =~ s/\s+\d+$//;   # Org name comes with taxon_id appended (why?) -- GJO

    @funcs = map { $_ =~ s/^function:\s*//; $_ } @funcs;

    if ($aliases)
    {
	$aliases =~ s/^aliases://;
    }
    else
    {
	$aliases = "";
    }

    my $user = $cgi->param('user');
    $user = $user ? $user : "";

    if ($user)
    {
	for ($i=0; ($i < @funcs) && ($funcs[$i] !~ /\#$user/); $i++) {}
	if ($i < @funcs)
	{
	    ($function,$who) = split(/\#/,$funcs[$i]);
	}
    }

    if (! $function)
    {
	for ($i=0; ($i < @funcs) && ($funcs[$i] !~ /\#master/); $i++) {}
	if ($i < @funcs)
	{
	    ($function,$who) = split(/\#/,$funcs[$i]);
	}
    }

    if ((! $function) && (@funcs > 0))
    {
	($function,$who) = split(/\#/,$funcs[0]);
    }
    my $box = "<input type=checkbox name=checked value=\"$peg\""
            . ($checked ? " checked=1" : "")
            . ">";
    return [ $box, &HTML::fid_link($cgi,$peg), $gs, $aliases, $function, $who ];
}

sub format_role_entry {
    my($fig,$cgi,$entry) = @_;

    return [&HTML::role_link($cgi,$entry)];
}

sub run_prot_scan_for_matches {
    my($fig,$cgi,$html,$org,$pat) = @_;
    my($string,$peg,$beg,$end,$user,$col_hdrs,$tab,$i);

    my $tmp_pat = "$FIG_Config::temp/tmp$$.pat";
    open(PAT,">$tmp_pat")
	|| die "could not open $tmp_pat";
    $pat =~ s/[\s\012\015]+/ /g;
    print PAT "$pat\n";
    close(PAT);
    my @out = `$FIG_Config::ext_bin/scan_for_matches -p $tmp_pat < $FIG_Config::organisms/$org/Features/peg/fasta`;
    if (@out < 1)
    {
	push(@$html,$cgi->h1("Sorry, no hits"));
    }
    else
    {
	if (@out > 2000)
	{
	    push(@$html,$cgi->h1("truncating to the first 1000 hits"));
	    $#out = 1999;
	}

	push(@$html,$cgi->pre);
	$user = $cgi->param('user');
	$col_hdrs = ["peg","begin","end","string","function of peg"];
	for ($i=0; ($i < @out); $i += 2)
	{
	    if ($out[$i] =~ /^>([^:]+):\[(\d+),(\d+)\]/)
	    {
		$peg = $1;
		$beg = $2;
		$end = $3;
		$string = $out[$i+1];
		chomp $string;
		push( @$tab, [ &HTML::fid_link($cgi,$peg,1),
		               $beg,
		               $end,
		               $string,
		               scalar $fig->function_of( $peg, $user )
		             ]
		    );
	    }
	}
	push(@$html,&HTML::make_table($col_hdrs,$tab,"Matches"));
	push(@$html,$cgi->end_pre);
    }
    unlink($tmp_pat);
}

#==============================================================================
#  Scan for matches
#==============================================================================

sub run_dna_scan_for_matches {
    my($fig,$cgi,$html,$org,$pat) = @_;
    my($string,$contig,$beg,$end,$col_hdrs,$tab,$i);

    my $tmp_pat = "$FIG_Config::temp/tmp$$.pat";
    open(PAT,">$tmp_pat")
	|| die "could not open $tmp_pat";
    $pat =~ s/[\s\012\015]+/ /g;
    print PAT "$pat\n";
    close(PAT);
    my @out = `cat $FIG_Config::organisms/$org/contigs | $FIG_Config::ext_bin/scan_for_matches -c $tmp_pat`;
    if (@out < 1)
    {
	push(@$html,$cgi->h1("Sorry, no hits"));
    }
    else
    {
	if (@out > 2000)
	{
	    push(@$html,$cgi->h1("truncating to the first 1000 hits"));
	    $#out = 1999;
	}

	push(@$html,$cgi->pre);
	$col_hdrs = ["contig","begin","end","string"];
	for ($i=0; ($i < @out); $i += 2)
	{
	    if ($out[$i] =~ /^>([^:]+):\[(\d+),(\d+)\]/)
	    {
		$contig = $1;
		$beg = $2;
		$end = $3;
		$string = $out[$i+1];
		chomp $string;
		push(@$tab,[$contig,$beg,$end,$string]);
	    }
	}
	push(@$html,&HTML::make_table($col_hdrs,$tab,"Matches"));
	push(@$html,$cgi->end_pre);
    }
    unlink($tmp_pat);
}

#==============================================================================
#  BLAST search
#==============================================================================

sub run_blast {
    my( $fig, $cgi, $html, $org, $tool, $seq ) = @_;
    my( $query, @out );

    my $tmp_seq = "$FIG_Config::temp/run_blast_tmp$$.seq";

    #--------------------------------------------------------------------------
    #  Is the request for an id?  Get the sequence
    #--------------------------------------------------------------------------
    if ($seq =~ /^\s*([a-zA-Z]{2,4}\|\S+)/)
    {
	# Replaced $id with $query so that output inherits label -- GJO
	$query = $1;
	$seq = "";
	if (($tool eq "blastp") || ($tool eq "tblastn"))
	{
	    $seq = $fig->get_translation($query);
	}
	elsif ($query =~ /^fig/)
	{
	    my @locs;
	    if ((@locs = $fig->feature_location($query)) && (@locs > 0))
	    {
		$seq = $fig->dna_seq($fig->genome_of($query),@locs);
	    }
	}
	if (! $seq)
	{
	    push(@$html,$cgi->h1("Sorry, could not get sequence for $query"));
	    return;
	}
    }

    #--------------------------------------------------------------------------
    #  Is it a fasta format?  Get the query name
    #--------------------------------------------------------------------------

    elsif ( $seq =~ s/^>\s*(\S+[^\n\012\015]*)// )  #  more flexible match -- GJO
    {
	$query = $1;
    }

    #--------------------------------------------------------------------------
    #  Take it as plain text
    #--------------------------------------------------------------------------

    else
    {
	$query = "query";
    }

    #
    #  The rest is taken as the sequence
    #

    $seq =~ s/\s+//g;
    open( SEQ, ">$tmp_seq" ) || die "run_blast could not open $tmp_seq";
    print SEQ ">$query\n$seq\n";
    close( SEQ );

    if (! $ENV{"BLASTMAT"}) { $ENV{"BLASTMAT"} = "$FIG_Config::blastmat" }
    my $blast_opt = $cgi->param( 'blast_options' );
    my $blastall = "$FIG_Config::ext_bin/blastall";

    if ( $tool eq "blastp" )
    {
	my $db = "$FIG_Config::organisms/$org/Features/peg/fasta";
	&verify_db( $db, "p" );
	@out = map { &HTML::set_prot_links($cgi,$_) } `$blastall -i $tmp_seq -d $db -p blastp $blast_opt`;
    }

    elsif ( $tool eq "blastx" )
    {
	my $db = "$FIG_Config::organisms/$org/Features/peg/fasta";
	&verify_db( $db, "p" );
	@out = map { &HTML::set_prot_links($cgi,$_) } `$blastall -i $tmp_seq -d $db -p blastx $blast_opt`;
    }

    elsif ( $tool eq "blastn" )
    {
	my $db = "$FIG_Config::organisms/$org/contigs";
	&verify_db( $db, "n" );                               ### fix to get all contigs
	@out = `$blastall -i $tmp_seq -d $db -p blastn -r 1 -q -1 $blast_opt`;
    }

    elsif ( $tool eq "tblastn" )
    {
	my $db = "$FIG_Config::organisms/$org/contigs";
	&verify_db( $db, "n" );                               ### fix to get all contigs
	@out = `$blastall -i $tmp_seq -d $db -p tblastn $blast_opt`;
    }

    elsif ( $tool eq 'blastp against complete genomes' )     ### this tool gets nonstandard treatment: RAO
    {
	&blast_complete($fig,$cgi,$html,$tmp_seq,$blastall);
	unlink($tmp_seq);
	return;
    }

    if (@out < 1)          #  This is really a bigger problem than no hits (GJO)
    {
	push(@$html,$cgi->h1("Sorry, no hits"));
    }
    else
    {
	push(@$html,$cgi->pre);
	push(@$html,@out);
	push(@$html,$cgi->end_pre);
    }
    unlink( $tmp_seq );
}


sub blast_complete {
    my($fig,$cgi,$html,$seq_file,$blastall) = @_;
    my($genome,@sims);
    
    @sims = ();
    foreach $genome ($fig->genomes("complete"))
    {
	my $db = "$FIG_Config::organisms/$genome/Features/peg/fasta";
	next if (! -s $db);

	&verify_db($db,"p");
	my $sim;
	push(@sims,map { chop; 
			$sim = [split(/\t/,$_)]; 
			$sim->[10] = ($sim->[10] =~ /^e-/) ? "1.0" . $sim->[10] : $sim->[10]; 
		        $sim } 
	          `$blastall -i $seq_file -d $db -m 8 -FF -e 1.0e-5 -p blastp`);
    }
    @sims = sort { $a->[10] <=> $b->[10] } @sims;
    &format_sims($fig,$cgi,$html,\@sims);
}

sub format_sims {
    my($fig,$cgi,$html,$sims) = @_;
    my($col_hdrs,$table,@ids,$ids,$sim,%seen);

    $col_hdrs = [ "Select up to here",
		  "Similar sequence",
		  "E-val",
		  "Function",
		  "Organism",
	          "Aliases"
		];

    $table = [];
    @ids = ();
    if (@$sims > 1000) { $#{$sims} = 999 }
    foreach $sim (@$sims)
    {
	if (! $seen{$sim->[1]})
	{
	    push(@$table,[$cgi->checkbox(-name => 'list_to', -value => $sim->[1], -override => 1, -checked => 0, -label => ""),
			  &HTML::fid_link($cgi,$sim->[1]),
			  $sim->[10],
			  scalar $fig->function_of($sim->[1]),
                          $fig->genus_species(&FIG::genome_of($sim->[1])),
			  scalar $fig->feature_aliases($sim->[1])
			  ]);
	    push(@ids,$sim->[1]);
	}
    }
    $ids = join(",",@ids);
    my $target = "window$$";
    push(@$html, $cgi->start_form( -method => 'post',
				    -target => $target,
				    -action => 'index.cgi'
	                          ),
	         $cgi->hidden(-name => 'ids', -value => $ids),
	         &HTML::make_table($col_hdrs,$table,"Best Hits"),
	         $cgi->submit('Extract Matched Sequences'),
	 $cgi->end_form);
}

sub verify_db {
    my($db,$type) = @_;

    if ($type =~ /^p/i)
    {
	if ((! -s "$db.psq") || (-M "$db.psq" > -M $db))
	{
	    system "$FIG_Config::ext_bin/formatdb -p T -i $db";
	}
    }
    else
    {
	if ((! -s "$db.nsq") || (-M "$db.nsq" > -M $db))
	{
	    system "$FIG_Config::ext_bin/formatdb -p F -i $db";
	}
    }
}	

sub export_assignments {
    my($fig,$cgi,$html,$who) = @_;
    my($genome,$x);

    my @genomes = map { $_ =~ /\((\d+\.\d+)\)/; $1 } $cgi->param('korgs');

    if (@genomes == 0)
    {
	@genomes = $fig->genomes;
    }
    
    my @assignments = $fig->assignments_made(\@genomes,$who,$cgi->param('after_date'));
    if (@assignments == 0)
    {
	push(@$html,$cgi->h1("Sorry, no assignments where made by $who"));
    }
    else
    {
	my $col_hdrs = ["FIG id", "External ID", "Genus/Species","Assignment"];
	my $tab = [];
	my($x,$peg,$func);
	foreach $x (@assignments)
	{
	    ($peg,$func) = @$x;
	    push(@$tab,[$peg,&ext_id($fig,$peg),$fig->genus_species($fig->genome_of($peg)),$func]);
	}
	
	if ($cgi->param('save_assignments'))
	{
	    my $user = $cgi->param('save_user');
	    if ($user)
	    {
		&FIG::verify_dir("$FIG_Config::data/Assignments/$user");
		my $file = &FIG::epoch_to_readable(time) . ":$who:exported_from_local_SEED";
		if (open(TMP,">$FIG_Config::data/Assignments/$user/$file"))
		{
		    print TMP join("",map { join("\t",@$_) . "\n" } map { [$_->[0],$_->[3]] } @$tab);
		    close(TMP);
		}
		push(@$html,$cgi->h1("Saved Assignment Set $file"));
	    }
	    else
	    {
		push(@$html,$cgi->h1("You need to specify a user to save an assignment set"));
	    }
	}

	if ($cgi->param('tabs'))
	{
	    print $cgi->header;
	    print "<pre>\n";
	    print join("",map { join("\t",@$_) . "\n" } @$tab);
	    print "</pre>\n";
	    exit;
	}
	else
	{
	    push(@$html,&HTML::make_table($col_hdrs,$tab,"Assignments Made by $who"));
	}
    }
}

sub ext_id {
    my($fig,$peg) = @_;

    my @mapped = grep { $_ !~ /^fig/ } map { $_->[0] } $fig->mapped_prot_ids($peg);
    if (@mapped == 0)
    {
	return $peg;
    }

    my @tmp = ();
    if ((@tmp = grep { $_ =~ /^sp/ }   @mapped) && (@tmp > 0))  { return $tmp[0] }
    if ((@tmp = grep { $_ =~ /^pir/ }  @mapped) && (@tmp > 0))  { return $tmp[0] }
    if ((@tmp = grep { $_ =~ /^gi/ }   @mapped) && (@tmp > 0))  { return $tmp[0] }
    if ((@tmp = grep { $_ =~ /^tr/ }   @mapped) && (@tmp > 0))  { return $tmp[0] }
    if ((@tmp = grep { $_ =~ /^tn/ }   @mapped) && (@tmp > 0))  { return $tmp[0] }
    if ((@tmp = grep { $_ =~ /^kegg/ } @mapped) && (@tmp > 0))  { return $tmp[0] }
    
    return $peg;
}

sub translate_assignments {
    my($fig,$cgi,$html,$from_func,$to_func) = @_;

    my $user = $cgi->param('save_user');
    if ($user)
    {
	&FIG::verify_dir("$FIG_Config::data/Assignments/$user");
	my $file = &FIG::epoch_to_readable(time) . ":$user:translation";
	if (open(TMP,">$FIG_Config::data/Assignments/$user/$file"))
	{
	    my($peg,$from_funcQ,$to_funcQ,$func,$to);
	    $from_funcQ = quotemeta $from_func;

	    foreach $peg ($fig->seqs_with_role($from_func))
	    {
		if ($peg =~ /^fig\|/)
		{
		    $func = $fig->function_of($peg);
		    $to   = $func;
		    if ($to   =~ s/$from_funcQ/$to_func/)
		    {
			print TMP "$peg\t$to\n";
		    }
		}
	    }
	    close(TMP);
	}
	push(@$html,$cgi->h1("Saved Assignment Set $file"));
    }
    else
    {
	push(@$html,$cgi->h1("You need to specify a user to save an assignment set"));
    }
}

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3