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

View of /FigWebServices/fig_scripts_service.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.3 - (download) (annotate)
Tue Oct 23 15:48:08 2007 UTC (12 years, 5 months ago) by disz
Branch: MAIN
Changes since 1.2: +344 -81 lines
added rast submit and check

use strict;
use Carp;
use SOAP::Lite;
use IPC::Open3;
use FIGO;
use SOAP::Transport::HTTP;
use DBMaster;
use Job48;
use Data::Dumper;

SOAP::Transport::HTTP::CGI   
-> dispatch_to('Scripts')     
-> handle;

package Scripts;
use FIG;
use FIG_Config;
use Data::Dumper;
use FigFams;
use FigFam;
use IPC::Open3;

=begin WSDL
_IN auth $string
_IN args $string
_RETURN $string jobid
_DOC Input is a hash with lots of parms and a fasta file, output is a job id | error
=cut
sub load_fasta_to_rast {
	my ($class, %args) = @_;
	open FILE,  ">/tmp/foo";
	print FILE $args{file};
	#print STDERR &Dumper(\%args);
	#print STDERR "PWD ", $args{password}, "\n";
	#print STDERR "Dumped\n";


	# We have to authenticate this user first. Check with Daniel how to do that
	my $organism = {name => $args{genome_name},
			tax_id => $args{tax_id},
			lineage => $args{lineage},
			genetic_code => $args{genetic_code}
			};

	#print STDERR &Dumper($organism);
	my $msg;
	my $user = $args{user};
	my $seed_id;
	my $project_id = "Test Project";
	my $filename = "/tmp/foo";

	 my $data = prepare_data_for_create_job( $msg , $seed_id, $organism, $project_id, $filename, $user);
	print STDERR &Dumper($data), "Data\n";
	my ($job_number,$err) = Job48->create_new_job($data);

	print STDERR "job, err = $job_number, $err\n";
	return(join ":", $err, $job_number); 

}

sub prepare_data_for_create_job{
  my ( $msg , $seed_id, $organism, $project_desc, $filename, $user) = @_;

  my $meta = { "upload.timestamp" => time,
	       "status.uploaded" => "complete",
	       "keep_genecalls" => "0",
	       "correction.automatic" => "1" ,
#	       "submit.candidate" =>  $msg,
#	       "replace.seedID" => $seed_id, 
	     };
  
  	print STDERR &Dumper($meta), "meta\n";
  open(SEQFILE , "$filename") or die "Can't open file $filename!\n";
  my $data = { taxonomy_id => $organism->{tax_id},
	       metagenome => 0,
	       genome => $organism->{name},
	       user => $user,
	       project => $project_desc,
	       taxonomy => $organism->{lineage},
	       genetic_code => $organism->{genetic_code},
	       sequence_file => \*SEQFILE,
	       meta => $meta
	     };

# print STDERR "made data \n"; 
  
#  	print STDERR &Dumper($data), "data\n";
  
  
  return $data;
}


=begin WSDL
_IN in $string
_IN in $string
_RETURN $string status
_DOC Input is a RAST job id,  output is a status
=cut
sub check_rast_job {
	my ($class, $job_id, $login_name)  = @_;

	#print STDERR "Check $job_id, $login_name";
	$ENV{DBHOST} = 'bioseed.mcs.anl.gov';
	my $dbm = DBMaster->new('FortyEight_WebApplication');
	my $users = $dbm->User->get_objects({ login => $login_name });
	my $user;
	if ($users && @$users) {
		$user = $users->[0];
		my ($stage, $status) = Job48->get_status_of_job($job_id, $user);
		print STDERR "stage $stage, status $status\n";
		return(join ":", $stage, $status); 
	} else {
	#	print STDERR "no users\n";
		return("No users");
	}
}


=begin WSDL
_IN in $string
_RETURN $string
_DOC Input is a RAST jobid file, output is a big file
=cut
sub get_rast_results {
	my ($class, $jobid) = @_;
	return ("this should be a big file");
}

=begin WSDL
_IN in $string
_RETURN $string
_DOC Input is an alias, output is a sequence
=cut
sub ali_to_seq {
	my ($class, $arg) = @_;
	return stdin_caller($class, "ali_to_seq", $arg);
}

=begin WSDL
_IN in $string
_RETURN $string
_DOC Input is an alias, output is peg \t peg
=cut
sub adjacent {
	my ($class, $arg) = @_;
	return stdin_caller($class, "adjacent", $arg);
}

=begin WSDL
_IN in $string
_RETURN $string
_DOC Input is a peg, output is two column table of peg\tcluster
=cut
sub cluster_by_bbhs {
	my ($class, $arg) = @_;
	return stdin_caller($class, "cluster_by_bbhs", $arg);
}

=begin WSDL
_IN in $string
_RETURN $string
_DOC Input is a peg, output is two column table of peg\cluster
=cut
sub cluster_by_sim {
	my ($class, $arg) = @_;
	return stdin_caller($class, "cluster_by_sim", $arg);
}

=begin WSDL
_IN in $string
_RETURN $string
_DOC Input is a peg, output is two column table of peg\text func
=cut
sub external_calls {
	my ($class, $arg) = @_;
	return stdin_caller($class, "external_calls", $arg);
}

=begin WSDL
_IN in $string
_RETURN $string
_DOC Input is a peg, output is a function
=cut
sub function_of {
	my ($class, $arg) = @_;
	return stdin_caller($class, "function_of", $arg);
}

=begin WSDL
_IN in $string
_RETURN $string
_DOC Input is a peg, output is a single column table of genomes
=cut
sub genomes_of {
	my ($class, $arg) = @_;
	return stdin_caller($class, "genomes_of", $arg);
}

=begin WSDL
_IN in $string
_RETURN $string
_DOC Input is a single column table of pegs, output is a single column table of fasta.DNA
=cut
sub fid2dna {
	my ($class, $arg) = @_;
	return stdin_caller($class, "fid2dna", $arg);
}

=begin WSDL
_IN in $string
_RETURN $string
_DOC Input is a single column table of pegs, output is a single column table of archaeal pegs
=cut
sub is_archaeal {
	my ($class, $arg) = @_;
	return stdin_caller($class, "is_archaeal", $arg);
}

=begin WSDL
_IN in $string
_RETURN $string
_DOC Input is a single column table of pegs, output is a single column table of bacterial pegs
=cut
sub is_bacterial {
	my ($class, $arg) = @_;
	return stdin_caller($class, "is_bacterial", $arg);
}

=begin WSDL
_IN in $string
_RETURN $string
_DOC Input is a single column table of pegs, output is a single column table of eukaryotic pegs
=cut
sub is_eukaryotic {
	my ($class, $arg) = @_;
	return stdin_caller($class, "is_eukaryotic", $arg);
}

=begin WSDL
_IN in $string
_RETURN $string
_DOC Input is a single column table of pegs, output is a single column table of prokaryotic pegs
=cut
sub is_prokaryotic {
	my ($class, $arg) = @_;
	return stdin_caller($class, "is_prokaryotic", $arg);
}

=begin WSDL
_IN in $string
_RETURN $string
_DOC Input is a peg, output is peg-Translation
=cut
sub translation_of {
	my ($class, $arg) = @_;
	return stdin_caller($class, "translation_of", $arg);
}

=begin WSDL
_IN in $string
_RETURN $string
_DOC Input is a peg, output is tab separated string of aliases
=cut
sub aliases_of {
	my ($class, $arg) = @_;
	return stdin_caller($class, "aliases_of", $arg);
}

=begin WSDL
_IN in $string
_RETURN $string
_DOC Input is an alias, output is a peg
=cut
sub alias2fig {
	my ($class, $arg) = @_;
	return stdin_caller($class, "alias2fig", $arg);
}



=begin WSDL
_IN in $string ec code
_RETURN $string ec name
_DOC Input is aec code , output is ec name
=cut
sub ec_name {
	my $class = shift();
	my $fig = new FIG;
	my $result = $fig->ec_name(@_);
	return $result;
}

=begin WSDL
_IN in $string
_RETURN @string
_DOC Input is a peg, output is list of 4 tuples
=cut
sub abstract_coupled_to {
	my $class = shift();
	my $fig = new FIG;
	my @result = $fig->abstract_coupled_to(@_);
	return @result;
}

=begin WSDL
_IN complete $string
_IN restrictions $string
_IN domain $string
_RETURN @string
_DOC Input is constraints, output is list of genomes
=cut
sub genomes {
	my $class = shift();
	my $fig = new FIG;
	my @result = $fig->genomes(@_);
	my @genomes;  
	 foreach my $genome (@result)       
	 { 
	         print STDERR "Genome is -$genome-\n";

		  my $genus_species = $fig->genus_species($genome);
	          push @genomes,  join("\t",$genome,$genus_species);
	         # print STDERR join("\t",$genome,$genus_species);
	 }

	#print STDERR @genomes;
	return @genomes;
	#return @result;
}

=begin WSDL
_IN in $string
_RETURN @string
_DOC Input is a peg, output is list of loc on contig
=cut
sub feature_location {
	my ($class, $arg1) = @_;
	my $fig = new FIG;
	my @result = ($fig->feature_location($arg1));
	return @result;
}

=begin WSDL
_IN in $string
_RETURN $string
_DOC Input is a peg, output is translation
=cut
sub get_translation {
	my ($class, $arg1) = @_;
	my $fig = new FIG;
	my $result = $fig->get_translation($arg1);
	return $result;
}

=begin WSDL
_IN pat1 $string
_IN pat2 $string
_RETURN @string
_DOC Input is two patterns, first one is used in search_index, second used to grep the results
=cut
sub search_and_grep {
	my ($class, $arg1, $arg2) = @_;

	my $fig = new FIG;

	my ($pegs, $roles) =  $fig->search_index($arg1);
	
	my (@result_list, $entry);

	for $entry (@$pegs) {
		push (@result_list, grep(/$arg2/, @$entry));
	}	
	push (@result_list, grep(/$arg2/, @$roles));
	chomp @result_list;
	my $return_value = join ("\n", @result_list); 
	return $return_value;
}

=begin WSDL
_RETURN $string list of families
_DOC No Input, output is list of all families
=cut
sub all_families {
	my ($class) = @_;
	my $fig = new FIG;
	my $figfams = new FigFams($fig);

        my @out = $figfams->all_families;
	print STDERR Dumper(@out);
	return @out;
}

=begin WSDL
_RETURN $string list of families and funcs
_DOC No Input, output is list of all families
=cut
sub all_families_with_funcs {
	my ($class) = @_;
	my $fig = new FIG;
	my $figfams = new FigFams($fig);

        my @out =$figfams->all_families_with_funcs;
	return @out;
}

=begin WSDL
_IN in $string list of famids
_RETURN $string 2 col table, famid, peg
_DOC Input is list of families, outoput is 2 col table of famid, peg
=cut
sub list_members {
	my ($class, $famids) = @_;
	my $fig = new FIG;
	my $figfams = new FigFams($fig);
	my @in = split(/\t/, $famids);
	warn("Starting 2 list members $famids\n");
    my @out = ();
    foreach my $famid (@in)
    {
	my $famO = new FigFam($fig,$famid);
	foreach my $peg ($famO->list_members)
	{
	    push(@out,[$famid,$peg]);
	}
    }
    return @out;
}

=begin WSDL
_IN in $string list of pegs
_RETURN $string returns a 3-column table [PEG,Function,AliasesCommaSeparated]
_DOC Input is list of families,returns a 3-column table [PEG,Function,AliasesCommaSeparated]
=cut
sub CDS_data {
	my ($class, $pegs) = @_;
	my $fig = new FIG;
	my $figfams = new FigFams($fig);
	my @in = split(/\t/, $pegs);

 #warn("Starting CDS data $pegs\n");
 #print STDERR &Dumper($pegs);

    my @out = ();
    foreach my $peg (@in)
    {
	my @famids = $figfams->families_containing_peg($peg);
	foreach my $famid (@famids)
	{
	    push(@out,[$peg,scalar $fig->function_of($peg),[$fig->feature_aliases($peg)]]);
	}
    }
    return @out;
}

=begin WSDL
_IN in $string list of pegs
_RETURN $string a 2-column table [PEG,Sequence]
_DOC Input is list of families,returns a 2-column table [PEG,Sequence] 
=cut
sub CDS_sequences {
	my ($class, $pegs) = @_;
	my $fig = new FIG;
	my $figfams = new FigFams($fig);
	my @in = split(/\t/, $pegs);

 #warn("Starting CDS seq $pegs\n");
 #print STDERR &Dumper($pegs);
    my @out = ();
    foreach my $peg (@in)
    {
	push(@out,[$peg,$fig->get_translation($peg)]);
    }
    return @out;
}

=begin WSDL
_IN in $string list of id seq pairs
_RETURN $string returns a 2-column table [Id,FamilyID]
_DOC Input is list of families,returns a 2-column table [Id,FamilyID]
=cut
sub is_member_of {
	my ($class, $id_seqs) = @_;
	my $fig = new FIG;
	my $figfams = new FigFams($fig);
	#warn("Doing is member $id_seqs\n");
 #print STDERR &Dumper($id_seqs);

	my @in = split(/\n/, $id_seqs);
    my @out = ();
    foreach my $pair (@in)
    {
	my($id,$seq) = split(/\t/, $pair);
	my($famO,undef) = $figfams->place_in_family($seq);
	if ($famO)
	{
	    push(@out,[$id,$famO->family_id]);
	}
    }
    return @out;
}


sub stdin_caller {
	my ($class, $name, $arg) = @_;
	my($rd, $wr, $err, $pid, $std_err, $return_value, @std_out);
	if (!($pid = open3($wr, $rd, $err, "$FIG_Config::bin/$name")))
	{
	die "Cannot run open3 $name: $!";
	}

	$wr->write($arg);
	close($wr);

	@std_out= <$rd>;
	close($rd);
	waitpid $pid, 0;
	$return_value = join ("", @std_out); 
	return $return_value;
}

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3