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

View of /FigWebServices/rest_rtmg.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (download) (annotate)
Fri Sep 23 14:55:16 2011 UTC (8 years, 5 months ago) by redwards
Branch: MAIN
CVS Tags: mgrast_release_3_1_2, rast_rel_2011_0928, mgrast_version_3_2, mgrast_dev_12152011, mgrast_dev_10262011
Changes since 1.1: +204 -1 lines
new version of rtmg

#__perl__

# NOTE THAT use strict will break this!!
use lib '/home/redwards/perl/lib/perl5/site_perl/5.8.7/i686-linux/';
use CGI;
use CGI::Carp qw/fatalsToBrowser/;
use JSON::XS;
use Data::Dumper;

use ANNOserver;
use SAPserver;
$|=1;

=pod 

=head1 rest_rtmg.cgi

YAWS - Yet another web service!

Why: We're using rpc encoding which is basically URL encoding. In this, I call something like 

http://bioseed.mcs.anl.gov/~redwards/FIG/rest_seed.cgi/multiply/2/3/4/5 

and get a response. Why do we need another web service? Mainly because of the Google work. Google pretty much exclusively deals with http requests, and eschews SOAP and other encodings as being too complex. 

The data returned is all in JSON format (http://www.json.org/) which is the Javascript object notation format. JSON is a really light weight markup language that cna handle complex objects quite easily. 

I am also aiming for lightweight code. In this case, we're not going to instantiate anything until we need it. Hopefully.

This code is almost exclusivvely used with the real time metagenomics site, so that is what I'm going to use it for.

=cut

# a really simple RESTful web service that returns seed data

my $cgi=new CGI qw/:standard/;
my $json= new JSON::XS;

print $cgi->header('text/plain');

# get the query with path so we get the RESTful information
my $abs = $cgi->url(-absolute=>1); # this will be the cgi-bin/rest.cgi stuff
my $rest = $cgi->url(-path_info=>1);
$rest =~ s/^.*$abs\///;
my @rest=split m#/#, $rest;

my $method = shift @rest;

# there is no good way of passing a null value!!
map {undef $rest[$_] if ($rest[$_] eq "undef" || $rest[$_] eq "null")} (0..$#rest);

my $result =  $json->encode({result => &{$method}(@rest) });

print $result, "\n";



=pod

=head1 multiply.

This is a really simple method that just multiplies two numbers! It's great for testing things out

=cut

sub multiply {
        
	my $x = 1;
        map {$x = $x * $_} @_;
        return $x;
}

=head1 annotate

This takes a dna sequence and returns the bare bones annotation. This is for first pass, kind of what's there look.

=cut

sub annotate {
	my %sequences = @_;
	my $sequences; 
	map {push @$sequences, [$_, "no comment", $sequences{$_}]} keys %sequences;

    	# Create a FIGfam server object.
    	my $ffServer = ANNOserver->new();
    	# Pass the input file to the FIGfam server to get assignments.
	my $reliability = 2;
	my $maxGap = 1000;
	my $kmer = 8;
	my $resultH = $ffServer->assign_functions_to_dna({-input=>$sequences, -minHits=>$reliability, -maxGap=>$maxGap, -kmer=>$kmer});

# Loop through the results. We send good results to the standard output,
# and failures to the standard error file.
	my $allresults;
	while (my $result = $resultH->get_next()) {push @$allresults, $result; print STDERR Dumper("ROB", $result)}
	return $allresults;

};



=head1 annotate_fasta_file

This takes a LOCAL fasta file and returns the bare bones annotation. This is for first pass, kind of what's there look. Italso takes an optional reliability. If not provided, defaults to 2.

=cut

sub annotate_fasta_file {
	my ($file, $reliability, $kmer, $maxGap) = @_;
	if (!defined $reliability) {$reliability = 2}
	if (!defined $maxGap) {$maxGap = 600}
	if (!defined $kmer) {$kmer = 8}
	use raelib;
	use FIG_Config;
	$file = $FIG_Config::temp . "/rtmg/" . $file;
	unless (-e $file) {return "$file not found";}
	##return ("using $file");
	my $fa=raelib->read_fasta($file);
	map {push @$sequences, [$_, "no comment", $fa->{$_}]} keys %$fa;

    	# Create a FIGfam server object.
    	my $ffServer = ANNOserver->new();
    	# Pass the input file to the FIGfam server to get assignments.
	my $maxGap = 1000;
	my $resultH = $ffServer->assign_functions_to_dna({-input=>$sequences, -minHits=>$reliability, -maxGap=>$maxGap, -kmer=>$kmer});

	my $allresults=[];
	open(OUT, ">$file.annotations") || die "can't write to annotations file";
	while (my $result = $resultH->get_next()) { 
		push @{$allresults}, $result; 
		my $seqid = $result->[0];
		foreach my $line (@{$result}[1..$#$result]) {
			print OUT $seqid;
			map {ref($_) eq "ARRAY" ? print OUT "\t", join("\t", @$_) : print OUT "\t$_"} @$line;
			print OUT "\n";
		}
	}
	close OUT;
	#unlink $file;
	return $allresults;
};


=head1 annotate_fasta_file_lite

This takes a LOCAL fasta file and returns the bare bones annotation. This is for first pass, kind of what's there look. Italso takes an optional reliability. If not provided, defaults to 2.

This only returns true that the file has been processed and does not return any data.

=cut

sub annotate_fasta_file_lite {
	my %params=@_;
	my $file = $params{'file'};
	my $reliability = $params{'reliability'};
	my $kmer = $params{'kmer'};
	my $maxGap = $params{'maxgap'};
	my $jobid = $params{'jobID'};
	my $kmerDataset = $params{'kmerDataset'};
	#my ($file, $reliability, $kmer, $maxGap, $jobid) = @_;
	if (!defined $reliability) {$reliability = 2}
	if (!defined $maxGap) {$maxGap = 600}
	if (!defined $kmer) {$kmer = 8}
	print STDERR "Lite: $jobid $file\n";
	use raelib;
	use FIG_Config;
	my $outputdir = $FIG_Config::temp . "/rtmg/" . $jobid;

	$file = $outputdir. "/" . $file;
	unless (-e $file) {return "$file not found";}
	##return ("using $file");
	my $fa=raelib->read_fasta($file);
	map {push @$sequences, [$_, "no comment", $fa->{$_}]} keys %$fa;

    	# Create a FIGfam server object.
    	my $ffServer = ANNOserver->new();
    	# Pass the input file to the FIGfam server to get assignments.
	my $maxGap = 1000;
	my @kmerDataset = $kmerDataset ? (-kmerDataset => $kmerDataset) : ();
	my $resultH = $ffServer->assign_functions_to_dna({
		-input=>$sequences,
		-minHits=>$reliability,
		@kmerDataset,
		-maxGap=>$maxGap,
		-kmer=>$kmer
	});

	# now add the data to the existing data
	my $htmldir = $FIG_Config::temp. "/rtmg/$jobid/web";
	unless (-e $htmldir) {mkdir $htmldir, 0755}



	my $seqfile = $htmldir . "/total.txt";
	open(SEQ, ">>$seqfile") || die "can't open sums file in append mode";
	flock(SEQ, 2); # collect an exclusive lock on the file so we can append to it.
	while (my $result = $resultH->get_next()) { 
		push @{$allresults}, $result; 
		my $seqid = $result->[0];
		foreach my $line (@{$result}[1..$#$result]) {
			print SEQ $seqid;
			map {ref($_) eq "ARRAY" ? print SEQ "\t", join("\t", @$_) : print SEQ "\t$_"} @$line;
			print SEQ "\n";
		}
	}
	close SEQ;
	return ({jobId=>$jobid});
}

=head1 update_table
	
	Rebuild the counts table

=cut

sub update_table {
	my ($jobid, $level)=@_;
	# read the current counts etc
	unless (defined $level) {$level = 3}

# Levels:
#	0=>"Function", 1=>"One level of subsystems", 2=>"Two levels of subsystems", 3=>"Three levels of subsystems"

	my $htmldir = $FIG_Config::temp. "/rtmg/$jobid/web";
	unless (-e $htmldir) {die "Should have found a directory at $htmldir"}

	my $subsystems;
	if (-e "$htmldir/data.pl") {
		open(DATA, "$htmldir/data.pl") || die "can't open $htmldir/data.pl";
		my $in = join("", <DATA>);
		close DATA;
		my $VAR1;
		eval {$in};
		$subsystems=$VAR1;
	}

	my $seqfile = $htmldir . "/total.txt";
	my %count;
	open(IN, $seqfile) || die "Can't open $seqfile";
	while (<IN>) {
		chomp;
		my @a=split  /\t/;
		$count{$a[4]}++;
	}
	close IN;

# now add the subsystems
	my $sshash;
	my %allss;
	if ($level > 0) {	
		my $sap = SAPserver->new();
		my @new = map {!defined {$subsystems->{'fn'}->{$_}}} keys %count;
		$sshash = $sap->subsystems_for_role({-ids=>[keys %count], -usable => 1, -exclude => ['cluster-based', 'experimental']});
		map {@{$subsystems->{'fn'}->{$_}} = @{$sshash->{$_}}} keys %$sshash;  
# now get all the classifications
		if ($level > 1) {
			my @missing;
			foreach my $ssarr (values %$sshash) {
				foreach my $ss (@$ssarr) {
					unless ($subsystems->{'classification'}->{$ss}) {
						push @missing, $ss;
					}
				}
			}

			my $class = $sap->classification_of({-ids=>\@missing});
			map {$subsystems->{'classification'}->{$_} = $class->{$_}} keys %$class;
		}
	}
	open(DATA, ">$htmldir/data.pl") || die "can't open $htmldir/data.pl";
	flock(DATA, 2);
	print DATA Dumper($subsystems);
	close DATA;

	my $class = $subsystems->{'classification'};

	my $tl; my $ol;
	foreach my $fn (keys %count) {
		foreach my $ss (@{$sshash->{$fn}}) {
			my $two = join("\t", @{$class->{$ss}});
			$tl->{$two} += $count{$fn};
			my $one = $class->{$ss}->[0];
			$ol->{$one} += $count{$fn};
		}
	}

	open(TXT, ">$htmldir/counts.txt") || die "can't open $htmldir/counts.txt";
	open(HTML, ">$htmldir/counts.html") || die "can't open $htmldir/counts.html";
	flock(TXT, 2);
	flock(HTML, 2);
	print HTML "<TABLE>\n";
	if ($level < 4) {
		foreach my $fn (keys %count) {
			if ($level == 0) {
				print TXT join("\t",  $fn, $count{$fn}), "\n";
				print HTML "<tr><td>", join("</td><td>", $fn, $count{$fn}), "</td></tr>\n";
			}
			else {
				foreach my $ss (@{$sshash->{$fn}}) {
					if ($level ==1 ) {
						print TXT join("\t", $ss, $fn, $count{$fn}), "\n";
						print HTML "<tr><td>", join("</td><td>", $ss, $fn, $count{$fn}), "</td></tr>\n";
					}
					elsif ($level == 2) {
						print TXT join("\t", $class->{$ss}->[0], $ss, $fn, $count{$fn}), "\n";
						print HTML "<tr><td>", join("</td><td>", $class->{$ss}->[0], $ss, $fn, $count{$fn}), "</td></tr>\n";
					}
					else {
						print TXT join("\t", @{$class->{$ss}}, $ss, $fn, $count{$fn}), "\n";
						print HTML "<tr><td>", join("</td><td>", @{$class->{$ss}}, $ss, $fn, $count{$fn}), "</td></tr>\n";
					}
				}
			}
		}
	}
	elsif ($level == 4) {
		foreach my $ssc (keys %$tl) {
			print TXT join("\t",  $ssc, $tl->{$ssc}), "\n";
			$tl->{$ssc} =~ s#\t#</td><td>#;
			print HTML "<tr><td>", join("</td><td>", $ssc, $tl->{$ssc}), "</td></tr>\n";
		}
	}
	elsif ($level == 5) {
		foreach my $ssc (keys %$ol) {
			print TXT join("\t",  $ssc, $ol->{$ssc}), "\n";
			print HTML "<tr><td>", join("</td><td>", $ssc, $ol->{$ssc}), "</td></tr>\n";
		}
	}

	print HTML "</TABLE>\n";
	close HTML;
	close TXT;
	return ({
			"tableHtml" => $FIG_Config::temp_url."/rtmg/$jobid/web/counts.html",
			"tableTxt" => $FIG_Config::temp_url."/rtmg/$jobid/web/counts.txt",
			});
}




1;


MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3