[Bio] / FigKernelPackages / FFserver.pm Repository:
ViewVC logotype

View of /FigKernelPackages/FFserver.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (download) (as text) (annotate)
Thu Apr 30 20:33:41 2009 UTC (10 years, 7 months ago) by olson
Branch: MAIN
Changes since 1.1: +178 -53 lines
more support for stuff

package FFserver;

use LWP::UserAgent;
use FIG_Config;
use Data::Dumper;

use strict;

sub new
{
    my($class, $server_url) = @_;

    $server_url = $FIG_Config::FFserver_url unless $server_url;
    $server_url = "http://bio-macpro-1.mcs.anl.gov/~disz/FIG/figfam_server.cgi" unless $server_url;


    my $self = {
	server_url => $server_url,
	ua => LWP::UserAgent->new(),
    };

    return bless $self, $class;
}

sub assign_function_to_prot
{
    my($self, $input) = @_;

    my $wq;
    
    if (ref($input) eq 'ARRAY')
    {
	$wq = SequenceListWorkQueue->new($input);
    }
    else
    {
	$wq = FastaWorkQueue->new($input);
    }

    return ResultHandler->new($wq, $self->{server_url}, 'assign_function_to_prot', \&id_seq_pair_bundler, \&tab_delimited_output_parser);
}

sub assign_functions_to_dna
{
    my($self, $input) = @_;

    my $wq;
    
    if (ref($input) eq 'ARRAY')
    {
	$wq = SequenceListWorkQueue->new($input);
    }
    else
    {
	$wq = FastaWorkQueue->new($input);
    }

    return ResultHandler->new($wq, $self->{server_url}, 'assign_function_to_DNA', \&id_seq_pair_bundler, \&tab_delimited_dna_data_output_parser);
}

sub id_seq_pair_bundler
{
    my($item) = @_;
    my($id, $seq) = @$item[0,2];
    return "id_seq", join(",", $id, (ref($seq) eq 'SCALAR' ? $$seq : $seq));
}

sub tab_delimited_output_parser
{
    my($line) = @_;
    chomp $line;
    my @cols = split(/\t/, $line);
    return \@cols;
}


sub tab_delimited_dna_data_output_parser
{
    my($line) = @_;
    chomp $line;
    my ($id, $idbe, $fam) = split(/\t/, $line);
    my ($beg, $end) = $idbe =~ /_(\d+)_(\d+)$/;
    return [$id, $beg, $end, $fam];
}

package ResultHandler;
use strict;
use Data::Dumper;

sub new
{
    my($class, $work_queue, $server_url, $function, $input_bundler, $output_parser) = @_;

    my $self = {
	work_queue => $work_queue,
	server_url => $server_url,
	function => $function,
	input_bundler => $input_bundler,
	output_parser => $output_parser,
	ua => LWP::UserAgent->new(),
	cur_result => undef,
    };
    return bless $self, $class;
}

sub get_next
{
    my($self) = @_;

    if ($self->{cur_result})
    {
	return $self->get_next_from_result();
    }
    else
    {
	my @inp = $self->{work_queue}->get_next_n_bytes(16000);
	if (@inp)
	{
	    my $form = [function => $self->{function},
			map { &{$self->{input_bundler}}($_) } @inp ];
	    # print "Invoke " .Dumper($form);

	    my $res = $self->{ua}->post($self->{server_url}, $form);
	    if ($res->is_success)
	    {
		$self->{cur_result} = $res->content;
		#print "res: $self->{cur_result}\n";
		return $self->get_next_from_result();
	    }
	    else
	    {
		die "error on post " . $res->content;
	    }
	}
	else
	{
	    return;
	}
    }
}

sub get_next_from_result
{
    my($self) = @_;
    if ($self->{cur_result} =~ s/^([^\n]*)\n//)
    {
	return &{$self->{output_parser}}($1);
    }
}

package SequenceWorkQueue;
use strict;

sub new
{
    my($class) = @_;

    my $self = {};
    
    return bless $self, $class;
}

sub get_next_n
{
    my($self, $n) = @_;
    my @out;
    
    for (my $i = 0;$i < $n; $i++)
    {
	my($id, $com, $seqp) = $self->get_next();
	if (defined($id))
	{
	    push(@out, [$id, $com, $seqp]);
	}
	else
	{
	    last;
	}
    }
    return @out;
}

sub get_next_n_bytes
{
    my($self, $n) = @_;
    my @out;

    my $size = 0;
    while ($size < $n)
    {
	my($id, $com, $seqp) = $self->get_next();
	if (defined($id))
	{
	    push(@out, [$id, $com, $seqp]);
	    $size += (ref($seqp) eq 'SCALAR') ? length($$seqp) : length($seqp);
	}
	else
	{
	    last;
	}
    }
    return @out;
}

package FastaWorkQueue;
use strict;
use base 'SequenceWorkQueue';
use FileHandle;
use FIG;

sub new
{
    my($class, $input) = @_;

    my $fh;
    if (ref($input))
    {
	$fh = $input;
    }
    else
    {
	$fh = new FileHandle("<$input");
    }

    my $self = $class->SUPER::new();

    $self->{fh} = $fh;

    return bless $self, $class;
}

sub get_next
{
    my($self) = @_;

    my($id, $seqp, $com) = &FIG::read_fasta_record($self->{fh});
    return defined($id) ? ($id, $com, $seqp) : ();
}

package SequenceListWorkQueue;
use strict;
use base 'SequenceWorkQueue';

sub new
{
    my($class, $input) = @_;

    my $fh;
    if (ref($input) ne 'ARRAY')
    {
	die "SequenceWorkQueue requires a list as input";
    }

    my $self = $class->SUPER::new();

    $self->{list} = $input;

    return bless $self, $class;
}

sub get_next
{
    my($self) = @_;

    my $top = shift @{$self->{list}};

    return defined($top) ? @$top : ();
}


1;


MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3