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

View of /FigWebServices/ss_export.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.8 - (download) (annotate)
Mon Dec 5 19:12:12 2005 UTC (13 years, 11 months ago) by olson
Branch: MAIN
CVS Tags: mgrast_dev_08112011, rast_rel_2009_05_18, mgrast_dev_08022011, rast_rel_2014_0912, rast_rel_2008_06_18, myrast_rel40, rast_rel_2008_06_16, mgrast_dev_05262011, rast_rel_2008_12_18, mgrast_dev_04082011, rast_rel_2008_07_21, rast_rel_2010_0928, rast_2008_0924, mgrast_version_3_2, mgrast_dev_12152011, rast_rel_2008_04_23, mgrast_dev_06072011, rast_rel_2008_09_30, rast_rel_2009_0925, rast_rel_2010_0526, rast_rel_2014_0729, mgrast_dev_02212011, rast_rel_2010_1206, caBIG-05Apr06-00, mgrast_release_3_0, mgrast_dev_03252011, rast_rel_2010_0118, mgrast_rel_2008_0924, mgrast_rel_2008_1110_v2, rast_rel_2009_02_05, rast_rel_2011_0119, mgrast_rel_2008_0625, mgrast_release_3_0_4, mgrast_release_3_0_2, mgrast_release_3_0_3, mgrast_release_3_0_1, mgrast_dev_03312011, mgrast_release_3_1_2, mgrast_release_3_1_1, mgrast_release_3_1_0, mgrast_dev_04132011, rast_rel_2008_10_09, mgrast_dev_04012011, rast_release_2008_09_29, mgrast_rel_2008_0806, mgrast_rel_2008_0923, mgrast_rel_2008_0919, rast_rel_2009_07_09, rast_rel_2010_0827, mgrast_rel_2008_1110, myrast_33, rast_rel_2011_0928, rast_rel_2008_09_29, mgrast_rel_2008_0917, rast_rel_2008_10_29, mgrast_dev_04052011, mgrast_dev_02222011, caBIG-13Feb06-00, rast_rel_2009_03_26, mgrast_dev_10262011, rast_rel_2008_11_24, rast_rel_2008_08_07, HEAD
Changes since 1.7: +17 -0 lines
add license words

#
# Copyright (c) 2003-2006 University of Chicago and Fellowship
# for Interpretations of Genomes. All Rights Reserved.
#
# This file is part of the SEED Toolkit.
# 
# The SEED Toolkit is free software. You can redistribute
# it and/or modify it under the terms of the SEED Toolkit
# Public License. 
#
# You should have received a copy of the SEED Toolkit Public License
# along with this program; if not write to the University of Chicago
# at info@ci.uchicago.edu or the Fellowship for Interpretation of
# Genomes at veronika@thefig.info or download a copy from
# http://www.theseed.org/LICENSE.TXT.
#

use FIG;
use CGI;
use HTML;

use List::Util;
use File::Spec;
use strict;

my $cgi = new CGI;
my $fig = new FIG();

my $user = $cgi->param("user");
my $subsystem = $cgi->param("ssa_name");

my $html = [];

#
# Decide what to do.
#
# If button_export is set, we're doing an export.
#
# Otherwise we're just updating the page.
#

if ($cgi->param("export_button"))
{
    my $sub = $fig->get_subsystem($subsystem);
    
    my(@roles, @genomes);

    for my $p ($cgi->param)
    {

	if ($p =~ /export_genome_(\d+)/)
	{
	    push(@genomes, $1);
	}
	elsif ($p =~ /export_role_(\d+)/)
	{
	    push(@roles, $1);
	}
    }


    #
    # We will export a file for each genome (for each selected subsystem),
    # for each subsystem (for each selected genome),
    # and for all selected sequences.
    #

    my $tmp = File::Spec->catfile($FIG_Config::temp, "export_$$");
    &FIG::verify_dir($tmp);

    chdir($tmp);

    #
    # Write a README with the mapping from genome and role index to name.
    #

    open(my $rfh, ">README");

    print $rfh "Roles\n";
    for my $role (@roles)
    {
	my $name = $sub->get_role($role);
	my $abbr = $sub->get_role_abbr($role);

	print $rfh "$role\t$abbr\t$name\n";
    }

    print $rfh "\n";

    print $rfh "Genomes\n";

    for my $g (@genomes)
    {
	my $gname = $sub->get_genome($g);
	my $gs = $fig->genus_species($gname);

	print $rfh "$g\t$gname\t$gs\n";
    }
    close($rfh);
    
    #
    # Write the role exports.
    #

    for my $role (@roles)
    {
	my $file = "role_$role.dna.fasta";
	my $protfile = "role_$role.prot.fasta";
	open(my $fh, ">$file");
	open(my $protfh, ">$protfile");
	for my $g (@genomes)
	{
	    my $gname = $sub->get_genome($g);
	    my $entry = $sub->get_cell($g, $role);
	    if ($entry)
	    {
		for my $peg (@$entry)
		{
		    my $pegname = $peg;
		    $pegname =~ s/^fig\|//;
		    $pegname =~ s/\.peg\././;

		    my @location = $fig->feature_location($peg);
		    if (@location > 0)
		    {
			my $seq = $fig->dna_seq($gname, @location);
			if ($seq ne "")
			{
			    &FIG::display_id_and_seq($pegname, \$seq, $fh);
			}
		    }
		    my $seq = $fig->get_translation($peg);
		    if ($seq ne "")
		    {
			&FIG::display_id_and_seq($pegname, \$seq, $protfh);
		    }
		}
	    }
	}
	close($fh);
	close($protfh);
    }

    #
    # Write the genome exports, and while we're at it, write the
    # all-sequences file.
    #

    open(my $all_fh, ">all.dna.fasta");
    open(my $allprot_fh, ">all.prot.fasta");
    my $catfile = "all.prot.cat.fasta";
    open(my $catfh, ">$catfile");

    for my $g (@genomes)
    {
	my $gname = $sub->get_genome($g);
	my $file = "genome_$g.dna.fasta";
	my $protfile = "genome_$g.prot.fasta";

	open(my $fh, ">$file");
	open(my $protfh, ">$protfile");
	print $catfh ">$gname/" . $fig->genus_species($gname) . "\n";
	for my $role (@roles)
	{
	    my $entry = $sub->get_cell($g, $role);
	    if ($entry)
	    {
		for my $peg (@$entry)
		{
		    my $pegname = $peg;
		    $pegname =~ s/^fig\|//;
		    $pegname =~ s/\.peg\././;
		    my @location = $fig->feature_location($peg);
		    if (@location > 0)
		    {
			my $seq = $fig->dna_seq($gname, @location);
			if ($seq ne "")
			{
			    &FIG::display_id_and_seq($pegname, \$seq, $fh);
			    &FIG::display_id_and_seq($pegname, \$seq, $all_fh);
			}
		    }
		    my $seq = $fig->get_translation($peg);
		    if ($seq ne "")
		    {
			&FIG::display_id_and_seq($pegname, \$seq, $protfh);
			&FIG::display_id_and_seq($pegname, \$seq, $allprot_fh);
			&FIG::display_seq(\$seq, $catfh);
		    }
		}
	    }
	}
	close($fh);
	close($protfh);
    }
    close($catfh);
    close($all_fh);
    close($allprot_fh);

    my $outname = "$subsystem.$$.tar.gz";
    $outname =~ s/[^\w.-]/_/g;

    system("tar czf ../$outname .");
    my $size = (stat("../$outname"))[7];

    print "Content-Type: application/octet-stream\n";
    print "Content-Length: $size\n";
    print "Content-Disposition:attachment;filename=$outname\n";
    print "\n";

    my $buf;
    open(my $myout, "<../$outname");
    while (read($myout, $buf, 4096))
    {	
	print $buf;
    }
    close($myout);

    chdir("..");
    system("rm -r $tmp $outname");

    exit;
}

push(@$html, $cgi->start_form(-action => "ss_export.cgi",
			      -method => "post"),
     $cgi->hidden(-name => 'user', -value => $user, -override => 1),
     $cgi->hidden(-name => 'ssa_name', -value => $subsystem, -override => 1),
     $cgi->h2("Showing genomes for $subsystem\n"),
    );

#
# Show the selection list for limiting to family.
#

my $taxonomic_groups = $fig->taxonomic_groups_of_complete(10);

my @group_names = sort grep { $_ ne "All" } map { $_->[0] } @$taxonomic_groups;

unshift(@group_names, "All");

#
# Display in a scrolling list.
#

push(@$html,
     $cgi->h2("Limit genomes shown to group:"),
     $cgi->scrolling_list(-name => 'limit_genome',
			  -values => [@group_names],
			  -default => "All",
			  -size => 5,
			  -multiple => 1),
     );


#
# Determine if we're limiting genomes, and only use
# genomes from that group if we are.
#

my @limit_genome = $cgi->param("limit_genome");
my %desired_genomes;

if (grep({$_ eq "All"} @limit_genome))
{
    @limit_genome = ();
}

if (@limit_genome)
{
    for my $limit_genome (@limit_genome)
    {
	my @list = grep({ $_->[0] eq $limit_genome } @$taxonomic_groups);
	for my $litem (@list)
	{
	    grep({ $desired_genomes{$_}++ }  @{$litem->[1]});
	}
    }
}

#
# And submit.
#

push(@$html,
     $cgi->p,
     $cgi->submit(-label => "Update page",
		  -name => 'update_button'),
     $cgi->br,
     $cgi->submit(-label => "Export sequences",
		  -name => 'export_button'));

#
# Build the table.
#
# Each row is an organism.
# Each column is a role.
#

my $sub = $fig->get_subsystem($subsystem);

my @roles = $sub->get_roles();
my @genomes;

#
# Filter genome list based on @limit_genome list.
#

if (@limit_genome)
{
    for my $g ($sub->get_genomes())
    {
	push(@genomes, $g) if $desired_genomes{$g};
    }
}
else
{
    @genomes = $sub->get_genomes();

}

#
# Columns are:
#  1.   Genome id
#  2.   Organism name
#  3.   Export-genome checkbox
#  4-n. Pegs for role (c-3).
#
# Rows are:
#  1.   Headers
#  2.   Export-role checkbox
#  3-n. Pegs for genome (r-2). 
#

my @col_hdrs = ("Genome", "Organism", "Export", @roles);

my @export_roles = map { $cgi->checkbox(-name => "export_role_$_",
					-checked => 1,
					-value => 1,
					-label => "");
		     } 1..@roles;
unshift(@export_roles, "", "", "");

my @table;

push(@table, \@export_roles);

#
# Now run thru the genomes.
#

for my $g (@genomes)
{
    my $row = [];

    my $idx = $sub->get_genome_index($g);
    push(@$row, $g);
    push(@$row, $fig->genus_species($g));
    push(@$row, $cgi->checkbox(-name => "export_genome_$idx",
			      -checked => 1,
			      -value => 1,
			      -label => ""));
    for my $role (@roles)
    {
	#
	# Get the cell from the spreadsheet and put the pegs in here.
	#

	my @pegs = $sub->get_pegs_from_cell($idx, $role);
	@pegs = map {
	    my $num = (&FIG::genome_and_peg_of($_))[1];
	    "<a href=\"protein.cgi?prot=$_&user=$user\">$num</a>"
	} @pegs;
	push(@$row, join(" ", @pegs));
    }

    push(@table, $row);
	 
}


push(@$html, HTML::make_table(\@col_hdrs, \@table));

push(@$html, $cgi->end_form());


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


__END__
    
#
# Create the table using the sorted list of genome ids.
#

for my $k (@show_genomes)
{
    my $c = $all_genomes{$k};
	
    my $row = [];

    #
    # Display genome id and name.
    #
    push(@$row, $k);
    push(@$row, &ext_genus_species($fig, $k));

    #
    # For each subsystem, look up the variant code and put in the table.
    #
    for my $subname (@display_subs)
    {
	my $sub = $fig->get_subsystem($subname);
	my $vc = $sub->get_variant_code_for_genome($k);
	push(@$row, "\@align=\"center\":$vc");
    }
    push(@table, $row);
}


push(@$html, HTML::make_table(\@col_hdrs, \@table));

push(@$html, $cgi->end_form());

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

sub ext_genus_species {
    my($fig,$genome) = @_;

    my $gs = $fig->genus_species($genome);
    my $c  = substr($fig->taxonomy_of($genome),0,1);
    return "$gs [$c]";
}
	

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3