view release on metacpan or  search on metacpan

lib/Bio/Phylo/CIPRES.pm  view on Meta::CPAN

=head1 METHODS

=head2 new()

The constructor takes the arguments as shown in the SYNOPSIS section. The arguments are
a direct translation of the named arguments (not option flags) that are passed on the 
command line to the L<cipresrun>  program. The value of the C<outfile> argument, and that
of the C<param> argument, is both a hash reference.

=cut

sub new {
	my $class  = shift;
	my @fields = qw[infile tool param outfile url user pass cipres_appkey];
	my $self   = bless { map { $_ => undef } @fields }, $class;
	my %args   = @_;
	while( my ( $property, $value ) = each %args ) {
		$self->$property($value);
	}
	return $self;
}

=head2 run()

Runs the entire analysis using the configuration as provided to the constructor. Returns
key value pairs where each key is an C<outfile> and each file is the data as text.

=cut

sub run {
	my $self = shift;
	my $url  = $self->launch_job;
	while(1) {
		sleep(60);
		my $status = $self->check_status($url);
		if ( $status->{'completed'} eq 'true' ) {
			$self->get_results( $status->{'outfiles'} );
			return $url;
		}
	}
}

=head2 launch_job()

Is called by C<run()>. Launches the analysis and returns the status URL at which progress
can be inspected.

=cut

sub launch_job {
	my $self = shift;
	my $ua   = $self->ua;
	my $url  = $self->url;
	my $load = $self->payload;
	my @head = $self->headers(1);
	my $res  = $ua->post( $url . '/job/' . $self->user, $load, @head );
	if ( $res->is_success ) {
	
		# run submission, parse result
		my $status_url;	
		my $result = $res->decoded_content;
		DEBUG $result;
		XML::Twig->new(
			'twig_handlers' => {
				'jobstatus/selfUri/url' => sub { $status_url = $_->text }
			}
		)->parse($result);
		INFO "Job launched at $status_url";
		return $status_url;	
	}
	else {
		throw 'NetworkError' => $res->status_line;	
	}
}

=head2 check_status()

Is called by C<run()>. Consults the status URL. Returns a hash reference whose values
specify whether the job is done, and if so, where the results can be fetched.

=cut

sub check_status {
	my ( $self, $url ) = @_;
	INFO "Going to check status for $url";
	my $ua   = $self->ua;
	my @head = $self->headers(0);
	my $res  = $ua->get( $url, @head );
	if ( $res->is_success ) {
	
		# post request, fetch result
		my ( $status, $outfiles );
		my $result = $res->decoded_content;
		DEBUG $result;
		XML::Twig->new(
			'twig_handlers' => {
				'jobstatus/resultsUri/url' => sub { $outfiles = $_->text },
				'jobstatus/terminalStage'  => sub { $status   = $_->text }			
			}
		)->parse($result);
		my $time = localtime();
		INFO "[$time] completed: $status";
		return { 'completed' => $status, 'outfiles' => $outfiles };	
	}
	else {
		throw 'NetworkError' => $res->status_line;	
	}	
}

=head2 get_results()

Is called by C<run()>. Returns the named result data as a hash.

=cut

sub get_results {
	my ( $self, $url ) = @_;	
	my %out  = %{ $self->outfile }; 
	my $ua   = $self->ua;
	my @head = $self->headers(0);
	my $res  = $ua->get( $url, @head );
	my %out_url;
	if ( $res->is_success ) {
		my $result = $res->decoded_content;
		DEBUG $result;
		XML::Twig->new(
			'twig_handlers' => {
				'results/jobfiles/jobfile' => sub {
					my $node = $_;
					my $name = $node->findvalue('filename');
					if ( $out{ $name } ) {
						$out_url{ $name } = $node->findvalue('downloadUri/url');
					}
					DEBUG $node->toString;
				}
			}
		)->parse($result);
		for my $name ( keys %out ) {
			my $location = $out_url{ $name };
			$res = $ua->get( $location, @head );
			if ( $res->is_success ) {
				open my $fh, '>', $out{ $name } or die $!;
				print $fh $res->decoded_content;
			}
			else {
				throw 'NetworkError' => $res->status_line;	
			}
		}		
	}
	else {
		throw 'NetworkError' => $res->status_line;	
	}
}

=head2 yml()

Given the location the config.yml file, populates properties of the object with the
right parameter values to authenticate the client with the CIPRES server.

=cut

sub yml {
	my ( $self, $yml ) = @_;
	INFO "Reading YAML file $yml";	
	my $info = LoadFile($yml);
	DEBUG "Parsed " . Dumper( $info );
	$self->user( $info->{'CRA_USER'} );
	$self->pass( $info->{'PASSWORD'} );
	$self->url( $info->{'URL'} );
	$self->cipres_appkey( $info->{'KEY'} );
}

=head2 ua()

Instantiates an authenticated L<LWP::UserAgent> object.

=cut

sub ua {
	my $self = shift;
	my $host = URI->new( $self->url )->host();
	my $user = $self->user;
	my $pass = $self->pass;
	my $ua   = LWP::UserAgent->new;
	DEBUG "Instantiating UserAgent $host:$PORT / $REALM / $user:****";
	$ua->ssl_opts( 'verify_hostname' => 0 );
	$ua->credentials(
		$host . ':' . $PORT,
		$REALM,
		$user => $pass
	);
	return $ua;
}

=head2 payload()

Constructs the HTTP POST payload for launching jobs. Returns an array reference of
key/value pairs.

=cut

sub payload {
	my $self = shift;