1#
2# BioPerl module for Bio::Tools::Run::Phylo::SLR
3#
4# Please direct questions and support issues to <bioperl-l@bioperl.org>
5#
6# Cared for by Albert Vilella <avilella-at-gmail-dot-com>
7#
8# Copyright Albert Vilella
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
16Bio::Tools::Run::Phylo::SLR - Wrapper around the SLR program
17
18=head1 SYNOPSIS
19
20  use Bio::Tools::Run::Phylo::SLR;
21  use Bio::AlignIO;
22  use Bio::TreeIO;
23  use Bio::SimpleAlign;
24
25  my $alignio = Bio::AlignIO->new
26      (-format => 'fasta',
27       -file   => 't/data/219877.cdna.fasta');
28
29  my $aln = $alignio->next_aln;
30
31  my $treeio = Bio::TreeIO->new
32      (-format => 'newick', -file => 't/data/219877.tree');
33
34  my $tree = $treeio->next_tree;
35
36  my $slr = Bio::Tools::Run::Phylo::SLR->new();
37  $slr->alignment($aln);
38  $slr->tree($tree);
39  # $rc = 1 for success, 0 for errors
40  my ($rc,$results) = $slr->run();
41
42  my $positive_sites = $results->{'positive'};
43
44  print "# Site\tNeutral\tOptimal\tOmega\t",
45        "lower\tupper\tLRT_Stat\tPval\tAdj.Pval\tResult\tNote\n";
46  foreach my $positive_site (@$positive_sites) {
47      print
48          $positive_site->[0], "\t",
49          $positive_site->[1], "\t",
50          $positive_site->[2], "\t",
51          $positive_site->[3], "\t",
52          $positive_site->[4], "\t",
53          $positive_site->[5], "\t",
54          $positive_site->[6], "\t",
55          $positive_site->[7], "\t",
56          $positive_site->[8], "\t",
57          "positive\n";
58  }
59
60=head1 DESCRIPTION
61
62This is a wrapper around the SLR program. See
63http://www.ebi.ac.uk/goldman/SLR/ for more information.
64
65This module is more about generating the proper ctl file and
66will run the program in a separate temporary directory to avoid
67creating temp files all over the place.
68
69=head1 FEEDBACK
70
71=head2 Mailing Lists
72
73User feedback is an integral part of the evolution of this and other
74Bioperl modules. Send your comments and suggestions preferably to
75the Bioperl mailing list.  Your participation is much appreciated.
76
77  bioperl-l@bioperl.org                  - General discussion
78  http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
79
80=head2 Support
81
82Please direct usage questions or support issues to the mailing list:
83
84I<bioperl-l@bioperl.org>
85
86rather than to the module maintainer directly. Many experienced and
87reponsive experts will be able look at the problem and quickly
88address it. Please include a thorough description of the problem
89with code and data examples if at all possible.
90
91=head2 Reporting Bugs
92
93Report bugs to the Bioperl bug tracking system to help us keep track
94of the bugs and their resolution. Bug reports can be submitted via the
95web:
96
97  http://redmine.open-bio.org/projects/bioperl/
98
99=head1 AUTHOR - Albert Vilella
100
101Email avilella-at-gmail-dot-com
102
103=head1 CONTRIBUTORS
104
105Additional contributors names and emails here
106
107=head1 APPENDIX
108
109The rest of the documentation details each of the object methods.
110Internal methods are usually preceded with a _
111
112=cut
113
114
115#' keep my emacs happy
116# Let the code begin...
117
118
119package Bio::Tools::Run::Phylo::SLR;
120use vars qw(@ISA %VALIDVALUES $MINNAMELEN $PROGRAMNAME $PROGRAM);
121use strict;
122use Bio::Root::Root;
123use Bio::AlignIO;
124use Bio::TreeIO;
125use Bio::SimpleAlign;
126use Bio::Tools::Run::WrapperBase;
127use Cwd;
128use File::Spec;
129
130@ISA = qw(Bio::Root::Root Bio::Tools::Run::WrapperBase);
131
132=head2 Default Values
133
134INCOMPLETE DOCUMENTATION OF ALL METHODS
135
136seqfile [incodon]
137  File from which to read alignment of codon sequences. The file
138  should be in PAML format.
139
140treefile [intree]
141  File from which tree should be read. The tree should be in Nexus
142  format
143
144outfile [slr.res]
145  File to which results are written. If the file already exists, it will
146  be overwritten.
147
148reoptimise [1]
149  Should the branch lengths, omega and kappa be reoptimized?
150  0 - no
151  1 - yes.
152
153kappa [2.0]
154  Value for kappa. If 'reoptimise' is specified, the value
155  given will be used as am initial estimate,
156
157omega [0.1]
158  Value for omega (dN/dS). If 'reoptimise' is specified, the value
159  given will be used as an initial estimate.
160
161codonf [0]
162  How codon frequencies are estimated:
163    0: F61/F60  Estimates used are the empirical frequencies from the
164  data.
165    1: F3x4     The frequencies of nucleotides at each codon position
166  are estimated from the data and then multiplied together to get the
167  frequency of observing a given codon. The frequency of stop codons is
168  set to zero, and all other frequencies scaled appropriately.
169    2: F1x4     Nucleotide frequencies are estimated from the data
170  (not taking into account at which position in the codon it occurs).
171  The nucleotide frequencies are multiplied together to get the frequency
172  of observing and then corrected for stop codons.
173
174freqtype [0]
175  How codon frequencies are incorporated into the substitution matrix.
176  0: q_{ij} = pi_{j} s_{ij}
177  1: q_{ij} = \sqrt(pi_j/pi_i) s_{ij}
178  2: q_{ij} = \pi_{n} s_{ij}, where n is the nucleotide that the
179  subsitution is to.
180  3: q_{ij} = s_{ij} / pi_i
181  Option 0 is the tradition method of incorporating equilibrium frequencies
182  into subsitution matrices (Felsenstein 1981; Goldman and Yang, 1994)
183  Option 1 is described by Goldman and Whelan (2002), in this case with the
184  additional parameter set to 0.5.
185  Option 2 was suggested by Muse and Gaut (1994).
186  Option 3 is included as an experiment, originally suggested by Bret Larget.
187  it does not appear to describe evolution very successfully and should not
188  be used for analyses.
189
190  Kosakovsky-Pond has repeatedly stated that he finds incorporating codon
191  frequencies in the manner of option 2 to be superior to option 0. We find
192  that option 1 tends to perform better than either of these options.
193
194positive_only [0]
195  If only positively selected sites are of interest, set this to "1".
196  Calculation will be slightly faster, but information about sites under
197  purifying selection is lost.
198
199gencode [universal]
200  Which genetic code to use when determining whether a given mutation
201  is synonymous or nonsynonymous. Currently only "universal" and
202  "mammalian" mitochondrial are supported.
203
204nucleof [0]
205  Allow for empirical exchangabilities for nucleotide substitution.
206  0: No adjustment. All nucleotides treated the same, modulo
207  transition / transversion.
208  1: The rate at which a substitution caused a mutation from nucleotide
209  a to nucleotide b is adjust by a constant N_{ab}. This adjustment is
210  in addition to other adjustments (e.g. transition / transversion or
211  base frequencies).
212
213aminof [0]
214  Incorporate amino acid similarity parameters into substitution matrix,
215  adjusting omega for a change between amino acid i and amino acid j.
216  A_{ij} is a symmetric matrix of constants representing amino acid
217  similarities.
218  0: Constant omega for all amino acid changes
219  1: omega_{ij} = omega^{A_{ij}}
220  2: omega_{ij} = a_{ij} log(omega) / [ 1 - exp(-a_{ij} log(omega)) ]
221  Option 1 has the same form as the original codon subsitution model
222  proposed by Goldman and Yang (but with potentially different
223  constants).
224  Option 2 has a more population genetic derivtion, with omega being
225  interpreted as the ratio of fixation probabilities.
226
227nucfile [nuc.dat]
228  If nucleof is non-zero, read nucleotide substitution constants from
229  nucfile. If this file does not exist, hard coded constants are used.
230
231aminofile [amino.dat]
232  If aminof is non-zero, read amino acid similarity constants from
233  aminofile. If this file does not exist, hard coded constants are used.
234
235timemem [0]
236  Print summary of real time and CPU time used. Will eventually print
237  summary of memory use as well.
238
239ldiff [3.841459]
240  Twice log-likelihood difference used as a threshold for calculating
241  support (confidence) intervals for sitewise omega estimates. This
242  value should be the quantile from a chi-square distribution with one
243  degree of freedom corresponding to the support required.
244  E.g. qchisq(0.95,1) = 3.841459
245     0.4549364 = 50% support
246     1.323304  = 75% support
247     2.705543  = 90% support
248     3.841459  = 95% support
249     6.634897  = 99% support
250     7.879439  = 99.5% support
251    10.82757   = 99.9% support
252
253paramin []
254  If not blank, read in parameters from file given by the argument.
255
256paramout []
257  If not blank, write out parameter estimates to file given.
258
259skipsitewise [0]
260  Skip sitewise estimation of omega. Depending on other options given,
261  either calculate maximum likelihood or likelihood fixed at parameter
262  values given.
263
264seed [0]
265  Seed for random number generator. If seed is 0, then previously
266  produced seed file (~/.rng64) is used. If this does not exist, the
267  random number generator is initialised using the clock.
268
269saveseed [1]
270  If non-zero, save finial seed in file (~/.rng64) to be used as initial
271  seed in future runs of program.
272
273=head2 Results Format
274
275Results file (default: slr.res)
276------------
277Results are presented in nine columns
278
279Site
280  Number of sites in alignment
281
282Neutral
283  (minus) Log-probability of observing site given that it was
284  evolving neutrally (omega=1)
285
286Optimal
287  (minus) Log-probability of observing site given that it was
288  evolving at the optimal value of omega.
289
290Omega
291  The value of omega which maximizes the log-probability of observing
292
293LRT_Stat
294  Log-likelihood ratio statistic for non-neutral selection (or
295  positive selection if the positive_only option is set to 1).
296  LRT_Stat = 2 * (Neutral-Optimal)
297
298Pval
299  P-value for non-neutral (or positive) selection at a site,
300  unadjusted for multiple comparisons.
301
302Adj. Pval
303  P-value for non-neutral (or positive) selection at a site, after
304  adjusting for multiple comparisons using the Hochberg procedure
305  (see the file "MultipleComparisons.txt" in the doc directory).
306
307Result
308  A simple visual guide to the result. Sites detected as having been
309  under positive selection are marked with a '+', sites under
310  purifying selection are marked with '-'. The number of symbols
311    Number symbols      Threshold
312          1             95%
313          2             99%
314          3             95% after adjustment
315          4             99% after adjustment
316
317  Occasionally the result may also contain an exclamation mark. This
318  indicates that the observation at a site is not significantly
319  different from random (equivalent to infinitely strong positive
320  selection). This may indicate that the alignment at that site is bad
321
322Note
323
324  The following events are flagged:
325  Synonymous            All codons at a site code for the same amino
326                        acid.
327  Single character      Only one sequence at the site is ungapped,
328                        the result of a recent insertion for example.
329  All gaps              All sequences at a site contain a gap
330                        character.
331
332  Sites marked "Single character" or "All gaps" are not counted
333  towards the number of sites for the purposes of correcting for
334  multiple comparisons since it is not possible to detect selection
335  from none or one observation under the assumptions made by the
336  sitewise likelihood ratio test.
337
338=cut
339
340
341#' keep my emacs happy
342
343BEGIN {
344
345    $MINNAMELEN = 25;
346    $PROGRAMNAME = 'Slr_Linux_static';
347    if ($^O =~ /darwin/i) {
348        $PROGRAMNAME = 'Slr_osx';
349    } elsif ($^O =~ /mswin/i) {
350        $PROGRAMNAME = 'Slr_windows.exe';
351    }
352    if( defined $ENV{'SLRDIR'} ) {
353	$PROGRAM = Bio::Root::IO->catfile($ENV{'SLRDIR'},$PROGRAMNAME). ($^O =~ /mswin/i ?'_windows.exe':'');;
354    }
355
356    # valid values for parameters, the default one is always
357    # the first one in the array
358    # example file provided with the package
359    %VALIDVALUES = (
360                    'outfile' => 'slr.res',
361                    'reoptimise'   => [ 1,0],
362                    'kappa'    => '2.0',
363                    'omega'    => '0.1',
364                    'codonf' => [ 0, 1,2],
365                    'freqtype' => [ 0, 1,2,3],
366                    'positive_only' => [ 0, 1],
367                    'gencode' => [ "universal", "mammalian"],
368                    'nucleof' => [ 0, 1],
369                    'aminof' => [ 0, 1,2],
370                    'nucfile' => '',
371                    'aminofile' => '',
372                    'timemem' => [ 0, 1],
373                    'ldiff' => [ 3.841459, 0.4549364,1.323304,2.705543,6.634897,7.879439,10.82757],
374                    'paramin' => '',
375                    'paramout' => '',
376                    'skipsitewise' => [ 0, 1],
377                    'seed' => [0],
378                    'saveseed' => [ 1, 0]
379                   );
380}
381
382=head2 program_name
383
384 Title   : program_name
385 Usage   : $factory->program_name()
386 Function: holds the program name
387 Returns:  string
388 Args    : None
389
390=cut
391
392sub program_name {
393        return $PROGRAMNAME;
394}
395
396=head2 program_dir
397
398 Title   : program_dir
399 Usage   : ->program_dir()
400 Function: returns the program directory, obtained from ENV variable.
401 Returns:  string
402 Args    :
403
404=cut
405
406sub program_dir {
407        return Bio::Root::IO->catfile($ENV{SLRDIR}) if $ENV{SLRDIR};
408}
409
410
411=head2 new
412
413 Title   : new
414 Usage   : my $obj = Bio::Tools::Run::Phylo::SLR->new();
415 Function: Builds a new Bio::Tools::Run::Phylo::SLR object
416 Returns : Bio::Tools::Run::Phylo::SLR
417 Args    : -alignment => the Bio::Align::AlignI object
418           -save_tempfiles => boolean to save the generated tempfiles and
419                              NOT cleanup after onesself (default FALSE)
420           -tree => the Bio::Tree::TreeI object
421           -params => a hashref of SLR parameters (all passed to set_parameter)
422           -executable => where the SLR executable resides
423
424See also: L<Bio::Tree::TreeI>, L<Bio::Align::AlignI>
425
426=cut
427
428sub new {
429  my($class,@args) = @_;
430
431  my $self = $class->SUPER::new(@args);
432  my ($aln, $tree, $st, $params, $exe,
433      $ubl) = $self->_rearrange([qw(ALIGNMENT TREE SAVE_TEMPFILES
434				    PARAMS EXECUTABLE)],
435				    @args);
436  defined $aln && $self->alignment($aln);
437  defined $tree && $self->tree($tree);
438  defined $st  && $self->save_tempfiles($st);
439  defined $exe && $self->executable($exe);
440
441  $self->set_default_parameters();
442  if( defined $params ) {
443      if( ref($params) !~ /HASH/i ) {
444	  $self->warn("Must provide a valid hash ref for parameter -FLAGS");
445      } else {
446	  map { $self->set_parameter($_, $$params{$_}) } keys %$params;
447      }
448  }
449  return $self;
450}
451
452
453=head2 prepare
454
455 Title   : prepare
456 Usage   : my $rundir = $slr->prepare($aln);
457 Function: prepare the SLR analysis using the default or updated parameters
458           the alignment parameter must have been set
459 Returns : value of rundir
460 Args    : L<Bio::Align::AlignI> object,
461	   L<Bio::Tree::TreeI> object
462
463=cut
464
465sub prepare{
466   my ($self,$aln,$tree) = @_;
467   unless ( $self->save_tempfiles ) {
468       # brush so we don't get plaque buildup ;)
469       $self->cleanup();
470   }
471   $tree = $self->tree unless $tree;
472   $aln  = $self->alignment unless $aln;
473   if( ! $aln ) {
474       $self->warn("must have supplied a valid alignment file in order to run SLR");
475       return 0;
476   }
477   if( ! $tree ) {
478       $self->warn("must have supplied a valid tree file in order to run SLR");
479       return 0;
480   }
481   my ($tempdir) = $self->tempdir();
482   my ($tempseqFH,$tempseqfile);
483
484   # Reorder the alignment according to the tree
485   my $ct = 1;
486   my %order;
487   foreach my $node ($tree->get_leaf_nodes) {
488       $order{$node->id_output} = $ct++;
489   }
490   my @seq; my @ids;
491   foreach my $seq ( $aln->each_seq() ) {
492       push @seq, $seq;
493       push @ids, $seq->display_id;
494   }
495   # use the map-sort-map idiom:
496   my @sorted = map { $_->[1] } sort { $a->[0] <=> $b->[0] } map { [$order{$_->id()}, $_] } @seq;
497   my $sorted_aln = Bio::SimpleAlign->new();
498   foreach (@sorted) {
499       $sorted_aln->add_seq($_);
500   }
501
502   # Rename the leaf nodes in the tree from 1 to n
503   $ct = 1;
504   foreach my $node ($tree->get_leaf_nodes) {
505       $node->id($ct++);
506   }
507
508   ($tempseqFH,$tempseqfile) = $self->io->tempfile
509       ('-dir' => $tempdir,
510        UNLINK => ($self->save_tempfiles ? 0 : 1));
511   my $alnout = Bio::AlignIO->new('-format'      => 'phylip',
512                                  '-fh'          => $tempseqFH,
513                                  '-interleaved' => 0,
514                                  '-idlinebreak' => 1,
515                                  '-idlength'    => $MINNAMELEN > $aln->maxdisplayname_length() ? $MINNAMELEN : $aln->maxdisplayname_length() +1);
516
517   $alnout->write_aln($sorted_aln);
518   $alnout->close();
519   undef $alnout;
520   close($tempseqFH);
521
522   my ($temptreeFH,$temptreefile);
523   ($temptreeFH,$temptreefile) = $self->io->tempfile
524       ('-dir' => $tempdir,
525        UNLINK => ($self->save_tempfiles ? 0 : 1));
526
527   my $treeout = Bio::TreeIO->new('-format' => 'newick',
528                                  '-fh'     => $temptreeFH);
529
530   # We need to add a line with the num of leaves ($ct-1) and the
531   # num of trees (1)
532   $treeout->_print(sprintf("%d 1\n",($ct-1)));
533   $treeout->write_tree($tree);
534   $treeout->close();
535   close($temptreeFH);
536
537   # now let's print the ctl file.
538   # many of the these programs are finicky about what the filename is
539   # and won't even run without the properly named file.
540
541   my ($treevolume,$treedirectories,$treefile) = File::Spec->splitpath( $temptreefile );
542   my ($alnvolume,$alndirectories,$alnfile) = File::Spec->splitpath( $tempseqfile );
543   my $slr_ctl = "$tempdir/slr.ctl";
544   open(SLR, ">$slr_ctl") or $self->throw("cannot open $slr_ctl for writing");
545   print SLR "seqfile\: $alnfile\n";
546   print SLR "treefile\: $treefile\n";
547   my $outfile = $self->outfile_name;
548   print SLR "outfile\: $outfile\n";
549
550   my %params = $self->get_parameters;
551   while( my ($param,$val) = each %params ) {
552       next if $param eq 'outfile';
553       print SLR "$param\: $val\n";
554   }
555   close(SLR);
556   return $tempdir;
557}
558
559
560
561=head2 run
562
563 Title   : run
564 Usage   : my ($rc,$parser) = $slr->run($aln,$tree);
565 Function: run the SLR analysis using the default or updated parameters
566           the alignment parameter must have been set
567 Returns : Return code, L<Bio::Tools::Phylo::SLR>
568 Args    : L<Bio::Align::AlignI> object,
569	   L<Bio::Tree::TreeI> object
570
571
572=cut
573
574sub run {
575   my ($self) = shift;;
576   my $outfile = $self->outfile_name;
577   my $tmpdir = $self->prepare(@_);
578
579   #my ($rc,$parser) = (1);
580   my ($rc,$results) = (1);
581   {
582       my $cwd = cwd();
583       my $exit_status;
584       chdir($tmpdir);
585       my $slrexe = $self->executable();
586       $self->throw("unable to find or run executable for SLR") unless $slrexe && -e $slrexe && -x _;
587       my $run;
588       open($run, "$slrexe |") or $self->throw("Cannot open exe $slrexe");
589       my @output = <$run>;
590       $exit_status = close($run);
591       $self->error_string(join('',@output));
592       if( (grep { /\berr(or)?: /io } @output)  || !$exit_status) {
593	   $self->warn("There was an error - see error_string for the program output");
594	   $rc = 0;
595       }
596       eval {
597           open RESULTS, "$tmpdir/$outfile" or die "couldnt open results file: $!\n";
598           my $okay = 0;
599           my $sites;
600           my $type = 'default';
601           while (<RESULTS>) {
602               chomp $_;
603               if ( /^\#/ ) {next;}
604               if ( /\!/ ) {$type = 'random';} # random is last
605               elsif ( /\+/ ) {$type = 'positive';}
606               elsif ( /\-\s+/ ) {$type = 'negative';}
607               elsif ( /Constant/ ) {$type = 'constant';}
608               elsif ( /All gaps/ ) {$type = 'all_gaps';}
609               elsif ( /Single character/ ) {$type = 'single_character';}
610               elsif ( /Synonymous/ ) {$type = 'synonymous';}
611               else  {$type = 'default'}
612               if ( /^\s+(\d+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)/ ) {
613                   push @{$sites->{$type}}, [$1,$2,$3,$4,$5,$6,$7,$8,$9];
614               } else {
615                   $DB::single=1;1;
616               }
617           }
618           $results = $sites;
619           close RESULTS;
620           # TODO: we could have a proper parser object
621           # 	   $parser = Bio::Tools::Phylo::SLR->new(-file => "$tmpdir/$outfile",
622           # 						 -dir => "$tmpdir");
623       };
624       if( $@ ) {
625	   $self->warn($self->error_string);
626       }
627       chdir($cwd);
628   }
629   #   return ($rc,$parser);
630   return ($rc,$results);
631}
632
633=head2 error_string
634
635 Title   : error_string
636 Usage   : $obj->error_string($newval)
637 Function: Where the output from the last analysus run is stored.
638 Returns : value of error_string
639 Args    : newvalue (optional)
640
641
642=cut
643
644sub error_string{
645   my ($self,$value) = @_;
646   if( defined $value) {
647      $self->{'error_string'} = $value;
648    }
649    return $self->{'error_string'};
650
651}
652
653=head2 alignment
654
655 Title   : alignment
656 Usage   : $slr->align($aln);
657 Function: Get/Set the L<Bio::Align::AlignI> object
658 Returns : L<Bio::Align::AlignI> object
659 Args    : [optional] L<Bio::Align::AlignI>
660 Comment : We could potentially add support for running directly on a file
661           but we shall keep it simple
662 See also: L<Bio::SimpleAlign>
663
664=cut
665
666sub alignment{
667   my ($self,$aln) = @_;
668
669   if( defined $aln ) {
670       if( -e $aln ) {
671	   $self->{'_alignment'} = $aln;
672       } elsif( !ref($aln) || ! $aln->isa('Bio::Align::AlignI') ) {
673	   $self->warn("Must specify a valid Bio::Align::AlignI object to the alignment function not $aln");
674	   return undef;
675       } else {
676	   $self->{'_alignment'} = $aln;
677       }
678   }
679   return  $self->{'_alignment'};
680}
681
682=head2 tree
683
684 Title   : tree
685 Usage   : $slr->tree($tree, %params);
686 Function: Get/Set the L<Bio::Tree::TreeI> object
687 Returns : L<Bio::Tree::TreeI>
688 Args    : [optional] $tree => L<Bio::Tree::TreeI>,
689
690 Comment : We could potentially add support for running directly on a file
691           but we shall keep it simple
692 See also: L<Bio::Tree::Tree>
693
694=cut
695
696sub tree {
697   my ($self, $tree, %params) = @_;
698   if( defined $tree ) {
699       if( ! ref($tree) || ! $tree->isa('Bio::Tree::TreeI') ) {
700	   $self->warn("Must specify a valid Bio::Tree::TreeI object to the alignment function");
701       }
702       $self->{'_tree'} = $tree;
703   }
704   return $self->{'_tree'};
705}
706
707=head2 get_parameters
708
709 Title   : get_parameters
710 Usage   : my %params = $self->get_parameters();
711 Function: returns the list of parameters as a hash
712 Returns : associative array keyed on parameter names
713 Args    : none
714
715
716=cut
717
718sub get_parameters{
719   my ($self) = @_;
720   # we're returning a copy of this
721   return %{ $self->{'_slrparams'} };
722}
723
724
725=head2 set_parameter
726
727 Title   : set_parameter
728 Usage   : $slr->set_parameter($param,$val);
729 Function: Sets a SLR parameter, will be validated against
730           the valid values as set in the %VALIDVALUES class variable.
731           The checks can be ignored if one turns off param checks like this:
732             $slr->no_param_checks(1)
733 Returns : boolean if set was success, if verbose is set to -1
734           then no warning will be reported
735 Args    : $param => name of the parameter
736           $value => value to set the parameter to
737 See also: L<no_param_checks()>
738
739=cut
740
741sub set_parameter{
742   my ($self,$param,$value) = @_;
743   unless (defined $self->{'no_param_checks'} && $self->{'no_param_checks'} == 1) {
744       if ( ! defined $VALIDVALUES{$param} ) {
745           $self->warn("unknown parameter $param will not be set unless you force by setting no_param_checks to true");
746           return 0;
747       }
748       if ( ref( $VALIDVALUES{$param}) =~ /ARRAY/i &&
749            scalar @{$VALIDVALUES{$param}} > 0 ) {
750
751           unless ( grep { $value eq $_ } @{ $VALIDVALUES{$param} } ) {
752               $self->warn("parameter $param specified value $value is not recognized, please see the documentation and the code for this module or set the no_param_checks to a true value");
753               return 0;
754           }
755       }
756   }
757   $self->{'_slrparams'}->{$param} = $value;
758   return 1;
759}
760
761=head2 set_default_parameters
762
763 Title   : set_default_parameters
764 Usage   : $slr->set_default_parameters(0);
765 Function: (Re)set the default parameters from the defaults
766           (the first value in each array in the
767	    %VALIDVALUES class variable)
768 Returns : none
769 Args    : boolean: keep existing parameter values
770
771
772=cut
773
774sub set_default_parameters{
775   my ($self,$keepold) = @_;
776   $keepold = 0 unless defined $keepold;
777
778   while( my ($param,$val) = each %VALIDVALUES ) {
779       # skip if we want to keep old values and it is already set
780       next if( defined $self->{'_slrparams'}->{$param} && $keepold);
781       if(ref($val)=~/ARRAY/i ) {
782	   $self->{'_slrparams'}->{$param} = $val->[0];
783       }  else {
784	   $self->{'_slrparams'}->{$param} = $val;
785       }
786   }
787}
788
789
790=head1 Bio::Tools::Run::WrapperBase methods
791
792=cut
793
794=head2 no_param_checks
795
796 Title   : no_param_checks
797 Usage   : $obj->no_param_checks($newval)
798 Function: Boolean flag as to whether or not we should
799           trust the sanity checks for parameter values
800 Returns : value of no_param_checks
801 Args    : newvalue (optional)
802
803
804=cut
805
806sub no_param_checks{
807   my ($self,$value) = @_;
808   if( defined $value) {
809      $self->{'no_param_checks'} = $value;
810    }
811    return $self->{'no_param_checks'};
812}
813
814
815=head2 save_tempfiles
816
817 Title   : save_tempfiles
818 Usage   : $obj->save_tempfiles($newval)
819 Function:
820 Returns : value of save_tempfiles
821 Args    : newvalue (optional)
822
823
824=cut
825
826=head2 outfile_name
827
828 Title   : outfile_name
829 Usage   : my $outfile = $slr->outfile_name();
830 Function: Get/Set the name of the output file for this run
831           (if you wanted to do something special)
832 Returns : string
833 Args    : [optional] string to set value to
834
835
836=cut
837
838sub outfile_name {
839    my $self = shift;
840    if( @_ ) {
841	return $self->{'_slrparams'}->{'outfile'} = shift @_;
842    }
843    unless (defined $self->{'_slrparams'}->{'outfile'}) {
844        $self->{'_slrparams'}->{'outfile'} = 'out.res';
845    }
846    return $self->{'_slrparams'}->{'outfile'};
847}
848
849=head2 tempdir
850
851 Title   : tempdir
852 Usage   : my $tmpdir = $self->tempdir();
853 Function: Retrieve a temporary directory name (which is created)
854 Returns : string which is the name of the temporary directory
855 Args    : none
856
857
858=cut
859
860=head2 cleanup
861
862 Title   : cleanup
863 Usage   : $slr->cleanup();
864 Function: Will cleanup the tempdir directory after an SLR run
865 Returns : none
866 Args    : none
867
868
869=cut
870
871=head2 io
872
873 Title   : io
874 Usage   : $obj->io($newval)
875 Function:  Gets a L<Bio::Root::IO> object
876 Returns : L<Bio::Root::IO>
877 Args    : none
878
879
880=cut
881
882sub DESTROY {
883    my $self= shift;
884    unless ( $self->save_tempfiles ) {
885	$self->cleanup();
886    }
887    $self->SUPER::DESTROY();
888}
889
8901;
891