view release on metacpan or  search on metacpan

lib/Bio/BioVeL/AsynchronousService.pm  view on Meta::CPAN

package Bio::BioVeL::AsynchronousService;
use strict;
use warnings;
use File::Path 'make_path';
use Scalar::Util 'refaddr';
use Bio::BioVeL::Service;
use Digest::MD5 'md5_hex';
use Apache2::Const '-compile' => qw'OK REDIRECT';
use Proc::ProcessTable;
use base 'Bio::BioVeL::Service';

# status constants
use constant RUNNING => 'running';
use constant DONE    => 'done';
use constant ERROR   => 'error';

=head1 NAME

Bio::BioVeL::AsynchronousService - base class for asynchronous web services

=head1 SYNOPSIS

 use Bio::BioVeL::AsynchronousService::Mock; # example class
 
 # this static method returns a writable directory into which
 # service objects are persisted between request/response cycles
 my $wd = Bio::BioVeL::AsynchronousService::Mock->workdir;

 # when instantiating objects, values for the 'parameters' that are defined
 # in their constructors can be provided as named arguments
 my $mock = Bio::BioVeL::AsynchronousService::Mock->new( 'seconds' => 1 );

 # every async service has a record of when it started
 my $epoch_time = $mock->timestamp;

 # can be RUNNING, ERROR or DONE
 if ( $mock->status eq Bio::BioVeL::AsynchronousService::DONE ) {
 	print $mock->response_body;
 }

=head1 DESCRIPTION

Asynchronous services need to subclass this class and implement at least the following
methods: C<launch> and C<response_body>. The parent class makes sure that launch()
forks off a process and returns immediately with enough information, stored as object
properties, so that update() can check how things are going and update the status(). 
Once the status set to C<DONE>, C<response_body> is executed to generate the output.

Successful implementations are likely going to have simple, serializable object properties
that allow a newly de-serialized object (i.e. during the next polling cycle) to probe
the process table or the job directory to check the status.

=head1 METHODS

=over

=item new

The constructor may or may not be passed the named argument 'jobid', which is used to
deserialize the job object and check on its status. If no job ID is provided, a new
object is created and launched.

=cut

sub new {
	my $class = shift;
	my $log   = $class->logger;
	my %args  = @_;
	my $self;
	if ( my $id = $args{'jobid'} ) {
	
		# unfreeze from file
		$log->info("instantiating existing $class job: $id");
		$self = $class->from_file( $class->workdir . '/' . $id . '.yml' );
		
		# check the service status
		eval { $self->update };
		if ( $@ ) {
			my $msg = "$@";		
			$log->error("problem updating $self: $msg");
			$self->lasterr( $msg );
			$self->status( ERROR );
		}
	}
	else {
		
		# create new instance
		$log->info("launching new $class job");
		$self = $class->SUPER::new( 'timestamp' => time(), %args );
		
		# generate UID: {pointer address}.{epoch time}
		$self->jobid( refaddr($self) . '.' . timestamp($self) );
		
		# launch the service
		eval { $self->launch_wrapper };
		if ( $@ ) {
			if ( $@ !~ /ModPerl::Util::exit/ ) {
				my $msg = "$@";
				$log->error("problem launching $self: $msg");
				$self->lasterr( $msg );
				$self->status( ERROR );
			}
			else {