File Coverage

blib/lib/Bio/Tools/Run/Phylo/PAML/Yn00.pm

Criterion	Covered	Total	%
statement	34	131	25.9
branch	2	48	4.1
condition	0	18	0.0
subroutine	11	20	55.0
pod	9	9	100.0
total	56	226	24.7

package Bio::Tools::Run::Phylo::PAML::Yn00;
$Bio::Tools::Run::Phylo::PAML::Yn00::VERSION = '1.7.2';
use utf8;
use strict;
use warnings;

use vars qw(@ISA %VALIDVALUES $MINNAMELEN $PROGRAMNAME $PROGRAM);
use Cwd;
use Bio::Root::Root;
use Bio::AlignIO;
use Bio::TreeIO;
use Bio::Tools::Run::WrapperBase;
use Bio::Tools::Phylo::PAML;

@ISA = qw(Bio::Root::Root Bio::Tools::Run::WrapperBase);

# ABSTRACT: Wrapper aroud the PAML program yn00
# AUTHOR: Jason Stajich
# OWNER: Jason Stajich
# LICENSE: Perl_5



BEGIN {

    $MINNAMELEN = 25;
    $PROGRAMNAME = 'yn00'  . ($^O =~ /mswin/i ?'.exe':'');
    if( defined $ENV{'PAMLDIR'} ) {
    $PROGRAM = Bio::Root::IO->catfile($ENV{'PAMLDIR'},$PROGRAMNAME);
    }
    # valid values for parameters, the default one is always
    # the first one in the array
    # much of the documentation here is lifted directly from the codeml.ctl
    # example file provided with the package
    %VALIDVALUES = (
             'noisy'   => [ 0..3,9],
             'verbose' => [ 0,1,2], # 0:concise, 1:detailed, 2:too much

             'weighting' => [0,1], # weighting pathways between codons
             'commonf3x4' => [0,1], # use same f3x4 for all sites

             # (icode) genetic code
             # 0:universal code
             # 1:mamalian mt
             # 2:yeast mt
             # 3:mold mt,
             # 4:invertebrate mt
             # 5:ciliate nuclear
             # 6:echinoderm mt
             # 7:euplotid mt
             # 8:alternative yeast nu.
             # 9:ascidian mt
             #10:blepharisma nu
             # these correspond to 1-11 in the genbank transl table

             'icode'    => [ 0..10],
             'ndata'    => [1..10],
             );
}



sub program_name {
    return $PROGRAMNAME;
}


sub program_dir {
            return Bio::Root::IO->catfile($ENV{PAMLDIR}) if $ENV{PAMLDIR};
}


sub new {
  my($class,@args) = @_;

  my $self = $class->SUPER::new(@args);
  my ($aln,$st) = $self->_rearrange([qw(ALIGNMENT SAVE_TEMPFILES)],
                    @args);
  defined $aln && $self->alignment($aln);
  defined $st  && $self->save_tempfiles($st);

  $self->set_default_parameters();
  return $self;
}


sub run{
   my ($self,$aln) = @_;
   ($aln) ||= $self->alignment();
   if( ! $aln ) {
       $self->warn("must have supplied a valid alignment file in order to run yn00");
       return 0;
   }
   my ($tmpdir) = $self->tempdir();
   my ($tempseqFH,$tempseqfile);
   if( ! ref($aln) && -e $aln ) {
       $tempseqfile = $aln;
   } else {
       ($tempseqFH,$tempseqfile) = $self->io->tempfile
       ('-dir' => $tmpdir,
        UNLINK => ($self->save_tempfiles ? 0 : 1));
       my $alnout = Bio::AlignIO->new('-format'      => 'phylip',
                     '-fh'          => $tempseqFH,
                     '-interleaved' => 0,
                     '-idlength'    => $MINNAMELEN > $aln->maxdisplayname_length() ? $MINNAMELEN : $aln->maxdisplayname_length() +1);

       $alnout->write_aln($aln);
       $alnout->close();
       undef $alnout;
       close($tempseqFH);
       undef $tempseqFH;
   }
   # now let's print the yn.ctl file.
   # many of the these programs are finicky about what the filename is
   # and won't even run without the properly named file.  Ack

   my $yn_ctl = "$tmpdir/yn00.ctl";
   open(YN, ">$yn_ctl") or $self->throw("cannot open $yn_ctl for writing");
   print YN "seqfile = $tempseqfile\n";

   my $outfile = $self->outfile_name;

   print YN "outfile = $outfile\n";
   my %params = $self->get_parameters;
   while( my ($param,$val) = each %params ) {
       print YN "$param = $val\n";
   }
   close(YN);
   my ($rc,$parser) = (1);
   {
       my $cwd = cwd();
       my $exit_status;
       chdir($tmpdir);
       my $ynexe = $self->executable();
       $self->throw("unable to find executable for 'yn'") unless $ynexe;
       open(RUN, "$ynexe |");
       my @output = ;
       $exit_status = close(RUN);
       $self->error_string(join('',@output));
       if( (grep { /\berr(or)?: /io } @output) || !$exit_status ) {
       $self->warn("There was an error - see error_string for the program output");
       $rc = 0;
       }
       eval {
       $parser = Bio::Tools::Phylo::PAML->new(-file => "$tmpdir/mlc",
                         -dir => "$tmpdir");

       };
       if( $@ ) {
       $self->warn($self->error_string);
       }
       chdir($cwd);
   }
   if( $self->verbose > 0 ) {
       open(IN, "$tmpdir/mlc");
       while() {
       $self->debug($_);
       }
   }

   unless ( $self->save_tempfiles ) {
      unlink("$yn_ctl");
      $self->cleanup();
   }
   return ($rc,$parser);
}


sub error_string{
   my ($self,$value) = @_;
   if( defined $value) {
      $self->{'error_string'} = $value;
    }
    return $self->{'error_string'};

}


sub alignment{
   my ($self,$aln) = @_;
   if( defined $aln ) {
       if( !ref($aln) || ! $aln->isa('Bio::Align::AlignI') ) {
       $self->warn("Must specify a valid Bio::Align::AlignI object to the alignment function");
       return undef;
       }
       $self->{'_alignment'} = $aln;
   }
   return  $self->{'_alignment'};
}


sub get_parameters{
   my ($self) = @_;
   # we're returning a copy of this
   return %{ $self->{'_codemlparams'} };
}



sub set_parameter{
   my ($self,$param,$value) = @_;
   if( ! defined $VALIDVALUES{$param} ) {
       $self->warn("unknown parameter $param will not set unless you force by setting no_param_checks to true");
       return 0;
   }
   if( ref( $VALIDVALUES{$param}) =~ /ARRAY/i &&
       scalar @{$VALIDVALUES{$param}} > 0 ) {

       unless ( grep {$value} @{ $VALIDVALUES{$param} } ) {
       $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");
       return 0;
       }
   }
   $self->{'_codemlparams'}->{$param} = $value;
   return 1;
}


sub set_default_parameters{
   my ($self,$keepold) = @_;
   $keepold = 0 unless defined $keepold;

   while( my ($param,$val) = each %VALIDVALUES ) {
       # skip if we want to keep old values and it is already set
       next if( defined $self->{'_codemlparams'}->{$param} && $keepold);
       if(ref($val)=~/ARRAY/i ) {
       $self->{'_codemlparams'}->{$param} = $val->[0];
       }  else {
       $self->{'_codemlparams'}->{$param} = $val;
       }
   }
}










1;

__END__