Bio/Tools/Analysis/SimpleAnalysisBase.pm

   1 #
   2 # BioPerl module for Bio::Tools::Analysis::SimpleAnalysisBase
   3 #
   4 # Please direct questions and support issues to <bioperl-l@bioperl.org>
   5 #
   6 # Cared for by Heikki Lehvaslaiho <heikki-at-bioperl-dot-org>
   7 #
   8 # Copyright Richard Adams
   9 #
  10 # You may distribute this module under the same terms as perl itself
  11
  12 # POD documentation - main docs before the code
  13
  14 =head1 NAME
  15
  16 Bio::Tools::Analysis::SimpleAnalysisBase - abstract superclass for
  17 SimpleAnalysis implementations
  18
  19 =head1 SYNOPSIS
  20
  21 # not to be run directly
  22
  23 =head1 DESCRIPTION
  24
  25 This class is a generic implementation of SimpleAnalysisI and should
  26 be used as a base class for specific implementations.
  27
  28 Modules implementing SimpleAnalysisBase only need to provide specific
  29 _init(), _run() and result() methods, plus any get/set methods for
  30 parameters to the analysis program.
  31
  32 =head1 SEE ALSO
  33
  34 L<Bio::SimpleAnalysisI>,
  35 L<Bio::WebAgent>
  36
  37 =head1 FEEDBACK
  38
  39 =head2 Mailing Lists
  40
  41 User feedback is an integral part of the evolution of this and other
  42 Bioperl modules. Send your comments and suggestions preferably to one
  43 of the Bioperl mailing lists.  Your participation is much appreciated.
  44
  45   bioperl-l@bioperl.org                  - General discussion
  46   http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
  47
  48 =head2 Support
  49
  50 Please direct usage questions or support issues to the mailing list:
  51
  52 I<bioperl-l@bioperl.org>
  53
  54 rather than to the module maintainer directly. Many experienced and
  55 reponsive experts will be able look at the problem and quickly
  56 address it. Please include a thorough description of the problem
  57 with code and data examples if at all possible.
  58
  59 =head2 Reporting Bugs
  60
  61 Report bugs to the Bioperl bug tracking system to help us keep track
  62 the bugs and their resolution.  Bug reports can be submitted via the
  63 web:
  64
  65   https://github.com/bioperl/bioperl-live/issues
  66
  67 =head1 AUTHORS
  68
  69 Richard Adams, Richard.Adams@ed.ac.uk,
  70 Heikki Lehvaslaiho, heikki-at-bioperl-dot-org
  71
  72 =head1 APPENDIX
  73
  74 The rest of the documentation details each of the object
  75 methods. Internal methods are usually preceded with a _
  76
  77 =cut
  78
  79
  80 # Let the code begin...
  81
  82
  83 package Bio::Tools::Analysis::SimpleAnalysisBase;
  84
  85 use strict;
  86 use Data::Dumper;
  87
  88 my $FLOAT = '[+-]?\d*\.\d*';
  89
  90 my %STATUS =  map { $_ => 1 } qw(CREATED COMPLETED TERMINATED_BY_ERROR);
  91
  92 use base qw(Bio::WebAgent Bio::SimpleAnalysisI);
  93
  94 =head2 new
  95
  96  Usage   : $job->new(...)
  97  Returns : a new analysis object,
  98  Args    : none (but an implementation may choose
  99            to add arguments representing parameters for the analysis
 100            program. Each key value of must have a method implemented
 101            for it in a subclass. A seq () method is provided here as
 102            this will probably be needed by all sequence analysis programs
 103
 104 =cut
 105
 106 sub new {
 107     my $class = shift;
 108
 109     my $self = $class->SUPER::new(); #WebAgent new
 110     $self->_init; #this line has to be before the attributes are filled in
 111     while ( @_ ) {
 112         my $key = lc shift;
 113         $key =~ s/^-//;
 114         $self->$key(shift);
 115     }
 116     return $self;
 117 }
 118
 119 =head2 seq
 120
 121  Usage   : $job->seq()
 122  Returns : a Bio::PrimarySeqI implementing sequence object, or void
 123  Args    : None, or a Bio::PrimarySeqI implementing object
 124
 125 =cut
 126
 127 sub seq {
 128     my ($self,$value) = @_;
 129     if ( defined $value) {
 130         $self->throw("I need a Bio::PrimarySeqI, not  [". $value. "]")
 131             unless $value->isa('Bio::PrimarySeqI');
 132                 $self->throw(" I need a PrimarySeq object, not a BioSeq object ")
 133                         if $value->isa('Bio::SeqI');
 134
 135         my $mol_type = $self->analysis_spec->{'type'};
 136         $self->throw("I need a [" . $mol_type . "]  seq, not a  [". $value->alphabet. "]")
 137             unless $value->alphabet =~/$mol_type/i;
 138         $self->{'_seq'} = $value;
 139         return $self;
 140     }
 141     return $self->{'_seq'} ;
 142 }
 143
 144 =head2  analysis_name
 145
 146     Usage     : $analysis->analysis_name();
 147     Returns   : The analysis name
 148     Arguments : none
 149
 150 =cut
 151
 152 sub analysis_name {
 153     my $self = shift;
 154     return $self->{'_ANALYSIS_NAME'};
 155 }
 156
 157 =head2  analysis_spec
 158
 159     Usage    :  $analysis->analysis_spec();
 160     Returns  :  a hash reference to  a hash of analysis parameters. See
 161                 Bio::SimpleAnalysisI for a list of recommended key values.
 162     Arguments:  none
 163
 164 =cut
 165
 166 sub analysis_spec {
 167     my $self = shift;
 168     return $self->{'_ANALYSIS_SPEC'};
 169 }
 170
 171 =head2 clear
 172
 173     Usage     : $analysis->clear();
 174     Returns   : true value on success
 175     Arguments : none
 176     Purpose   : to remove raw results from a previous analysis so that
 177                 an analysis can be repeated with different parameters.
 178
 179 =cut
 180
 181 sub clear {
 182         my $self= shift;
 183         if (defined($self->{'_result'})) {
 184                 delete $self->{'_result'};
 185                 }
 186         if (defined ($self->{'_parsed'})) {
 187                 delete $self->{'_parsed'};
 188                 }
 189         return 1;
 190 }
 191
 192
 193
 194 =head2  input_spec
 195
 196     Usage     : $analysis->input_spec();
 197     Returns   : a  reference to  an array of  hashes of analysis parameters. See
 198                 Bio::SimpleAnalysisI for a list of recommended key values.
 199     Arguments : none
 200
 201 =cut
 202
 203 sub input_spec {
 204     my $self = shift;
 205     return $self->{'_INPUT_SPEC'};
 206 }
 207
 208 =head2  result_spec
 209
 210     Usage     : $analysis->result_spec();
 211     Returns   : a  reference to  a   hashes of resultformats. See
 212                 Bio::SimpleAnalysisI for a list of recommended key values.
 213                 The key values can be used as parameters to the result()
 214                 method, the values provide descriptions.
 215     Arguments : none
 216
 217 =cut
 218
 219 sub result_spec {
 220     my $self = shift;
 221     return $self->{'_RESULT_SPEC'};
 222 }
 223
 224 sub run {
 225     my ($self, $args) = @_;
 226     $self->_process_arguments ($args) if $args;
 227
 228     # check input
 229     $self->throw("Need a sequence object as an input") unless $self->seq;
 230     $self->debug(Data::Dumper->Dump([$self],[$self]));
 231
 232     # internal run()
 233     $self->_run;
 234     return $self;
 235 }
 236
 237 sub wait_for {
 238     my ($self, $args) = @_;
 239     $self->run($args);
 240 }
 241
 242 sub status {
 243     my ($self,$value) = @_;
 244
 245     if( defined $value) {
 246         no strict 'refs';
 247         my $class = ref($self);
 248         $self->throw("Not a valid status value [$value]\n".
 249                      "Valid values are ". join(", ", keys %STATUS ))
 250             unless defined $STATUS{$value};
 251         $self->{'_status'} = $value;
 252         use strict;
 253     }
 254     return $self->{'_status'} || 'CREATED' ;
 255 }
 256
 257 sub _process_arguments {
 258     my ($self, $args) = @_;
 259
 260     my %spec;
 261     map {$spec{ $_->{'name'} } = $_ } @{$self->input_spec};
 262
 263     $self->debug(Data::Dumper->Dump([\%spec, $args],[\%spec, $args]));
 264     foreach my $key (keys %$args) {
 265         my $value = $args->{$key};
 266
 267         $self->throw("Unknown argument [$key]")
 268             unless $spec{$key};
 269         $self->$key($value);
 270     }
 271
 272     foreach my $key (keys %spec) {
 273         $self->throw("Mandatory argument [$key] is not set")
 274             if $spec{$key}{'mandatory'} eq 'true' and not defined $self->$key;
 275     }
 276 }
 277
 278
 279 sub _run { shift->throw_not_implemented();}
 280
 281 1;