Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Move Pise modules over to bioperl-pise

svn path=/bioperl-pise/trunk/; revision=15348
  • Loading branch information...
commit b2c081e530428abb8867333a50fb3769f1dc7dd4 0 parents
cjfields authored
1,027 Bio/Tools/Run/PiseApplication.pm
@@ -0,0 +1,1027 @@
+# $Id$
+#
+# BioPerl modules for Pise
+#
+# Cared for by Catherine Letondal <letondal@pasteur.fr>
+#
+# For copyright and disclaimer see below.
+#
+# POD documentation - main docs before the code
+
+=head1 NAME
+
+Bio::Tools::Run::PiseApplication - A class manage Pise programs information, configuring parameters and submit jobs.
+
+=head1 SYNOPSIS
+
+ use Bio::Tools::Run::AnalysisFactory::Pise;
+
+ # Build a Pise factory
+ my $factory = Bio::Tools::Run::AnalysisFactory::Pise->new();
+
+ # Then create an application object (Pise::Run::Tools::PiseApplication):
+ my $program = $factory->program('genscan');
+
+ # Set parameters
+ $program->seq($ARGV[0]);
+
+ # Next, run the program
+ # (notice that you can set some parameters at run time)
+ my $job = $program->run(-parameter_file => "Arabidopsis.smat");
+
+ # Test for submission errors:
+ if ($job->error) {
+ print "Job submission error (",$job->jobid,"):\n";
+ print $job->error_message,"\n";
+ exit;
+ }
+
+ # Get results
+ print STDERR $job->content('genscan.out');
+ # or:
+ my $result_file = $job->save('genscan.out');
+
+
+=head1 DESCRIPTION
+
+A class to manage Pise programs information, configuring parameters
+and submit jobs. It is the super-class of all the
+Bio::Tools::Run::PiseApplication::program classes.
+
+This class is preferably created through the
+Bio::Tools::Run::AnalysisFactory::Pise factory:
+
+ my $factory = Bio::Tools::Run::AnalysisFactory::Pise->new();
+ my $program = $factory->program('mfold');
+
+By submitting a job, you create a Bio::Tools::Run::PiseJob instance with
+the parameters you have just set. Bio::Tools::Run::PiseJob class handles
+a specific job state and results.
+
+ my $factory = Bio::Tools::Run::AnalysisFactory::Pise->new(
+ -email => 'me@myhome');
+ my $program = $factory->program('water',
+ -sequencea => $seqa,
+ -seqall => $seqb);
+
+ # run: submit and waits for completion
+ my $job = $program->run();
+
+ # for long jobs
+ my $job = $program->submit(); # only submit the request
+ my $jobid = $job->jobid;
+ # later, from another script
+ my $job = Bio::Tools::Run::PiseJob->fromUrl($jobid);
+ if ($job->terminated) {
+ print $job->stdout;
+ }
+
+
+=head2 Pise parameters setting.
+
+The @params list should contain a list of -parameter =E<gt> value pairs.
+
+ my @params = (-query => $file, -protein_db => "genpept");
+ my $program = $factory->program('blast2', @params);
+
+or directly :
+
+ my $program = $factory->program('blast2', query => $file, protein_db => "genpept");
+
+Each program parameter is described in the documentation of the
+corresponding Bio::Tools::Run::PiseApplication::program documentation.
+
+You can change parameters at any time by calling the corresponding
+method, e.g, changing the parameter E in blast2:
+
+ my $program = $factory->program('blast2', -protein_db => "genpept");
+ $program->query($seq);
+ $program->Expect($value);
+
+Parameter of Pise type "Sequence" and "InFile" may be given as string,
+filename, or filehandle. Parameter of type "Sequence" may also be given as Bio::Seq or Bio::SimpleAlign objects.
+
+=head2 Job output
+
+See Bio::Tools::Run::PiseJob for how to fetch results and chain programs.
+
+=head2 Location and email parameters
+
+Email can be set at factory creation.
+
+The location parameter stands for the actual CGI location. There are default
+values for most of Pise programs.
+
+You can either set location at:
+
+=over 3
+
+=item 1 factory creation
+
+ my $factory = Bio::Tools::Run::AnalysisFactory::Pise->new(
+ -location = 'http://somewhere/Pise/cgi-bin',
+ -email => 'me@myhome');
+
+=item 2 program creation
+
+ my $program = $factory->program('water',
+ -location = 'http://somewhere/Pise/cgi-bin/water.pl'
+ );
+
+=item 3 any time before running:
+
+ $program->location('http://somewhere/Pise/cgi-bin/water.pl');
+ $program->run();
+
+=item 4 when running:
+
+ $job = $program->run(-location => 'http://somewhere/Pise/cgi-bin/water.pl');
+
+=back
+
+=head1 FEEDBACK
+
+=head2 Mailing Lists
+
+User feedback is an integral part of the evolution of this and other
+Bioperl modules. Send your comments and suggestions preferably to
+the Bioperl mailing list. Your participation is much appreciated.
+
+ bioperl-l@bioperl.org - General discussion
+ http://bioperl.org/wiki/Mailing_lists - About the mailing lists
+
+=head2 Reporting Bugs
+
+Report bugs to the Bioperl bug tracking system to help us keep track
+of the bugs and their resolution. Bug reports can be submitted via the
+web:
+
+ http://bugzilla.open-bio.org/
+
+=head1 AUTHOR
+
+Catherine Letondal (letondal@pasteur.fr)
+
+=head1 COPYRIGHT
+
+Copyright (C) 2003 Institut Pasteur & Catherine Letondal.
+All Rights Reserved.
+
+This module is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=head1 DISCLAIMER
+
+This software is provided "as is" without warranty of any kind.
+
+=head1 SEE ALSO
+
+Bio::Tools::Run::AnalysisFactory::Pise
+Bio::Tools::Run::PiseJob
+
+=cut
+
+#'
+
+package Bio::Tools::Run::PiseApplication;
+
+use vars qw($AUTOLOAD $DEFAULT_PISE_EMAIL @ISA);
+use strict;
+use Bio::Root::Root;
+use Bio::Tools::Run::PiseJob;
+
+@ISA = qw(Bio::Root::Root);
+$DEFAULT_PISE_EMAIL = 'pise-bioapi@pasteur.fr';
+
+=head2 new
+
+ Title : new()
+ Usage : my $program = Bio::Tools::Run::PiseApplication->new($location,
+ $email);
+ Function: Creates a Bio::Tools::Run::PiseApplication::program object,
+ where program stands for any
+ of the Pise programs.
+ This method should not be used directly, but rather by
+ a Bio::Tools::Run::AnalysisFactory::Pise instance.
+ Example :
+ Returns : An instance of Bio::Tools::Run::PiseApplication::program.
+
+=cut
+
+sub new {
+ my ($class, $location, $email, $verbose) = @_;
+
+ my $self = $class->SUPER::new;
+ if (! defined $location) {
+ $self->throw(ref($self) . ": You must provide a Pise CGI url (-location).");
+ }
+ $self->{LOCATION} = $location;
+ if (defined $email) {
+ $self->{EMAIL} = $email;
+ } else {
+ $self->{EMAIL} = $DEFAULT_PISE_EMAIL;
+ }
+ if (defined $verbose) {
+ $self->{VERBOSE} = $verbose;
+ } else {
+ $self->{VERBOSE} = 0;
+ }
+ $self->{RESULTS_TYPE} = "url";
+ return $self;
+}
+
+=head2 location
+
+ Title : location
+ Usage : my $location = $program->location;
+ Function: Called from Bio::Tools::Run::PiseJob to get/set program/Pise
+ configuration informations from the
+ Bio::Tools::Run::PiseApplication::program class.
+ Example :
+ Returns : A string containing the url of the Pise server CGI.
+
+=cut
+
+sub location {
+ my $self = shift;
+ if (@_) { $self->{LOCATION} = shift ; }
+ return $self->{LOCATION} ;
+}
+
+=head2 email
+
+ Title : email()
+ Usage : my $email = $program->email();
+ Function: Called from Bio::Tools::Run::PiseJob to get/set program/Pise
+ configuration informations from the
+ Bio::Tools::Run::PiseApplication::program class.
+ Example :
+ Returns : A string containing the user email for submissions.
+
+=cut
+
+sub email {
+ my $self = shift;
+ if (@_) { $self->{EMAIL} = shift ; }
+ return $self->{EMAIL} ;
+}
+
+=head2 verbose
+
+ Title : verbose()
+ Usage : $program->verbose(1);
+ Function: Ask the object to tells more.
+ Example :
+ Returns : Actual value.
+
+=cut
+
+sub verbose {
+ my $self = shift;
+ if (@_) { $self->{VERBOSE} = shift ; }
+ return $self->{VERBOSE} ;
+}
+
+=head2 param_type
+
+ Title : param_type()
+ Usage : my $type = $program->param_type($param);
+ Function: Tells the Pise parameter type of $param (e.g: Sequence,
+ String, Excl, ...).
+ Example :
+ Returns : A string containing the Pise parameter type.
+
+=cut
+
+sub param_type {
+ my $self = shift;
+ my $param = shift;
+ my $type;
+ if ($param =~ /_data$/) {
+ my $p;
+ ($p = $param) =~ s/_data//;
+ $type = $self->type($p) ;
+# print STDERR "param: $param => $p type=$type\n" if ($self->{DEBUG});
+ } else {
+ $type = $self->type($param) ;
+ }
+ return $type;
+}
+
+=head2 run
+
+ Title : run()
+ Usage : $program->run();
+ $program->run(10);
+ Function: Submit the job and waits for completion. You may provide an
+ interval for completion checking.
+ Example :
+ Returns : The instance of Bio::Tools::Run::Pisejob that has been run.
+
+=cut
+
+sub run {
+ my ($self, @args) = @_;
+
+ my ($location) =
+ $self->_rearrange([qw(LOCATION )],
+ @args);
+ if (defined $location) {
+ $self->{LOCATION} = $location;
+ }
+
+ my ($interval) =
+ $self->_rearrange([qw(INTERVAL )],
+ @args);
+ if (! defined $interval) {
+ $interval = 10;
+ }
+
+ foreach my $param ($self->parameters_order) {
+ my $param_name = $param;
+ $param_name =~ tr/a-z/A-Z/;
+ my ($value) =
+ $self->_rearrange([$param_name],
+ @args);
+ if ($value) {
+ print STDERR "run: setting $param to $value\n" if $self->{VERBOSE};
+ $self->$param($value);
+ }
+ }
+
+ my $pisejob = $self->submit;
+ if (! defined $pisejob) {
+ $self->throw(ref($self) . "::run: no job created");
+ }
+ if ($pisejob->error) {
+ print STDERR ref($self) . "::run: error while submitting:", $pisejob->error_message,"\n" if $self->{VERBOSE};
+ return $pisejob;
+ }
+
+ my $jobid = $pisejob->jobid();
+
+ if ( ! ($pisejob->terminated) ) {
+ $pisejob->results_type($self->{RESULTS_TYPE});
+ }
+ while ( ! ($pisejob->terminated) ) {
+ print STDERR ref($self), "::run: waiting for completion...($jobid)\n" if $self->{VERBOSE};
+ sleep $interval;
+ last if ($pisejob->error);
+ }
+
+ $self->{_LASTJOBID} = $jobid;
+ return $pisejob;
+}
+
+=head2 submit
+
+ Title : submit()
+ Usage : $program->submit();
+ Function: Submit the job.
+ Example :
+ Returns : The instance of Bio::Tools::Run::Pisejob that has been run.
+
+=cut
+
+sub submit {
+ my ($self, @args) = @_;
+
+ my ($location) =
+ $self->_rearrange([qw(LOCATION )],
+ @args);
+ if (defined $location) {
+ $self->{LOCATION} = $location;
+ }
+
+ foreach my $param ($self->parameters_order) {
+ my $param_name = $param;
+ $param_name =~ tr/a-z/A-Z/;
+ my ($value) =
+ $self->_rearrange([$param_name],
+ @args);
+ if ($value) {
+ print STDERR "submit: setting $param to $value\n" if $self->{VERBOSE};
+ $self->$param($value);
+ }
+ }
+
+ my $pisejob = Bio::Tools::Run::PiseJob->new($self, $self->{VERBOSE});
+
+ if (! defined $pisejob) {
+ $self->throw(ref($self) . "::submit: no job created");
+ }
+ if ($pisejob->error) {
+ return $pisejob;
+ }
+ if ( ! ($pisejob->terminated) ) {
+ $pisejob->results_type($self->{RESULTS_TYPE});
+ }
+ my $jobid = $pisejob->jobid();
+ $self->{_LASTJOBID} = $jobid;
+
+ print STDERR ref($self), "::submit: job running, url: $jobid\n" if $self->{VERBOSE};
+
+ return $pisejob;
+}
+
+=head2 results_type
+
+ Title : results_type()
+ Usage : $program->results_type($type);
+ Function: Enables to change result delivery from one email per file
+ to url notification or attached files. $type is either: url,
+ attachment, email. This information will be provided to the job
+ when detached and submitted through the run method.
+ Example :
+ Returns :
+
+=cut
+
+sub results_type {
+ my ($self, $type) = @_;
+ $self->{RESULTS_TYPE} = $type;
+ print STDERR ref($self), "::results_type: results type changed to: $type\n" if $self->{VERBOSE};
+}
+
+
+=head2 paraminfo
+
+ Title : paraminfo()
+ Usage : $program->paraminfo();
+ Function: Displays parameters and prompts.
+ Example :
+ Returns :
+
+=cut
+
+sub paraminfo {
+ my $self = shift;
+ my $prompt;
+ foreach my $param ($self->parameters) {
+ $prompt = $self->prompt($param);
+ if ($prompt) {
+ print "$param\t\t$prompt\n";
+ }
+ }
+ return;
+}
+
+=head2 _init_params
+
+ Title : _init_params
+ Usage : $self->_init_params(@params);
+ Function: Internal. To be called from Pise::program::new method after
+ all the data structures have been initialized.
+ Example :
+ Returns :
+
+=cut
+
+sub _init_params {
+ my $self = shift;
+ my @params = @_;
+
+ my ($param, $value);
+ while (@params) {
+ $param = shift @params;
+ $value = shift @params;
+ next if( $param =~ /^-/ ); # don't want named parameters
+ print STDERR "init_params $param to $value\n" if $self->{VERBOSE};
+ $self->$param($value);
+ }
+}
+
+=head2 _OK_FIELD
+
+ Title : _OK_FIELD()
+ Usage : if ($self->_OK_FIELD($param)) ...
+ Function: Checks if $param is a known parameter for the specific program.
+ Example :
+ Returns : TRUE/FALSE
+
+=cut
+
+sub _OK_FIELD {
+ my ($self, $param) = @_;
+ print STDERR "_OK_FIELD: $param\n" if $self->{DEBUG};
+ if (grep /^$param$/, $self->parameters) {
+ return 1;
+ }
+ if ($param =~ /(\w+)_data$/) {
+ $param = $1;
+ my $type = $self->param_type($param);
+ if ($type eq "InFile" || $type eq "Sequence") {
+ return 1;
+ }
+ }
+
+}
+
+sub AUTOLOAD {
+ my $self = shift;
+ my $param = $AUTOLOAD;
+ $param =~ s/.*:://;
+
+ #print STDERR "AUTOLOAD: $param\n";
+ $self->throw("Unallowed parameter or unknown procedure: $param !") unless $self->_OK_FIELD($param);
+ $self->{$param} = shift if @_;
+ print STDERR ref($self), "::$param: $param set to: ",$self->{$param}, "\n" if $self->{DEBUG};
+ return $self->{$param};
+}
+
+#
+# from here on, all the methods are accessors to Pise data structures.
+#
+
+sub parameters {
+ my $self = shift;
+ return ($self->parameters_order);
+}
+
+sub command {
+ my $self = shift;
+ return $self->{COMMAND} ;
+}
+
+sub program {
+ my $self = shift;
+ return ( $self->command ) ;
+}
+
+sub version {
+ my $self = shift;
+ return $self->{VERSION} ;
+}
+
+sub title {
+ my $self = shift;
+ if (@_) { $self->{TITLE} = shift ; }
+ return $self->{TITLE} ;
+}
+
+sub description {
+ my $self = shift;
+ if (@_) { $self->{DESCRIPTION} = shift ; }
+ return $self->{DESCRIPTION} ;
+}
+
+sub authors {
+ my $self = shift;
+ if (@_) { $self->{AUTHORS} = shift ; }
+ return $self->{AUTHORS} ;
+}
+
+sub doclink {
+ my $self = shift;
+ if (@_) { $self->{DOCLINK} = shift ; }
+ return $self->{DOCLINK} ;
+}
+
+sub reference {
+ my $self = shift;
+ return @{ $self->{REFERENCE} };
+}
+
+sub seqinput {
+ my $self = shift;
+ if (@_) { $self->{SEQINPUT} = shift ; }
+ return $self->{SEQINPUT} ;
+}
+
+sub seqtype {
+ my $self = shift;
+ if (@_) { $self->{SEQTYPE} = shift ; }
+ return $self->{SEQTYPE} ;
+}
+
+sub top_parameters {
+ my $self = shift;
+ return @{ $self->{TOP_PARAMETERS} };
+}
+
+sub parameters_order {
+ my $self = shift;
+ return @{ $self->{PARAMETERS_ORDER} };
+}
+
+sub by_group_parameters {
+ my $self = shift;
+ return @{ $self->{BY_GROUP_PARAMETERS} };
+}
+
+sub type {
+ my $self = shift;
+ if (@_) {
+ my $param = shift;
+ if (@_) { $self->{TYPE}{$param} = shift ; }
+ return $self->{TYPE}{$param};
+ } else {
+ return %{ $self->{TYPE} };
+ }
+}
+
+sub format {
+ my $self = shift;
+ if (@_) {
+ my $param = shift;
+ if (@_) {
+ my $language = shift;
+ if (@_) { $self->{FORMAT}{$param}{$language} = shift ; }
+ return $self->{FORMAT}{$param}{$language};
+ } else {
+ if (defined $self->{FORMAT}{$param}) {
+ return %{ $self->{FORMAT}{$param} };
+ } else {
+ return $self->{FORMAT}{$param};
+ }
+ }
+ } else {
+ return %{ $self->{FORMAT} };
+ }
+}
+
+sub filenames {
+ my $self = shift;
+ if (@_) {
+ my $param = shift;
+ if (@_) { $self->{FILENAMES}{$param} = shift ; }
+ return $self->{FILENAMES}{$param};
+ } else {
+ return %{ $self->{FILENAMES} };
+ }
+}
+
+sub seqfmt {
+ my $self = shift;
+ if (@_) {
+ my $param = shift;
+ if (@_) { $self->{SEQFMT}{$param} = shift ; }
+ return @{ $self->{SEQFMT}{$param} };
+ } else {
+ return %{ $self->{SEQFMT} };
+ }
+}
+
+sub size {
+ my $self = shift;
+ if (@_) {
+ my $param = shift;
+ if (@_) { $self->{SIZE}{$param} = shift ; }
+ return $self->{SIZE}{$param};
+ } else {
+ return %{ $self->{SIZE} };
+ }
+}
+
+sub group {
+ my $self = shift;
+ if (@_) {
+ my $param = shift;
+ if (@_) { $self->{GROUP}{$param} = shift ; }
+ return $self->{GROUP}{$param};
+ } else {
+ return %{ $self->{GROUP} };
+ }
+}
+
+sub ishidden {
+ my $self = shift;
+ if (@_) {
+ my $param = shift;
+ if (@_) { $self->{ISHIDDEN}{$param} = shift ; }
+ return $self->{ISHIDDEN}{$param};
+ } else {
+ return %{ $self->{ISHIDDEN} };
+ }
+}
+
+sub iscommand {
+ my $self = shift;
+ if (@_) {
+ my $param = shift;
+ if (@_) { $self->{ISCOMMAND}{$param} = shift ; }
+ return $self->{ISCOMMAND}{$param};
+ } else {
+ return %{ $self->{ISCOMMAND} };
+ }
+}
+
+sub ismandatory {
+ my $self = shift;
+ if (@_) {
+ my $param = shift;
+ if (@_) { $self->{ISMANDATORY}{$param} = shift ; }
+ return $self->{ISMANDATORY}{$param};
+ } else {
+ return %{ $self->{ISMANDATORY} };
+ }
+}
+
+sub isstandout {
+ my $self = shift;
+ if (@_) {
+ my $param = shift;
+ if (@_) { $self->{ISSTANDOUT}{$param} = shift ; }
+ return $self->{ISSTANDOUT}{$param};
+ } else {
+ return %{ $self->{ISSTANDOUT} };
+ }
+}
+
+sub _interface_standout {
+ my $self = shift;
+ if (@_) { $self->{_INTERFACE_STANDOUT} = shift ; }
+ return $self->{_INTERFACE_STANDOUT};
+}
+
+sub _standout_file {
+ my $self = shift;
+ if (@_) { $self->{_STANDOUT_FILE} = shift ; }
+ return $self->{_STANDOUT_FILE};
+}
+
+sub prompt {
+ my $self = shift;
+ if (@_) {
+ my $param = shift;
+ if (@_) { $self->{PROMPT}{$param} = shift ; }
+ return $self->{PROMPT}{$param};
+ } else {
+ return %{ $self->{PROMPT} };
+ }
+}
+
+sub vlist {
+ my $self = shift;
+ if (@_) {
+ my $param = shift;
+ if (@_) { $self->{VLIST}{$param} = shift ; }
+ return @{ $self->{VLIST}{$param} };
+ } else {
+ return %{ $self->{VLIST} };
+ }
+}
+
+sub flist {
+ my $self = shift;
+ if (@_) {
+ my $param = shift;
+ if (@_) {
+ my $value = shift;
+ if (@_) { $self->{FLIST}{$param}{$value} = shift ; }
+ return $self->{FLIST}{$param}{$value};
+ } else {
+ if (defined $self->{FLIST}{$param}) {
+ return %{ $self->{FLIST}{$param} };
+ } else {
+ return $self->{FLIST}{$param} ;
+ }
+ }
+ } else {
+ return %{ $self->{FLIST} };
+ }
+}
+
+sub separator {
+ my $self = shift;
+ if (@_) {
+ my $param = shift;
+ if (@_) { $self->{SEPARATOR}{$param} = shift ; }
+ return $self->{SEPARATOR}{$param};
+ } else {
+ return %{ $self->{SEPARATOR} };
+ }
+}
+
+sub vdef {
+ my $self = shift;
+ if (@_) {
+ my $param = shift;
+ if (@_) { $self->{VDEF}{$param} = shift ; }
+ # may be a list (List type parameters)
+ # must be casted by user
+ return $self->{VDEF}{$param};
+ } else {
+ return %{ $self->{VDEF} };
+ }
+}
+
+sub precond {
+ my $self = shift;
+ if (@_) {
+ my $param = shift;
+ if (@_) {
+ my $language = shift;
+ if (@_) { $self->{PRECOND}{$param}{$language} = shift ; }
+ return $self->{PRECOND}{$param}{$language};
+ } else {
+ if (defined $self->{PRECOND}{$param}) {
+ return %{ $self->{PRECOND}{$param} };
+ } else {
+ return $self->{PRECOND}{$param} ;
+ }
+ }
+ } else {
+ return %{ $self->{PRECOND} };
+ }
+}
+
+sub ctrl {
+ my $self = shift;
+ if (@_) {
+ my $param = shift;
+ if (@_) {
+ my $language = shift;
+ if (@_) {
+ my $test = shift;
+ if (@_) {
+ $self->{CTRL}{$param}{$language}{$test} = shift ;
+ }
+ return $self->{CTRL}{$param}{$language}{$test};
+ } else {
+ if (defined $self->{CTRL}{$param}{$language}) {
+ return %{ $self->{CTRL}{$param}{$language} };
+ } else {
+ return $self->{CTRL}{$param}{$language};
+ }
+ }
+ } else {
+ if (defined $self->{CTRL}{$param}) {
+ return %{ $self->{CTRL}{$param} };
+ } else {
+ return $self->{CTRL}{$param};
+ }
+ }
+ } else {
+ return %{ $self->{CTRL} };
+ }
+}
+
+sub pipeout {
+ my $self = shift;
+ if (@_) {
+ my $param = shift;
+ if (@_) {
+ my $test = shift;
+ if (@_) { $self->{PIPEOUT}{$param}{$test} = shift ; }
+ return $self->{PIPEOUT}{$param}{$test} ;
+ } else {
+ if (defined $self->{PIPEOUT}{$param}) {
+ return %{ $self->{PIPEOUT}{$param} };
+ } else {
+ return $self->{PIPEOUT}{$param};
+ }
+ }
+ } else {
+ return %{ $self->{PIPEOUT} };
+ }
+}
+
+sub withpipeout {
+ my $self = shift;
+ if (@_) {
+ my $param = shift;
+ if (@_) {
+ my $test = shift;
+ if (@_) { $self->{WITHPIPEOUT}{$param}{$test} = shift ; }
+ return @{ $self->{WITHPIPEOUT}{$param}{$test} };
+ } else {
+ if (defined $self->{WITHPIPEOUT}{$param}) {
+ return %{ $self->{WITHPIPEOUT}{$param} };
+ } else {
+ return $self->{WITHPIPEOUT}{$param} ;
+ }
+ }
+ } else {
+ return %{ $self->{WITHPIPEOUT} };
+ }
+}
+
+sub pipein {
+ my $self = shift;
+ if (@_) {
+ my $param = shift;
+ if (@_) {
+ my $type = shift;
+ if (@_) { $self->{PIPEIN}{$param}{$type} = shift ; }
+ return $self->{PIPEIN}{$param}{$type} ;
+ } else {
+ if (defined $self->{PIPEIN}{$param}) {
+ return %{ $self->{PIPEIN}{$param} };
+ } else {
+ return $self->{PIPEIN}{$param};
+ }
+ }
+ } else {
+ return %{ $self->{PIPEIN} };
+ }
+}
+
+sub withpipein {
+ my $self = shift;
+ if (@_) {
+ my $param = shift;
+ if (@_) {
+ my $type = shift;
+ if (@_) { $self->{WITHPIPEIN}{$param}{$type} = shift ; }
+ return @{ $self->{WITHPIPEIN}{$param}{$type} };
+ } else {
+ if (defined $self->{WITHPIPEIN}{$param}) {
+ return %{ $self->{WITHPIPEIN}{$param} };
+ } else {
+ return $self->{WITHPIPEIN}{$param} ;
+ }
+ }
+ } else {
+ return %{ $self->{WITHPIPEIN} };
+ }
+}
+
+sub isclean {
+ my $self = shift;
+ if (@_) {
+ my $param = shift;
+ if (@_) { $self->{ISCLEAN}{$param} = shift ; }
+ return $self->{ISCLEAN}{$param};
+ } else {
+ return %{ $self->{ISCLEAN} };
+ }
+}
+
+sub issimple {
+ my $self = shift;
+ if (@_) {
+ my $param = shift;
+ if (@_) { $self->{ISSIMPLE}{$param} = shift ; }
+ return $self->{ISSIMPLE}{$param};
+ } else {
+ return %{ $self->{ISSIMPLE} };
+ }
+}
+
+sub paramfile {
+ my $self = shift;
+ if (@_) {
+ my $param = shift;
+ if (@_) { $self->{PARAMFILE}{$param} = shift ; }
+ return $self->{PARAMFILE}{$param};
+ } else {
+ return %{ $self->{PARAMFILE} };
+ }
+}
+
+sub comment {
+ my $self = shift;
+ if (@_) {
+ my $param = shift;
+ if (@_) {
+ $self->{COMMENT}{$param} = [ @{$_[0]} ] ;
+ }
+ if (defined $self->{COMMENT}{$param} ) {
+ return @{ $self->{COMMENT}{$param} };
+ } else {
+ return $self->{COMMENT}{$param}
+ }
+ } else {
+ return %{ $self->{COMMENT} };
+ }
+}
+
+
+sub scalemin {
+ my $self = shift;
+ if (@_) {
+ my $param = shift;
+ if (@_) { $self->{SCALEMIN}{$param} = shift ; }
+ return $self->{SCALEMIN}{$param};
+ } else {
+ return %{ $self->{SCALEMIN} };
+ }
+}
+
+sub scalemax {
+ my $self = shift;
+ if (@_) {
+ my $param = shift;
+ if (@_) { $self->{SCALEMAX}{$param} = shift ; }
+ return $self->{SCALEMAX}{$param};
+ } else {
+ return %{ $self->{SCALEMAX} };
+ }
+}
+
+sub scaleinc {
+ my $self = shift;
+ if (@_) {
+ my $param = shift;
+ if (@_) { $self->{SCALEINC}{$param} = shift ; }
+ return $self->{SCALEINC}{$param};
+ } else {
+ return %{ $self->{SCALEINC} };
+ }
+}
+
+
+1;
+
+
1,220 Bio/Tools/Run/PiseJob.pm
@@ -0,0 +1,1220 @@
+# $Id$
+# BioPerl modules for Pise
+#
+# Cared for by Catherine Letondal <letondal@pasteur.fr>
+#
+# For copyright and disclaimer see below.
+#
+# POD documentation - main docs before the code
+
+=head1 NAME
+
+Bio::Tools::Run::PiseJob - A class to manage Pise jobs.
+
+=head1 SYNOPSIS
+
+ use Bio::Tools::Run::AnalysisFactory::Pise;
+
+ # Build a Pise factory
+ my $factory = Bio::Tools::Run::AnalysisFactory::Pise->new();
+
+ # Then create an application object (Pise::Run::Tools::PiseApplication):
+ my $program = $factory->program('genscan');
+
+ # Set parameters
+ $program->seq($ARGV[0]);
+
+ # Next, run the program
+ # (notice that you can set some parameters at run time)
+ my $job = $program->run(-parameter_file => "Arabidopsis.smat");
+
+ my $job = $program->run(-seq => $ARGV[0]);
+
+ # Test for submission errors:
+ if ($job->error) {
+ print "Job submission error (",$job->jobid,"):\n";
+ print $job->error_message,"\n";
+ exit;
+ }
+
+ # Get results
+ print STDERR $job->content('genscan.out');
+ # or:
+ my $result_file = $job->save('genscan.out');
+
+
+=head1 DESCRIPTION
+
+Bio::Tools::Run::PiseJob class handles a specific job state and results.
+A Bio::Tools::Run::PiseJob instance should be created by a subclass of
+Bio::Tools::Run::PiseApplication class, e.g
+Bio::Tools::Run::PiseApplication::genscan or
+Bio::Tools::Run::PiseApplication::dnapars, ... (see
+Bio::Tools::Run::PiseApplication class) :
+
+ my $job = Bio::Tools::Run::PiseJob->new($self, $self->{VERBOSE});
+
+This class may also be used as a mean to get informations
+about a running job, or to get results after a long computation:
+
+ my $job = Bio::Factory::Pise->job($url);
+ print $job->content('infile.aln');
+
+Once the job is created, you can get results:
+
+ foreach my $result ($job->get_results) {
+ print $job->content($result);
+ $job->save($result, "myfile"); # $job->save($result) keeps the name
+ print $job->stdout; # print job standard output
+ print $job->stderr; # print job standard error
+ }
+
+You can feed a result file as a filehandle to a bioperl parser :
+
+ my $parser = Bio::Tools:Genscan->new (-fh => $job->fh('genscan.out'));
+ my $parser = Bio::Tools:BPlite->new (-fh => $job->fh('blast2.txt'));
+
+... or to another pise job:
+
+ my $neighbor = $factory->program ('neighbor',
+ -infile => $job->fh('outfile'));
+
+You can lookup up for a type of result that could be piped to another
+Pise program:
+
+ my $matrix = $job->lookup_piped_file('phylip_dist');
+
+returns the url of the just calculated Phylip distances matrix file,
+produced by e.g DNADIST or PROTDIST.
+
+All the available pipe types may be obtained by:
+
+ $job->lookup_piped_files;
+
+=head1 FEEDBACK
+
+=head2 Mailing Lists
+
+User feedback is an integral part of the evolution of this and other
+Bioperl modules. Send your comments and suggestions preferably to
+the Bioperl mailing list. Your participation is much appreciated.
+
+ bioperl-l@bioperl.org - General discussion
+ http://bioperl.org/wiki/Mailing_lists - About the mailing lists
+
+=head2 Reporting Bugs
+
+Report bugs to the Bioperl bug tracking system to help us keep track
+of the bugs and their resolution. Bug reports can be submitted via the
+web:
+
+ http://bugzilla.open-bio.org/
+
+=head1 AUTHOR
+
+Catherine Letondal (letondal@pasteur.fr)
+
+=head1 COPYRIGHT
+
+Copyright (C) 2003 Institut Pasteur & Catherine Letondal.
+All Rights Reserved.
+
+This module is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=head1 DISCLAIMER
+
+This software is provided "as is" without warranty of any kind.
+
+=head1 SEE ALSO
+
+Bio::Tools::Run::AnalysisFactory::Pise
+Bio::Tools::Run::PiseApplication
+
+=cut
+
+#'
+
+package Bio::Tools::Run::PiseJob;
+
+use strict;
+use Bio::Root::Root;
+use Bio::AlignIO;
+use Bio::Tools::Run::PiseJobParser;
+use XML::Parser::PerlSAX;
+use LWP::UserAgent;
+use HTTP::Request::Common;
+use POSIX;
+use Bio::Root::Version;
+
+use base qw(Bio::Root::Root);
+
+our $VERSION = ${Bio::Root::Version::VERSION};
+
+=head2 new
+
+ Title : new()
+ Usage : $job = Bio::Tools::Run::PiseJob->new($application, $verbose);
+ Function: Creates a Bio::Tools::Run::PiseJob object.
+ This is normally called by an application object
+ - i.e a subclass of the Bio::Tools::Run::PiseApplication class,
+ for submitting a job.
+ This method actually submit the job and parse results.
+ Example :
+ Returns : An instance of Bio::Tools::Run::PiseJob.
+
+=cut
+
+sub new {
+ my ($class, $application, $verbose) = @_;
+ my $self = $class->SUPER::new();
+
+ $self->{APPLICATION} = $application;
+ $self->{VERBOSE} = $verbose;
+ $self->{DEBUG} = 0;
+
+ $self->_init;
+ $self->_submit;
+ return $self;
+}
+
+=head2 verbose
+
+ Title : verbose()
+ Usage : $program->verbose(1);
+ Function: Ask the object to tells more.
+ Example :
+ Returns :
+
+=cut
+
+sub verbose {
+ my $self = shift;
+ if (@_) { $self->{VERBOSE} = shift ; }
+ return $self->{VERBOSE} ;
+}
+
+=head2 job
+
+ Title : job()
+ Usage : $job = Bio::Tools::Run::PiseJob->job(url);
+ Function: Creates a Bio::Tools::Run::PiseJob object from an already
+ run job by giving the url of the job result page.
+ May also be called through Bio::Factory::Pise->job(url);
+ Example :
+ Returns : An instance of Bio::Tools::Run::PiseJob.
+
+=cut
+
+sub job {
+ my ($class, $url, $verbose) = @_;
+ my $self = Bio::Tools::Run::PiseJob->SUPER::new();
+
+ $self->{JOBID} = $url;
+ $self->{VERBOSE} = $verbose;
+ $self->{ERROR} = undef;
+ $self->{ERROR_MESSAGE} = undef;
+ $self->{TERMINATED} = 0;
+ $self->{RESULT_FILES} = undef;
+ $self->{RESULTS} = undef;
+ $self->{SCRATCH_DIR} = undef;
+ $self->{DEBUG} = 0;
+ $self->{PIPES} = {};
+ $self->{TMPFILES} = [];
+ $self->{PIPED_FILE_TYPE} = {};
+
+ my $ua = $self->_get_ua;
+ my $res = $ua->request(GET $self->{JOBID});
+
+ if ($res->is_success) {
+ $self->{RESULTS} = $res->content;
+ if ($self->_parse($res->content) < 0) {
+ $self->{ERROR} = 1;
+ $self->{ERROR_MESSAGE} = ref($self) . " _fromUrl: parsing error";
+ }
+ } else {
+ $self->{ERROR} = 1;
+ $self->{ERROR_MESSAGE} = ref($self) . " _fromUrl: " . $res->message;
+ $self->throw(ref($self) . " _fromUrl: " . $res->message);
+ }
+
+ return $self;
+}
+
+=head2 jobid
+
+ Title : jobid()
+ Usage : $job->jobid();
+ Function: Returns the url of the job result page.
+ Example :
+ Returns :
+
+=cut
+
+sub jobid {
+ my $self = shift;
+ return $self->{JOBID};
+}
+
+=head2 error
+
+ Title : error()
+ Usage : $job->error();
+ Function: Tells if the job has been successfully run. This is the case
+ when the job has been submitted, but the Pise server has
+ detected user errors (missing mandatory parameter, unallowed
+ value,...). This also happen when the user provided an
+ invalid url, or the http request could not be submitted.
+ See method error_message().
+
+ Example :
+ Returns : TRUE/FALSE
+
+=cut
+
+sub error {
+ my $self = shift;
+ return $self->{ERROR};
+}
+
+=head2 error_message
+
+ Title : error_message()
+ Usage : $job->error_message();
+ Function: Returns the error message.
+ Example :
+ Returns : A string.
+
+=cut
+
+sub error_message {
+ my $self = shift;
+ return $self->{ERROR_MESSAGE};
+}
+
+=head2 get_results
+
+ Title : get_results()
+ Usage : $job->get_results();
+ Function: Provides the urls of the result files.
+ Example :
+ Returns : A list of urls.
+
+=cut
+
+sub get_results {
+ my $self = shift;
+
+ if (! $self->{JOBID}) {
+ $self->throw("Bio::Tools::Run::PiseJob::get_results: your job has no jobid");
+ }
+ if (! $self->{TERMINATED}) {
+ $self->throw("Bio::Tools::Run::PiseJob::get_results: your job is not terminated");
+ }
+
+ return @{ $self->{RESULT_FILES} };
+}
+
+=head2 get_pipes
+
+ Title : get_pipes()
+ Usage : $job->get_pipes($result);
+ Function: Provides the names of the programs that can use this type of
+ result. $result is an url, that can be provided through the
+ get_results method.
+ Example :
+ Returns : A list of program names.
+
+=cut
+
+sub get_pipes {
+ my $self = shift;
+ my $result_file = shift;
+
+ if (! $self->{JOBID}) {
+ $self->throw("Bio::Tools::Run::PiseJob::get_pipes: your job has no jobid");
+ }
+ if (! $self->{TERMINATED}) {
+ $self->throw("Bio::Tools::Run::PiseJob::get_pipes: your job is not terminated");
+ }
+
+ my %pipes = %{ $self->{PIPES}};
+ if (defined $pipes{$result_file}) {
+ my @pipes = @{ $pipes{$result_file} };
+ return @pipes;
+ } else {
+ return;
+ }
+}
+
+=head2 piped_file_type
+
+ Title : piped_file_type()
+ Usage : $job->piped_file_type($result);
+ Function: Provides the Pise type of $result. $result is an url,
+ that can be provided through the get_results method.
+ Example :
+ Returns : A Pise pipetype name.
+
+=cut
+
+sub piped_file_type {
+ my $self = shift;
+ my $result_file = shift;
+ if (! $self->{JOBID}) {
+ $self->throw("Bio::Tools::Run::PiseJob::piped_file_type: your job has no jobid");
+ }
+ if (! $self->{TERMINATED}) {
+ $self->throw("Bio::Tools::Run::PiseJob::piped_file_type: your job is not terminated");
+ }
+ return $self->{PIPED_FILE_TYPE}{$result_file};
+}
+
+=head2 lookup_piped_files
+
+ Title : lookup_piped_files()
+ Usage : $pipe_types = $job->lookup_piped_files();
+ Function: Returns the pipe types produced by the job
+ (e.g: phylip_tree, seqsfile, readseq_ok_alig, ...).
+ You have to call lookup_piped_file($type) to get the actual
+ correponding result file.
+ Example :
+ Returns : A string.
+
+=cut
+
+sub lookup_piped_files {
+ my $self = shift;
+ my $pipe_type = shift;
+ if (! $self->{JOBID}) {
+ $self->throw(ref($self) . " lookup_piped_files: your job has no jobid");
+ }
+ if (! $self->{TERMINATED}) {
+ $self->throw(ref($self) . " lookup_piped_files: your job is not terminated");
+ }
+ return (values %{$self->{PIPED_FILE_TYPE}});
+
+}
+
+=head2 lookup_piped_file
+
+ Title : lookup_piped_file(type)
+ Usage : $result = $job->lookup_piped_file($type);
+ Function: Returns the name of the result file of pipe type $type
+ (e.g: phylip_tree, seqsfile, readseq_ok_alig, ...). $result
+ is an url.
+ Example :
+ Returns : A string (an url).
+
+=cut
+
+sub lookup_piped_file {
+ my $self = shift;
+ my $pipe_type = shift;
+ if (! $self->{JOBID}) {
+ $self->throw("Bio::Tools::Run::PiseJob::lookup_piped_file: your job has no jobid");
+ }
+ if (! $self->{TERMINATED}) {
+ $self->throw("Bio::Tools::Run::PiseJob::lookup_piped_file: your job is not terminated");
+ }
+ foreach my $result (@{ $self->{RESULT_FILES}} ) {
+ if ($self->{PIPED_FILE_TYPE}{$result} eq $pipe_type) {
+ return $result;
+ }
+ }
+}
+
+=head2 terminated
+
+ Title : terminated()
+ Usage : $job->terminated();
+ Function: Tells whether the job has terminated.
+ Example :
+ Returns : TRUE/FALSE.
+
+=cut
+
+sub terminated {
+ my $self = shift;
+ my $jobid = shift;
+ if (! defined $jobid) {
+ $jobid = $self->{JOBID};
+ }
+ if (! defined $jobid) {
+ $self->{ERROR} = 1;
+ $self->{ERROR_MESSAGE} = ref($self) . " terminated: no jobid?";
+ }
+ my $ua = $self->_get_ua;
+
+ my $res = $ua->request(GET $jobid);
+
+ if ($res->is_success) {
+ $self->{RESULTS} = $res->content;
+ if ($self->_parse($res->content) < 0) {
+ $self->{ERROR} = 1;
+ $self->{ERROR_MESSAGE} = ref($self) . " terminated: parsing error";
+ }
+ } else {
+ $self->{ERROR} = 1;
+ $self->{ERROR_MESSAGE} = ref($self) . " terminated: " . $res->message;
+ $self->throw(ref($self) . " terminated: " . $res->message);
+ }
+
+ if ($self->{TERMINATED}) {
+ return 1;
+ }
+
+ return 0;
+}
+
+=head2 save
+
+ Title : save()
+ Usage : $filename = $job->save($result);
+ $filename = $job->save($result, $name);
+ Function: Save the result in a file. $result is an url,
+ that can be provided through the get_results method. You can
+ provide your own filename. By default, the file name will be
+ the same as the result name.
+ Example :
+ Returns : A file name.
+
+=cut
+
+sub save {
+ my $self = shift;
+ my $jobid;
+ my $url;
+ my $file;
+ my $result;
+
+ if (! $self->{JOBID}) {
+ $self->throw("Bio::Tools::Run::PiseJob::save: your job has no jobid");
+ }
+ if (! $self->{TERMINATED}) {
+ $self->throw("Bio::Tools::Run::PiseJob::save: your job is not finished");
+ }
+ if (@_) {
+ $result = shift;
+ } else {
+ $self->throw("Bio::Tools::Run::PiseJob::save: you must provide the result url");
+ }
+
+ my $tmp_url = $self->{JOBID};
+ if (@_) {
+ $file = shift;
+ } else {
+ $file = $result;
+ if ($file =~ /http/) {
+ $file =~ s/$tmp_url//;
+ if (defined $self->{PROGRAM}) {
+ my $cmd = $self->{PROGRAM};
+ $file =~ s/$cmd//;
+ $file =~ s/\w?\d+\///;
+ $file =~ s/\///g;
+ } else {
+ $file =~ s/\w+\/\w?\d+\///;
+ $file =~ s/\///g;
+ }
+ }
+ }
+
+ my $ua = $self->_get_ua;
+
+ foreach $url (@{ $self->{RESULT_FILES}}) {
+ if ($self->{DEBUG}) {
+ $self->debug(ref($self), "::save: $url (",$self->{PROGRAM},")\n");
+ }
+ if ($url =~ /$result/) {
+ my $res = $ua->request(GET $url);
+
+ if ($res->is_success) {
+ open(my $FILE,"> $file") || die "cannot open $file: $!";
+ print $FILE $res->content;
+ close $FILE;
+ return $file;
+ } else {
+ $self->{ERROR} = 1;
+ $self->{ERROR_MESSAGE} = ref($self) . " save: " . $res->message;
+ $self->throw(ref($self) . " save: " . $res->message);
+ }
+ }
+ }
+}
+
+=head2 content
+
+ Title : content()
+ Usage : $s = $job->content($result);
+ Function: Provides the content of $result. $result is an url,
+ that can be provided through the get_results method.
+ By default, $result is the standard output.
+ Example :
+ Returns : A string.
+
+=cut
+
+sub content {
+ my $self = shift;
+ my $jobid;
+ my $url;
+ my $file;
+
+ if (@_) {
+ $file = shift;
+ } else {
+ $file = $self->{PROGRAM} . ".out";
+ }
+
+ if (! $self->{JOBID}) {
+ $self->throw("Bio::Tools::Run::PiseJob::content: your job has no jobid");
+ }
+ if (! $self->{TERMINATED}) {
+ $self->throw("Bio::Tools::Run::PiseJob::content: your job is not terminated");
+ }
+
+ my $ua = $self->_get_ua;
+
+ foreach $url (@{ $self->{RESULT_FILES}}) {
+ if ($self->{DEBUG}) {
+ $self->debug(ref($self) . " content: $url (",$self->{PROGRAM},")\n");
+ }
+ if ($url =~ /$file/) {
+ if ($self->{DEBUG}) {
+ $self->debug(ref($self) . " content: this one!\n");
+ }
+ my $res = $ua->request(GET $url);
+
+ if ($res->is_success) {
+ return $res->content;
+ } else {
+ $self->{ERROR} = 1;
+ $self->{ERROR_MESSAGE} = ref($self) . " content: " . $res->message;
+ $self->throw(ref($self) . " content: " . $res->message);
+ }
+ }
+ }
+}
+
+=head2 stdout
+
+ Title : stdout()
+ Usage : print $job->stdout();
+ Function: Provides the content of the job standard output.
+ Example :
+ Returns : A string.
+
+=cut
+
+sub stdout {
+ my $self = shift;
+ if (! $self->{JOBID}) {
+ $self->throw("Bio::Tools::Run::PiseJob::stdout: your job has no jobid");
+ }
+ if (! $self->{TERMINATED}) {
+ $self->throw("Bio::Tools::Run::PiseJob::stdout: your job has not terminated");
+ }
+
+ return $self->content($self->{PROGRAM} . ".out");
+
+}
+
+=head2 output
+
+ Title : output()
+ Usage : Alias for stdout()
+
+=cut
+
+sub output {
+ my $self = shift;
+ return($self->stdout);
+}
+
+=head2 stderr
+
+ Title : stderr()
+ Usage : print $job->stderr();
+ Function: Provides the content of the job standard error.
+ Example :
+ Returns : A string.
+
+=cut
+
+sub stderr {
+ my $self = shift;
+
+ if (! $self->{JOBID}) {
+ $self->throw("Bio::Tools::Run::PiseJob::stderr: your job has no jobid");
+ }
+ if (! $self->{TERMINATED}) {
+ $self->throw("Bio::Tools::Run::PiseJob::stderr: your job has not terminated");
+ }
+
+ return $self->content($self->{PROGRAM} . ".err");
+
+}
+
+=head2 fh
+
+ Title : fh()
+ Usage : $fh = $job->fh($result);
+ Function: Provides a filhandle for a result.
+ $result is an url, that can be provided through the
+ get_results method.
+
+ Be aware that you must re-ask for it for a subsequent use. For
+ instance, if you first use it for an input parameter:
+ my $program = Pise::program->new ( ...,
+ file => $previous_job->fh('..'),
+ );
+ my $job = $program->run;
+
+ A subsequent run of the same object: will need a re-initialization:
+ $program->file($previous_job->fh('..'));
+ my $job2 = $program->run;
+
+ Example :
+ Returns : A filehandle.
+
+=cut
+
+sub fh {
+ my $self = shift;
+ my $jobid;
+ my $url;
+ my $file;
+
+ if (! $self->{JOBID}) {
+ $self->throw("Bio::Tools::Run::PiseJob::fh: your job has no jobid");
+ }
+ if (! $self->{TERMINATED}) {
+ $self->throw("Bio::Tools::Run::PiseJob::fh: your job has not terminated");
+ }
+ if (@_) {
+ $file = shift;
+ } else {
+ $file = $self->{PROGRAM} . ".out";
+ }
+
+ my $ua = $self->_get_ua;
+
+ foreach $url (@{ $self->{RESULT_FILES}}) {
+ if ($self->{DEBUG}) {
+ $self->debug("DEBUG> Bio::Tools::Run::PiseJob fh: $url (",$self->{PROGRAM},")\n");
+ }
+ if ($url =~ /$file/ or $file =~ /$url/ or $file==$url) {
+ if ($self->{DEBUG}) {
+ $self->debug("Bio::Tools::Run::PiseJob::fh: this one ($file)!\n");
+ }
+ my $res = $ua->request(GET $url);
+
+ if ($res->is_success) {
+ @{ $self->{FH_DATA} } = split( "\n", $res->content);
+ my $class = ref($self) || $self;
+ my $s = Symbol::gensym;
+ tie $$s,$class,$self;
+ return $s;
+ } else {
+ $self->{ERROR} = 1;
+ $self->{ERROR_MESSAGE} = ref($self) . " fh: " . $res->message;
+ $self->throw(ref($self) . " fh: " . $res->message);
+ }
+ }
+ }
+
+
+}
+
+=head2 results_type
+
+ Title : results_type()
+ Usage : $job->results_type($type);
+ Function: Enables to change result delivery from one email per file
+ to url notification or attached files. $type is either: url,
+ attachment, email.
+ Example :
+ Returns : 1 if success, 0 if job already terminated.
+
+=cut
+
+sub results_type {
+ my $self = shift;
+ my $results_type;
+ if (! $self->{JOBID}) {
+ $self->throw("Bio::Tools::Run::PiseJob::results_type: your job has no jobid");
+ }
+ if ($self->{TERMINATED}) {
+ $self->debug("Bio::Tools::Run::PiseJob::results_type: job already terminated\n");
+ return 0;
+ }
+ if (@_) {
+ $results_type = shift;
+ } else {
+ $results_type = "url";
+ }
+
+ my $jobid = $self->{JOBID};
+ my $application = $self->{APPLICATION};
+ my $email = $self->{EMAIL};
+
+ my $scratch_dir = (defined $self->{SCRATCH_DIR}) ? $self->{SCRATCH_DIR} : "" ;
+ my $command = $application->program;
+ if ($scratch_dir eq "") {
+ ($scratch_dir = $jobid) =~ s/http.+\/(\w?\d+)/$1/;
+ $scratch_dir =~ s/index.html//;
+ $scratch_dir = "$command/$scratch_dir";
+ }
+
+ my $ua = $self->_get_ua;
+
+ my $location = $self->{LOCATION};
+ $location =~ s/$command\.pl//;
+ $location .= "lib/results.pl";
+ $self->debug("Bio::Tools::Run::PiseJob::results_type: running $location to change results type ($results_type scratch_dir: $scratch_dir)\n");
+
+ my $res = $ua->request(POST $location, [command => $command, email => $email, results_type => $results_type, scratch_dir => $scratch_dir]);
+
+ if ($res->is_success) {
+ return 1;
+ } else {
+ $self->throw("Bio::Tools::Run::PiseJob::results_type: " . $res->message);
+ }
+}
+
+=head2 value
+
+ Title : value(param)
+ Usage : $job->value(param);
+ Function:
+ Example :
+ Returns : value of parameter param, if available.
+
+=cut
+
+sub value {
+ my $self = shift;
+ my $param;
+ if (! $self->{JOBID}) {
+ $self->throw("Bio::Tools::Run::PiseJob::value: your job has no jobid");
+ }
+ if (! $self->{TERMINATED}) {
+ $self->throw("Bio::Tools::Run::PiseJob::value: the job has not terminated");
+ }
+ if (@_) {
+ $param = shift;
+ } else {
+ return;
+ }
+
+ if (exists $self->{VALUE}{$param}) {
+ return $self->{VALUE}{$param};
+ }
+}
+
+=head2 _init
+
+ Title : _init()
+ Usage : $self->_init;
+ Function: Internal. Initializes parameters. Called by new.
+ Example :
+ Returns :
+
+=cut
+
+sub _init {
+ my $self = shift;
+ my $application = $self->{APPLICATION};
+
+ $self->{PROGRAM} = $application->program;
+ $self->{LOCATION} = $application->location;
+ $self->{EMAIL} = $application->email;
+ $self->{JOBID} = undef;
+ $self->{ERROR} = undef;
+ $self->{ERROR_MESSAGE} = undef;
+ $self->{TERMINATED} = 0;
+ $self->{ARGS} = undef;
+ $self->{RESULT_FILES} = undef;
+ $self->{RESULTS} = undef;
+ $self->{SCRATCH_DIR} = undef;
+ $self->{PIPES} = {};
+ $self->{PIPED_FILE_TYPE} = {};
+ $self->{UA} = undef;
+ $self->{VERSION} = $VERSION;
+
+ foreach my $param ($application->parameters) {
+ my $value;
+ $self->debug("Bio::Tools::Run::PiseJob::_init param type: ", $application->param_type($param), "\n");
+ $value = $application->$param();
+ if (defined $value) {
+ $self->debug("Bio::Tools::Run::PiseJob::_init param value: $value, ref: ",ref($value),"\n");
+
+ if ($application->param_type($param) eq "Sequence" || $application->param_type($param) eq "InFile") {
+ if (ref($value)) {
+ $self->debug(ref($self), "::_init: ",ref($value), "\n");
+ if (ref($value) eq "GLOB" || $value->isa('IO::Handle')) {
+ $self->debug("Bio::Tools::Run::PiseJob::_init got filehandle ",ref($value),"\n");
+ while (<$value>) {
+ $self->{ARGS}{$param . "_data"} .= $_;
+ }
+ } elsif ($value->isa("Bio::PrimarySeqI")) {
+ # not restricted to Sequence type (for
+ # Sequence type in Pise implies conversion)
+ $self->{ARGS}{$param . "_data"} = $value->seq;
+
+ } elsif ($value->isa("Bio::SimpleAlign")) {
+ # not restricted to Sequence type (for
+ # Sequence type in Pise implies conversion)
+
+ #my $tmpfile = POSIX::tmpnam;
+ my $tmpfile = $param . ".fasta";
+ # bioperl 1.0
+ my $out = Bio::AlignIO->new(-file => ">$tmpfile", '-format' => 'fasta');
+ $out->write_aln($value);
+ #close(TMP);
+ push (@{$self->{TMPFILES}}, $tmpfile);
+ $self->debug("Bio::Tools::Run::PiseJob::_init written alignment to $tmpfile\n");
+ $self->{ARGS}{$param} = $tmpfile;
+ }
+ } else {
+ if (ref(\$value) eq "SCALAR" && -f $value) {
+ $self->{ARGS}{$param} = $value;
+ $self->debug("Bio::Tools::Run::PiseJob::_init got file ($value)\n");
+ } else {
+ $self->{ARGS}{$param . "_data"} = $value;
+ }
+ }
+ } else {
+ $self->{ARGS}{$param} = $value;
+ }
+ }
+ }
+
+ $self->{ARGS}{'email'} = $self->{EMAIL};
+}
+
+=head2 _submit
+
+ Title : _submit()
+ Usage : $self->_submit();
+ Function: Internal. Sends the http request on a Pise server. Called by new.
+ Example :
+ Returns : -1 if an error has occured
+ jobid else
+ Exceptions: when the job has already been submitted.
+
+=cut
+
+sub _submit {
+
+ my $self = shift;
+
+ if (defined $self->{JOBID}) {
+ $self->debug(ref($self) . " submit: this job has been already setup and launched\n");
+ $self->{ERROR} = 1;
+ $self->{ERROR_MESSAGE} = ref($self) . " _submit: this job has been already setup and launched";
+ $self->throw(ref($self) . " _submit: this job has been already setup and launched");
+
+ }
+
+ my $location = $self->{LOCATION};
+
+ my $application = $self->{APPLICATION};
+ my $type;
+ my $value;
+ my $vdef;
+ my @content;
+
+ foreach my $param (keys %{ $self->{ARGS} }) {
+ $type = $application->param_type($param) || '';
+ $value = $self->{ARGS}{$param} || '';
+ if (defined $type &&
+ ($type eq "InFile" || $type eq "Sequence") ) {
+ if ($param !~ /_data$/) {
+ stat($value);
+ if (-e _) {
+ push (@content, $param => [$value]);
+ $self->debug("_submit(1): $param: file $value\n");
+ } else {
+ push (@content, $param => $value);
+ $self->debug("_submit(1): $param: not file (1)\n");
+ }
+ } else {
+ push (@content, $param => $value);
+ $self->debug("_submit(1): $param: not file ($value)(2)\n");
+ }
+ } elsif ($type eq "Switch") {
+ if ($value) {
+ push (@content, $param => "on");
+ }
+ } elsif ($type eq "List") {
+ foreach my $v (@{ $value }) {
+ push (@content, $param => $v);
+ }
+ } else {
+ push (@content, $param => $value);
+ }
+
+# $self->debug("$param ($type): $content{$param}\n");
+ }
+
+ # dealing with default values
+ # they are more or less assumed by the Pise system, so it's better to
+ # fill them
+ foreach my $param ($application->parameters_order) {
+ $type = $application->param_type($param) ;
+ if (! defined $self->{ARGS}{$param}) {
+ $vdef = $application->vdef($param) ;
+ if ($vdef && $vdef ne "\"\"") {
+ if ($type eq "Switch") {
+ push (@content, $param => "on");
+ } elsif ($type eq "List") {
+ foreach my $v (@{ $vdef }) {
+ push (@content, $param => $v);
+ }
+ } else {
+ $self->debug("_submit(2): setting $param to vdef $vdef\n");
+ push (@content, $param => $vdef);
+ }
+ }
+ }
+ }
+
+ if ($self->{DEBUG}) {
+ my $i;
+ for ($i=0; $i <= scalar(@content); $i++) {
+ $self->debug("PiseJob _submit(3): $content[$i]\n");
+ }
+ }
+
+ $self->debug(ref($self), "::_submit: submitting request ($location)...\n");
+
+ my $ua = $self->_get_ua;
+
+ my $res = $ua->request(POST $location,
+ Content_Type => 'form-data',
+ Content => \@content);
+
+ foreach my $tmpfile (@{ $self->{TMPFILES}} ) {
+ $self->debug("removing $tmpfile\n");
+ unlink $tmpfile;
+ }
+
+ if ($res->is_success) {
+# if ($self->{DEBUG}) {
+# $self->debug("submit:\n", $res->content);
+# }
+ $self->{RESULTS} = $res->content;
+ if ($self->_parse($res->content) >= 0) {
+ return $self->jobid;
+ } else {
+ $self->debug(ref($self) . " _submit: parse error, result content: " . $res->content,"\n");
+ return $self->jobid;
+ }
+ } else {
+ $self->{ERROR} = 1;
+ $self->{ERROR_MESSAGE} = ref($self) . " _submit: " . $res->message;
+ $self->{TERMINATED} = 1;
+ return -1;
+ }
+}
+
+=head2 _parse
+
+ Title : _parse()
+ Usage : $self->_parse();
+ Function: Internal. Parses Pise XHTML results page and fills data structures.
+ Called by frmoUrl or by _submit.
+ Example :
+ Returns :
+
+=cut
+
+sub _parse {
+ my $self = shift;
+ my $content;
+ if (@_) {
+ $content = shift;
+ } elsif (defined $self->{RESULTS}) {
+ $content = $self->{RESULTS};
+ } else {
+ $self->debug("parse: you must provide the REMOTE results page\n");
+ return -1;
+ }
+ my $handler;
+ if ($self->{VERBOSE}) {
+ $handler = Bio::Tools::Run::PiseJobParser->new(1);
+ } else {
+ $handler = Bio::Tools::Run::PiseJobParser->new;
+ }
+ my $parser = XML::Parser::PerlSAX->new (Handler => $handler);
+ $self->{PARSER} = $parser;
+ $content = $self->_clean_content($content);
+
+ eval {$parser->parse($content)};
+
+ if ($@) {
+ $self->debug("parse: cannot parse this job:\n$@\n");
+ $self->debug("$content\n");
+ return -1;
+ } else {
+ if (! $self->{JOBID}) {
+ $self->{JOBID} = $handler->bioweb_result;
+ }
+ $self->{SCRATCH_DIR} = $handler->scratch_dir;
+ my @results_files = $handler->hrefs;
+ $self->{RESULT_FILES} = [@results_files];
+ foreach my $result (@results_files) {
+ $self->{PIPED_FILE_TYPE}{$result} = $handler->piped_file_type($result);
+ }
+ my %pipes = $handler->pipes;
+ if ( %pipes) {
+ foreach my $f (keys %pipes) {
+ if (defined $pipes{$f}) {
+ my @p = @{ $pipes{$f} };
+ foreach my $p (@p) {
+ push (@{$self->{PIPES}{$f}}, $p);
+ }
+ }
+ }
+ }
+
+ # parameters hidden values
+ ;
+ foreach my $param (keys %{ $handler->{value}}) {
+ $self->{VALUE}{$param} = $handler->{value}{$param};
+ #$self->debug("DEBUG> Bio::Tools::Run::PiseJob _parse: $param => ", $self->{VALUE}{$param}, "\n");
+ }
+
+ $self->{TERMINATED} = $handler->terminated;
+ if ($handler->error) {
+ $self->{ERROR} = $handler->error;
+ $self->{ERROR_MESSAGE} = $handler->error_message;
+ $self->debug(ref($self) . " _parse: an error has occured (", $self->{PROGRAM}, ") : ",$handler->error_message, "\n");
+ return -1;
+ }
+ }
+
+}
+
+sub _get_ua {
+ my $self = shift;
+ my $ua;
+ if (defined $self->{UA}) {
+ $ua = $self->{UA};
+ } else {
+ $ua = LWP::UserAgent->new;
+ $ua->agent("Pise/" . $self->{VERSION} . "/" . $ua->agent);
+ $self->{UA} = $ua;
+ }
+ return $ua;
+}
+
+=head2 READLINE
+
+ Title : READLINE()
+ Usage :
+ Function: Internal - see perltie.
+ Example :
+ Returns : A string.
+
+=cut
+
+sub READLINE {
+ my $self = shift;
+ if (scalar(@{ $self->{pisejob}->{FH_DATA} }) > 0) {
+ my $line = shift @{ $self->{pisejob}->{FH_DATA} };
+ return "$line\n";
+ } else {
+ return;
+ }
+}
+
+=head2 TIEHANDLE
+
+ Title : TIEHANDLE()
+ Usage :
+ Function: Internal - see perltie.
+ Example :
+ Returns :
+
+=cut
+
+sub TIEHANDLE {
+ my $class = shift;
+ return bless {pisejob => shift}, $class;
+}
+
+=head2 CLOSE()
+
+ Title : CLOSE()
+ Usage :
+ Function: Internal - see perltie.
+ Example :
+ Returns :
+
+=cut
+
+# Note: this partly fixes Bug 2126
+sub CLOSE {
+ my $self = shift;
+ my $fh = $self->fh;
+ return if (!$fh || \*STDOUT == $fh || \*STDERR == $fh || \$STDIN == $fh);
+ close $fh;
+}
+
+=head2 _clean_content
+
+ Title : _clean_content()
+ Usage : my $content = $self->_clean_content($content);
+ Function: Internal. Useful to call before XML parsing.
+ Example :
+ Returns :
+
+=cut
+
+sub _clean_content {
+ my $self = shift;
+ my $content = shift;
+
+ $content =~ s/\&/\&amp;/g;
+# $content =~ s/</&lt;/g;
+# $content =~ s/>/&gt;/g;
+ my $title;
+ my $head = '';
+ my $foot;
+# if ($content !~ /<\?xml/) {
+# $head = "<?xml version=\"1.0\" encoding=\"iso-8859-1\"?>\n";
+# }
+ if ($content !~ /DOCTYPE/) {
+ $head .= "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\"
+ \"http://www.w3.org/TR/xhtml1/DTD/strict.dtd\">\n";
+ }
+ if ($content !~ /<html>/i) {
+ if (defined $self->{APPLICATION}) {
+ my $application = $self->{APPLICATION};
+ $title = $application->title;
+ } else {
+ $title = "unknown title";
+ }
+ $head .= "<HTML>
+<HEAD><TITLE>$title</TITLE><h1>$title</h1>
+</HEAD>
+<BODY>
+";
+ }
+ $content = $head . $content;
+
+ if ($content !~ /<\/html>/i) {
+ $foot = "
+</BODY></HTML>
+";
+ $content = $content . $foot;
+ }
+# $self->debug("clean_content:\n",$content\n");
+
+ return $content;
+
+}
+
+1;
280 Bio/Tools/Run/PiseJobParser.pm
@@ -0,0 +1,280 @@
+# $Id$
+#
+# Cared for by Catherine Letondal <letondal@pasteur.fr>
+#
+# For copyright and disclaimer see below.
+#
+# POD documentation - main docs before the code
+
+=head1 NAME
+
+Bio::Tools::Run::PiseJobParser - A class to parse a Pise server XHTML output.
+
+=head1 SYNOPSIS
+
+ #
+
+=head1 DESCRIPTION
+
+ Parsing of Pise XHTML output to extract results files and piping menus.
+
+=head1 FEEDBACK
+
+=head2 Mailing Lists
+
+User feedback is an integral part of the evolution of this and other
+Bioperl modules. Send your comments and suggestions preferably to
+the Bioperl mailing list. Your participation is much appreciated.
+
+ bioperl-l@bioperl.org - General discussion
+ http://bioperl.org/wiki/Mailing_lists - About the mailing lists
+
+=head2 Reporting Bugs
+
+Report bugs to the Bioperl bug tracking system to help us keep track
+of the bugs and their resolution. Bug reports can be submitted via the
+web:
+
+ http://bugzilla.open-bio.org/
+
+=head1 AUTHOR
+
+Catherine Letondal (letondal@pasteur.fr)
+
+=head1 COPYRIGHT
+
+Copyright (C) 2003 Institut Pasteur & Catherine Letondal.
+All Rights Reserved.
+
+This module is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=head1 DISCLAIMER
+
+This software is provided "as is" without warranty of any kind.
+
+=head1 SEE ALSO
+
+Bio::Tools::Run::PiseJob
+Bio::Tools::Run::AnalysisFactory::Pise
+Bio::Tools::Run::PiseApplication
+
+=cut
+
+#'
+
+package Bio::Tools::Run::PiseJobParser;
+
+use vars qw(@ISA);
+use strict;
+use Bio::Root::Root;
+
+@ISA = qw(Bio::Root::Root);
+
+sub new {
+ my ($class, $verbose) = @_;
+ my $self = $class->SUPER::new();
+ if ($verbose) {
+ $self->{VERBOSE} = $verbose;
+ } else {
+ $self->{VERBOSE} = 0;
+ }
+
+ $self->{DEBUG} = 0;
+
+ return $self;
+}
+
+sub characters {
+ my ($self, $element) = @_;
+ chomp ($element->{Data});
+ print STDERR $element->{Data} if ($self->{DEBUG});
+ if ($element->{Data} =~ /Results not available yet/) {
+ $self->{terminated} = 0;
+ }
+ if ($element->{Data} =~ /Results:/) {
+ $self->{output_files} = 1;
+ $self->{terminated} = 1;
+ }
+ if ($element->{Data} =~ /Warning:/) {
+ $self->{warning} = 1;
+ }
+ if ($element->{Data} =~ /this files will remain accessible for/) {
+ $self->{output_files} = 0;
+ $self->{result_url} = 1;
+ }
+ if ($element->{Data} =~ /You can save them individually/) {
+ $self->{result_url} = 0;
+ }
+ if ($element->{Data} =~ /upon completion of the job/) {
+ print STDERR "job detached\n" if $self->{DEBUG};
+ $self->{result_url} = 1;
+ }
+ if ($element->{Data} =~ /Please wait for the results of this query before submitting/) {
+ $self->{result_url} = 0;
+ }
+ if ($self->{check_message}) {
+ $self->{error_message} .= $element->{Data};
+ }
+}
+
+sub comment {
+ my ($self, $element) = @_;
+ if ($element->{Data} =~ /USER ERROR/) {
+ $self->{error} = 1;
+ }
+}
+
+sub start_element {
+ my ($self, $element) = @_;
+ print STDERR "\nstart element: ",$element->{Name},"\n" if ($self->{DEBUG});
+
+ my %attributes = %{ $element->{Attributes} };
+ foreach my $attr (keys %attributes) {
+ print STDERR "\t$attr $attributes{$attr}\n" if ($self->{DEBUG});
+ }
+ if ($element->{Name} eq "HTML") {
+ #$self->{terminated} = 1;
+ $self->{terminated} = 0;
+ $self->{error} = 0;
+ $self->{error_message} = "";
+ $self->{warning} = 0;
+ $self->{hrefs} = [];
+ } elsif ($element->{Name} eq "A") {
+ $self->{href} = $attributes{HREF};
+ # so nothing could work for Pise installation where Pise is in the
+ # url... :-(
+ #if ($PiseJobParser::href !~ /Pise/ && $PiseJobParser::href ne "" && $PiseJobParser::output_files) {
+ if (defined $self->{href} &&
+ $self->{href} ne "") {
+ if ($self->{output_files}) {
+ push (@{$self->{hrefs}}, $self->{href} );
+ print STDERR "Bio::Tools::Run::PiseJobParser: href=",$self->{href} ,"\n" if ($self->{DEBUG});
+ } elsif ($self->{result_url}) {
+ if (! $self->{bioweb_result}) {
+ $self->{bioweb_result} = $self->{href};
+ }
+ }
+ }
+ } elsif ($element->{Name} eq "H3") {
+ if ($self->{error}) {
+ $self->{check_message} = 1;
+ }
+ } elsif ($element->{Name} eq "FORM") {
+ my $action = $attributes{action};
+ if ($action =~ /connect.pl/) {
+ $self->{connected}{$self->{href}} = 1;
+ print STDERR "\t",$self->{href}, " is connected to...\n" if ($self->{DEBUG});
+ } elsif ($action =~ /results.pl/) {
+ $self->{terminated} = 0;
+ }
+ } elsif ($element->{Name} eq "INPUT") {
+ my $name =$attributes{NAME} || '';
+ my $value=$attributes{VALUE} || '';
+ if( defined $name && defined $value ) {
+ if ($name eq "scratch_dir") {
+ $self->{scratch_dir} = $value;
+ } else {
+ $self->{value}{$name} = $value;
+ }
+ }
+ if ($self->{connected}{$self->{href}}) {
+ if ($name eq "piped_file_type") {
+ print STDERR "DEBUG> ",$self->{href}," = $value\n" if ($self->{DEBUG});
+ $self->{piped_file_type}{$self->{href}} = $value;
+ }
+ }
+ } elsif ($element->{Name} eq "OPTION") {
+ my $option=1;
+ my $value=$attributes{VALUE};
+ my $command;
+ my @with_piped_files;
+ my $with_href;
+ my $root_url;
+ my $with_param;
+ my $with_value;
+ ($command,@with_piped_files) = split(",",$value);
+ if ($self->{connected}{$self->{href}}) {
+ push (@{$self->{pipes}{$self->{href}}}, $command);
+
+ #print STDERR "pipes:\n";
+ #foreach my $f (keys %{$self->{pipes}}) {
+ #my @p = @{ $self->{pipes}{$f} };
+ #foreach my $p (@p) {
+ # print STDERR "\tf: $f\tp: $p\n";
+ #}
+ #}
+
+ ($root_url = $self->{href}) =~ s/(.+)\/.+/$1/;
+ foreach my $with_file (@with_piped_files) {
+ ($with_param,$with_value) = split("=",$with_file);
+ my $with_href = "$root_url/$with_value" ;
+ push @{ $self->{with_href}{$self->{href}} }, $with_href;
+ if ( ! (grep {$command eq $_ } @{$self->{pipes}{$with_href}}) ) {
+ push (@{$self->{pipes}{$with_href}},$command);
+ $self->{piped_file_type}{$with_href} = $with_param;
+ }
+ }
+ print STDERR "\t\t",$self->{href}," is connected to $value\n" if ($self->{DEBUG});
+ }
+ }
+
+}
+
+sub end_element {
+ my ($self, $element) = @_;
+ print STDERR "\nend element: ",$element->{Name},"\n" if ($self->{DEBUG});
+ if ($element->{Name} eq "H3") {
+ if ($self->{error}) {
+ $self->{check_message}=0;
+ }
+ } elsif ($element->{Name} eq "HR" && $self->{warning}) {
+ $self->{warning} = 0;
+ }
+}
+
+sub pipes {
+ my $self = shift;
+ if (defined $self->{pipes}) {
+ return %{$self->{pipes}};
+ }
+ return ();
+}
+
+sub piped_file_type {
+ my $self = shift;
+ my $href = shift;
+ return $self->{piped_file_type}{$href};
+}
+
+sub bioweb_result {
+ my $self = shift;
+ return $self->{bioweb_result};
+}
+
+sub scratch_dir {
+ my $self = shift;
+ return $self->{scratch_dir};
+}
+
+sub hrefs {
+ my $self = shift;
+ return @{ $self->{hrefs} };
+}
+
+sub terminated {
+ my $self = shift;
+ return $self->{terminated};
+}
+
+sub error {
+ my $self = shift;
+ return $self->{error};
+}
+
+sub error_message {
+ my $self = shift;
+ return $self->{error_message};
+}
+
+1;
488 Bio/Tools/Run/PiseWorkflow.pm
@@ -0,0 +1,488 @@
+# $Id$
+#
+# Cared for by S. Thoraval <s.thoraval@imb.uq.edu.au>
+#
+# POD documentation - main docs before the code
+
+=head1 NAME
+
+Bio::Tools::Run::PiseWorkflow
+
+=head1 SYNOPSIS
+
+ # First, create a Bio::Tools::Run::AnalysisFactory::Pise object:
+ my $factory = Bio::Tools::Run::AnalysisFactory::Pise->new();
+ # Then create the application objects (Pise::Run::Tools::PiseApplication):
+ my $clustalw = $factory->program('clustalw');
+ $clustalw->infile($my_alignment_file);
+ my $protpars = $factory->program('protpars');
+
+ # You can specify different servers for different applications :
+ my $protdist = $factory->program('protpars'
+ -remote => 'http://kun.homelinux.com/cgi-bin/Pise/5.a//protpars.pl',
+ -email => 'your_email');
+
+ # Create a new workflow object :
+ my $workflow = Bio::Tools::Run::PiseWorkflow->new();
+
+ # Define the workflow's methods using the application objects:
+ # the application method $protpars will receive the output of
+ # type 'readseq_ok_alig' from the application method $clustalw.
+ $workflow->addpipe(-method => $clustalw,
+ -tomethod => $protpars,
+ -pipetype => 'readseq_ok_alig');
+
+ # The application method $clustalw will be piped to a second
+ # application method ($protdist) using the output of type 'readseq_ok_alig'.
+ $workflow->addpipe(-method => $clustalw,
+ -tomethod => $protdist,
+ -pipetype => 'readseq_ok_alig');
+
+ # The application method $protpars will be piped to the application
+ # method $consense using the output of type 'phylip_tree'.
+ my $consense = $factory->program('consense');
+ $workflow->addpipe(-method => $protpars,
+ -tomethod => $consense,
+ -pipetype => 'phylip_tree');
+
+ # Run the workflow.
+ $workflow->run();
+
+
+=head1 DESCRIPTION
+
+A class to create a Pise workflow using Pise application objects as methods.
+A workflow is defined by a set of methods which all instanciate the
+class PiseApplication.
+
+Create the workflow object :
+
+ my $workflow = Bio::Tools::Run::PiseWorkflow->new();
+
+You can specify which application will be used as the first method at
+creation of the workflow object: (by default, this first
+method will be the one specified by the option -method at the
+First call of the function addpipe().
+
+ my $workflow = Bio::Tools::Run::PiseWorkflow->new($clustalw);
+
+Use the function addpipe to define the workflow :
+
+ $workflow->addpipe(-method => $clustalw,
+ -tomethod => $protpars,
+ -pipetype => 'readseq_ok_alig');
+
+One method may be piped to different methods in the workflow:
+
+ $workflow->addpipe(-method => $clustalw,
+ -tomethod => $protdist,
+ -pipetype => 'readseq_ok_alig');
+
+To run the workflow (processes will be forked when possible):
+
+ $workflow->run();
+
+An html temporary file summarising the jobs status will be created in
+the working directory. The html output file can also be specified:
+
+ $workflow->run(-html => 'jobs.html');
+
+
+
+=cut
+
+# Let the code begin...
+
+package Bio::Tools::Run::PiseWorkflow;
+
+use vars qw(@ISA);
+use strict;
+use Bio::Root::Root;
+use Bio::Tools::Run::PiseApplication;
+use Bio::Tools::Run::PiseJob;
+use Data::Dumper;
+use CGI;
+use File::Temp qw/ tempfile /;
+use Fcntl qw(:DEFAULT :flock);
+use Bio::Root::Version;
+
+@ISA = qw(Bio::Root::Root);
+my %pids;
+
+our $VERSION = ${Bio::Root::Version::VERSION};
+
+=head2 new
+
+ Title : new()
+ Usage : my $workflow = Bio::Tools::Run::PiseWorkflow->new();
+ Function: Creates a Bio::Tools::Run::PiseWorkflow object.
+ Example : my $workflow = Bio::Tools::Run::PiseWorkflow->new();
+ Returns : An instance of Bio::Tools::Run::PiseWorkflow.
+
+=cut
+
+sub new {
+ my ($class,@args) = @_;
+ my $self = $class->SUPER::new(@args);
+ my ($method, $verbose) = $self->_rearrange([qw(METHOD VERBOSE)], @args);
+ if (defined $verbose) {
+ $self->{VERBOSE} = $verbose;
+ } else {
+ $self->{VERBOSE} = 0;
+ }
+ if (defined $method) {
+ $self->{'PIPEDEF'}[0]{'method'} = $method;
+ }
+ return $self;
+}
+
+=head2 addpipe
+
+ Title : addpipe()
+ Usage : $workflow = Bio::Tools::Run::PiseWorkflow->addpipe(
+ -method => $clustalw,