Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
Fixes for bug 3381.
  • Loading branch information
daisieh committed Aug 23, 2012
1 parent 2e63f07 commit c697dae
Show file tree
Hide file tree
Showing 2 changed files with 109 additions and 96 deletions.
154 changes: 79 additions & 75 deletions lib/Bio/Tools/Run/Phylo/Hyphy/REL.pm
Expand Up @@ -2,7 +2,7 @@
#
# BioPerl module for Bio::Tools::Run::Phylo::Hyphy::REL
#
# Please direct questions and support issues to <bioperl-l@bioperl.org>
# Please direct questions and support issues to <bioperl-l@bioperl.org>
#
# Cared for by Albert Vilella <avilella-at-gmail-dot-com>
#
Expand Down Expand Up @@ -56,15 +56,15 @@ 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 Support
=head2 Support
Please direct usage questions or support issues to the mailing list:
I<bioperl-l@bioperl.org>
rather than to the module maintainer directly. Many experienced and
reponsive experts will be able look at the problem and quickly
address it. Please include a thorough description of the problem
rather than to the module maintainer directly. Many experienced and
reponsive experts will be able look at the problem and quickly
address it. Please include a thorough description of the problem
with code and data examples if at all possible.
=head2 Reporting Bugs
Expand Down Expand Up @@ -115,23 +115,24 @@ INCOMPLETE DOCUMENTATION OF ALL METHODS
=cut

BEGIN {
@VALIDVALUES =
BEGIN {
@VALIDVALUES =
(
{'geneticCode' => [ "Universal","VertebratemtDNA","YeastmtDNA","Mold/ProtozoanmtDNA",
"InvertebratemtDNA","CiliateNuclear","EchinodermmtDNA","EuplotidNuclear",
"Alt.YeastNuclear","AscidianmtDNA","FlatwormmtDNA","BlepharismaNuclear"]},
{'tempalnfile' => undef }, # aln file goes here
{'temptreefile' => undef }, # tree file goes here
{'Model' => [ "Null for Test 1", "Null for Test 2", "Alternative"]},
{'temptsvfile' => undef } # site-by-site conditional probabilities go to this file
);
}

=head2 new
Title : new
Usage : my $obj = Bio::Tools::Run::Phylo::Hyphy::REL->new();
Function: Builds a new Bio::Tools::Run::Phylo::Hyphy::REL object
Function: Builds a new Bio::Tools::Run::Phylo::Hyphy::REL object
Returns : Bio::Tools::Run::Phylo::Hyphy::REL
Args : -alignment => the Bio::Align::AlignI object
-save_tempfiles => boolean to save the generated tempfiles and
Expand All @@ -147,20 +148,22 @@ See also: L<Bio::Tree::TreeI>, L<Bio::Align::AlignI>
sub new {
my($class,@args) = @_;

my $self = $class->SUPER::new(@args);
my ($aln, $tree, $st, $params, $exe,
$ubl) = $self->_rearrange([qw(ALIGNMENT TREE SAVE_TEMPFILES
PARAMS EXECUTABLE)],
@args);
defined $aln && $self->alignment($aln);
defined $tree && $self->tree($tree);
defined $st && $self->save_tempfiles($st);
defined $exe && $self->executable($exe);

$self->set_default_parameters();
if( defined $params ) {
if( ref($params) !~ /HASH/i ) {
$self->warn("Must provide a valid hash ref for parameter -FLAGS");
my $self = $class->SUPER::new(@args);
my ($aln, $tree, $st, $params, $exe,
$ubl) = $self->_rearrange([qw(ALIGNMENT TREE SAVE_TEMPFILES PARAMS EXECUTABLE)], @args);
defined $aln && $self->alignment($aln);
defined $tree && $self->tree($tree);
defined $st && $self->save_tempfiles($st);
defined $exe && $self->executable($exe);

my $tsvfile = $self->tempdir() . "/results.tsv";
$self->{'_params'}{'temptsvfile'} = $tsvfile;


$self->set_default_parameters();
if( defined $params ) {
if( ref($params) !~ /HASH/i ) {
$self->warn("Must provide a valid hash ref for parameter -FLAGS");
} else {
map { $self->set_parameter($_, $$params{$_}) } keys %$params;
}
Expand Down Expand Up @@ -188,33 +191,33 @@ sub run {
$self->prepare($aln,$tree) unless (defined($self->{'_prepared'}));
my ($rc,$results) = (1);
{
my $commandstring;
my $exit_status;
my $tempdir = $self->tempdir;
my $relexe = $self->executable();
$self->throw("unable to find or run executable for 'HYPHY'") unless $relexe && -e $relexe && -x _;
$commandstring = $relexe . " BASEPATH=" . $self->program_dir . " " . $self->{'_wrapper'};
open(RUN, "$commandstring |") or $self->throw("Cannot open exe $relexe");
my @output = <RUN>;
$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;
}
my $outfile = $self->outfile_name;
eval {
open(OUTFILE, ">$outfile") or $self->throw("cannot open $outfile for writing");
# FIXME -- needs output parsing -- ask hyphy to clean that up into a tsv?
foreach my $output (@output) {
print OUTFILE $output;
$results .= sprintf($output);
}
close(OUTFILE);
};
if( $@ ) {
$self->warn($self->error_string);
}
my $commandstring;
my $exit_status;
my $tempdir = $self->tempdir;

my $relexe = $self->executable();
$self->throw("unable to find or run executable for 'HYPHY'") unless $relexe && -e $relexe && -x _;
$commandstring = $relexe . " BASEPATH=" . $self->program_dir . " " . $self->{'_wrapper'};
open(RUN, "$commandstring |") or $self->throw("Cannot open exe $relexe");
my @output = <RUN>;
$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;
}
my $outfile = $self->outfile_name;
eval {
open(OUTFILE, ">$outfile") or $self->throw("cannot open $outfile for writing");
foreach my $output (@output) {
print OUTFILE $output;
$results .= sprintf($output);
}
close(OUTFILE);
};
if( $@ ) {
$self->warn($self->error_string);
}
}
unless ( $self->save_tempfiles ) {
unlink($self->{'_wrapper'});
Expand All @@ -230,7 +233,7 @@ sub run {
Usage : $self->create_wrapper
Function: It will create the wrapper file that interfaces with the analysis bf file
Example :
Returns :
Returns :
Args :
Expand All @@ -249,7 +252,7 @@ sub create_wrapper {
Title : set_default_parameters
Usage : $rel->set_default_parameters(0);
Function: (Re)set the default parameters from the defaults
(the first value in each array in the
(the first value in each array in the
%VALIDVALUES class variable)
Returns : none
Args : boolean: keep existing parameter values
Expand All @@ -261,28 +264,29 @@ sub set_default_parameters {
my ($self,$keepold) = @_;
$keepold = 0 unless defined $keepold;
foreach my $elem (@VALIDVALUES) {
my ($param,$val) = each %$elem;
# skip if we want to keep old values and it is already set
if (ref($val)=~/ARRAY/i ) {
unless (ref($val->[0])=~/HASH/i) {
push @{ $self->{'_orderedparams'} }, {$param, $val->[0]};
} else {
$val = $val->[0];
}
}
if ( ref($val) =~ /HASH/i ) {
my $prevparam;
while (defined($val)) {
last unless (ref($val) =~ /HASH/i);
last unless (defined($param));
$prevparam = $param;
($param,$val) = each %{$val};
push @{ $self->{'_orderedparams'} }, {$prevparam, $param};
push @{ $self->{'_orderedparams'} }, {$param, $val} if (defined($val));
}
} elsif (ref($val) !~ /HASH/i && ref($val) !~ /ARRAY/i) {
push @{ $self->{'_orderedparams'} }, {$param, $val};
}
keys %$elem; #reset hash iterator
my ($param,$val) = each %$elem;
# skip if we want to keep old values and it is already set
if (ref($val)=~/ARRAY/i ) {
unless (ref($val->[0])=~/HASH/i) {
push @{ $self->{'_orderedparams'} }, {$param, $val->[0]};
} else {
$val = $val->[0];
}
}
if ( ref($val) =~ /HASH/i ) {
my $prevparam;
while (defined($val)) {
last unless (ref($val) =~ /HASH/i);
last unless (defined($param));
$prevparam = $param;
($param,$val) = each %{$val};
push @{ $self->{'_orderedparams'} }, {$prevparam, $param};
push @{ $self->{'_orderedparams'} }, {$param, $val} if (defined($val));
}
} elsif (ref($val) !~ /HASH/i && ref($val) !~ /ARRAY/i) {
push @{ $self->{'_orderedparams'} }, {$param, $val};
}
}
}

Expand All @@ -296,7 +300,7 @@ sub set_default_parameters {
Title : no_param_checks
Usage : $obj->no_param_checks($newval)
Function: Boolean flag as to whether or not we should
trust the sanity checks for parameter values
trust the sanity checks for parameter values
Returns : value of no_param_checks
Args : newvalue (optional)
Expand All @@ -307,7 +311,7 @@ sub set_default_parameters {
Title : save_tempfiles
Usage : $obj->save_tempfiles($newval)
Function:
Function:
Returns : value of save_tempfiles
Args : newvalue (optional)
Expand Down
51 changes: 30 additions & 21 deletions t/Hyphy.t
Expand Up @@ -7,53 +7,62 @@ use strict;

BEGIN {
use Bio::Root::Test;
test_begin(-tests => 15, -requires_module =>'IO::String');

use_ok('Bio::Root::IO');
test_begin(-tests => 8, -requires_module =>'IO::String');

use_ok('Bio::Tools::Run::Phylo::Hyphy::SLAC');
use_ok('Bio::Tools::Run::Phylo::Hyphy::FEL');
use_ok('Bio::Tools::Run::Phylo::Hyphy::REL');
use_ok('Bio::Tools::Run::Phylo::Hyphy::Modeltest');
use_ok('Bio::AlignIO');
use_ok('Bio::TreeIO');
}

ok my $slac = Bio::Tools::Run::Phylo::Hyphy::SLAC->new();
ok my $rel = Bio::Tools::Run::Phylo::Hyphy::REL->new();
ok my $fel = Bio::Tools::Run::Phylo::Hyphy::FEL->new();
ok my $modeltest = Bio::Tools::Run::Phylo::Hyphy::Modeltest->new();
my $slac = Bio::Tools::Run::Phylo::Hyphy::SLAC->new();

SKIP: {
test_skip(-requires_executable => $slac, -tests => 4);

my $alignio = Bio::AlignIO->new(-format => 'fasta',
-file => 't/data/hyphy1.fasta');

my $treeio = Bio::TreeIO->new(-format => 'newick',
-file => 't/data/hyphy1.tree');

my $aln = $alignio->next_aln;
my $tree = $treeio->next_tree;

$slac->alignment($aln);
$slac->tree($tree);
my ($rc,$results) = $slac->run();
ok defined($results);

if ($rc == 0) {
self->warn("ERROR in SLAC module $rc:" . $slac->error_string() . "\n");
}
ok ($rc != 0, "SLAC module");

my $rel = Bio::Tools::Run::Phylo::Hyphy::REL->new();
$rel->alignment($aln);
$rel->tree($tree);
($rc,$results) = $rel->run();
ok defined($results);

if ($rc == 0) {
self->warn(print "ERROR in REL module $rc:" . $rel->error_string() . "\n");
}
ok ($rc != 0, "REL module");

my $fel = Bio::Tools::Run::Phylo::Hyphy::FEL->new();
$fel->alignment($aln);
$fel->tree($tree);
($rc,$results) = $fel->run();
ok defined($results);

if ($rc == 0) {
self->warn("ERROR in FEL module $rc:" . $fel->error_string() . "\n");
}
ok ($rc != 0, "FEL module");

my $modeltest = Bio::Tools::Run::Phylo::Hyphy::Modeltest->new();
$modeltest->alignment($aln);
$modeltest->tree($tree);
($rc,$results) = $modeltest->run();
ok defined($results);

if ($rc == 0) {
self->warn("ERROR in Modeltest module $rc:" . print $modeltest->error_string() . "\n");
}
ok ($rc != 0, "Modeltest module");

#*** where are the tests?!
}

0 comments on commit c697dae

Please sign in to comment.