[Bioperl-guts-l] bioperl commit

Jason Stajich jason at pub.open-bio.org
Fri May 14 12:30:07 EDT 2004


jason
Fri May 14 12:30:07 EDT 2004
Update of /home/repository/bioperl/bioperl-run/Bio/Tools/Run/Alignment
In directory pub.open-bio.org:/tmp/cvs-serv4678/Bio/Tools/Run/Alignment

Modified Files:
	Clustalw.pm 
Added Files:
	MAFFT.pm 
Log Message:
more, better tests for the new implementation for tree/bootstrap -- still some things to fix

bioperl-run/Bio/Tools/Run/Alignment MAFFT.pm,NONE,1.1 Clustalw.pm,1.37,1.38
===================================================================
RCS file: /home/repository/bioperl/bioperl-run/Bio/Tools/Run/Alignment/Clustalw.pm,v
retrieving revision 1.37
retrieving revision 1.38
diff -u -r1.37 -r1.38
--- /home/repository/bioperl/bioperl-run/Bio/Tools/Run/Alignment/Clustalw.pm	2004/05/14 01:16:00	1.37
+++ /home/repository/bioperl/bioperl-run/Bio/Tools/Run/Alignment/Clustalw.pm	2004/05/14 16:30:07	1.38
@@ -321,9 +321,9 @@
 use Bio::Seq;
 use Bio::SeqIO;
 use Bio::SimpleAlign;
-use Bio::AlignIO;
+use Bio::AlignIO;
 use Bio::TreeIO;
-use Bio::Root::Root;
+use Bio::Root::Root;
 use Bio::Root::IO;
 use Bio::Tools::Run::WrapperBase;
 
@@ -356,7 +356,7 @@
     @OTHER_SWITCHES = qw(QUIET);
     # Authorize attribute fields
     foreach my $attr ( @CLUSTALW_PARAMS, @CLUSTALW_SWITCHES,
-		       @OTHER_SWITCHES ) { $OK_FIELD{$attr}++; }
+		       @OTHER_SWITCHES ) { $OK_FIELD{$attr}++; }
 }
 
 =head2 program_name
@@ -519,14 +519,18 @@
 
  Title   : tree
  Usage   :
-    @params = ('bootstrap', 1000, 'tossgaps', 1, 'kimura', 1, 'seed', 121, 'bootlabels', 'nodes', 'quiet', 1);
+    @params = ('bootstrap' => 1000, 
+	       'tossgaps'  => 1, 
+	       'kimura'    => 1, 
+	       'seed'      => 121, 
+	       'bootlabels'=> 'nodes', 
+	       'quiet'     => 1);
     $factory = Bio::Tools::Run::Alignment::Clustalw->new(@params);
     $tree_obj = $factory->tree($aln_obj);
 or
     $tree_obj = $factory->tree($treefilename);
  Function: 
- Example :
- Returns : 
+ Returns : Bio::TreeIO object
  Args    : 
 
 
@@ -537,7 +541,7 @@
     my ($temp,$infilename, $seq);
     my ($attr, $value, $switch);
     $self->io->_io_cleanup();
-    # Create input file pointer
+    # Create input file pointer
     $infilename = $self->_setinput($input);
     
     if (!$infilename) {$self->throw("Bad input data (sequences need an id ) or less than 2 sequences in $input !");}
@@ -545,8 +549,8 @@
     # Create parameter string to pass to clustalw program
     my $param_string = $self->_setparams();
 
-    # run clustalw
-    my $tree = $self->_run('tree', $infilename,$param_string);
+    # run clustalw
+    my $tree = $self->_run('tree', $infilename,$param_string);
 }
 #################################################
 
@@ -566,51 +570,61 @@
 
 sub _run {
     my ($self,$command,$infile1,$infile2,$param_string) = @_;
-    my $instring;
-
+    my $instring;
+    
     if ($command =~ /align/) {
-
+	
 	if( $^O eq 'dec_osf' ) {
 	    $instring =  "$infile1";
 	    $command = '';
 	} else { 
 	    $instring = " -infile=$infile1";
 	}
-    	$param_string .= " $infile2";
+	$param_string .= " $infile2";
 
     }
 
     if ($command =~ /profile/) {
-	    $instring =  "-profile1=$infile1  -profile2=$infile2";
+	$instring =  "-profile1=$infile1  -profile2=$infile2";
     	chmod 0777, $infile1,$infile2;
     	$command = '-profile';
     }
-    
+
     if ($command =~ /tree/) {
-        
     	if( $^O eq 'dec_osf' ) {
 	    $instring =  "$infile1";
-	    $command = '';
+	    $command = '';
 	} else { 
-	    $instring = " $infile1";
+	    $instring = " $infile1";
 	}
     	$param_string .= " $infile2";
-    	
+
     	$self->debug( "Program ".$self->executable."\n");
-    	
     	my $commandstring = $self->executable."$instring"."$param_string";
-        $self->debug( "clustal command = $commandstring");
-    	my $status = system($commandstring);
-    	$self->throw( "Clustalw call ($commandstring) crashed: $? \n") unless $status==0;
-        
+        $self->debug( "clustal command = $commandstring");
+	my $status = system($commandstring);
+	unless( $status == 0 ) {
+	    $self->warn( "Clustalw call ($commandstring) crashed: $? \n");
+	    return undef;
+	}
+
     	my $treefile = $instring;
     	$treefile =~ s/ //g;
-    	$treefile = $instring.'.phb' if $param_string =~ /-bootstrap/;
-        $treefile = $instring.'.ph' if $param_string =~ /-tree/;
-        
-    	my $in = new Bio::TreeIO('-file'=> "$treefile");
-        
-    	return $in;
+	if( $param_string =~ /-bootstrap/ ) {
+	    $treefile = $instring.'.phb';
+	} elsif( $param_string =~ /-tree/ ) {
+	    $treefile = $instring.'.ph';
+	} else { $treefile = $instring.".dnd" }
+	my $in = new Bio::TreeIO('-file'  => $treefile,
+				 '-format'=> 'newick');
+    	my $tree = $in->next_tree;
+	unless ( $self->save_tempfiles ) {
+	    foreach my $f ( $treefile ) {
+		$f =~ s/\.[^\.]*$// ;
+		unlink $f if( $f ne '' );
+	    }
+	}
+	return $tree;
     }
     
     my $output = $self->output || 'gcg';
@@ -620,24 +634,30 @@
 
     $self->debug( "clustal command = $commandstring");
     my $status = system($commandstring);    
-    $self->throw( "Clustalw call ($commandstring) crashed: $? \n") unless $status==0;
-    
-    my $outfile = $self->outfile();
-    
+    unless( $status == 0 ) {
+	$self->warn( "Clustalw call ($commandstring) crashed: $? \n");
+	return undef;
+    }
+
+    my $outfile = $self->outfile();
+
 # retrieve alignment (Note: MSF format for AlignIO = GCG format of clustalw)
 
     my $format= $output =~/phylip/i ? "phylip" : "MSF";
 
-    my $in  = Bio::AlignIO->new(-file => $outfile);
+    my $in  = Bio::AlignIO->new(-file  => $outfile,
+				-format=> $format);
     my $aln = $in->next_aln();
+    $in->close;
 
     # Clean up the temporary files created along the way...
     # Replace file suffix with dnd to find name of dendrogram file(s) to delete
-    foreach my $f ( $infile1, $infile2 ) {
-    	$f =~ s/\.[^\.]*$// ;
-    	unlink $f .'.dnd' if( $f ne '' );
+    unless ( $self->save_tempfiles ) {
+	foreach my $f ( $infile1, $infile2 ) {
+	    $f =~ s/\.[^\.]*$// ;
+	    unlink $f .'.dnd' if( $f ne '' );
+	}
     }
-    $in->close;
     return $aln;
 }
 
@@ -672,31 +692,29 @@
 
     #  $input may be an array of BioSeq objects...
     if (ref($input) eq "ARRAY") {
-        #  Open temporary file for both reading & writing of BioSeq array
+        #  Open temporary file for both reading & writing of BioSeq array
 	($tfh,$infilename) = $self->io->tempfile(-dir=>$self->tempdir);
 	$temp =  Bio::SeqIO->new('-fh'=>$tfh,
-				 '-format' =>'Fasta');
-        
+				 '-format' =>'Fasta');
+        
 	# Need at least 2 seqs for alignment
 	unless (scalar(@$input) > 1) {return 0;}
 
 	foreach $seq (@$input) {
 	    unless (defined $seq &&
 		    $seq->isa("Bio::PrimarySeqI") and $seq->id() )
-	    {return 0;}
-	    $temp->write_seq($seq);
-	}
+	    {return 0;}
+	    $temp->write_seq($seq);
+	}
 	$temp->close();
 	close($tfh);
-	undef $tfh;
+	undef $tfh;
 	return $infilename;
     }
 #  $input may be a SimpleAlign object.
     elsif (ref($input) eq "Bio::SimpleAlign") {
 	#  Open temporary file for both reading & writing of SimpleAlign object
-	if ($suffix ==1 || $suffix== 2 ) {
-	    ($tfh,$infilename) = $self->io->tempfile(-dir=>$self->tempdir);
-	}
+	($tfh,$infilename) = $self->io->tempfile(-dir=>$self->tempdir);
 	$temp =  Bio::AlignIO->new('-fh'=> $tfh,
 				   '-format' => 'fasta');
 	$temp->write_aln($input);
@@ -755,7 +773,7 @@
     }
 
 # Set default output file if no explicit output file selected
-    unless ($param_string =~ /outfile/) {
+    unless ($param_string =~ /outfile/) {
 	my ($tfh, $outfile) = $self->io->tempfile(-dir=>$self->tempdir());
 	close($tfh);
 	undef $tfh;
@@ -763,10 +781,12 @@
     	$param_string .= " -outfile=$outfile" ;
     }
     
-    if ($self->quiet() || $self->verbose() < 0) {
-        $PROGRAM = Bio::Root::IO->catfile($PROGRAMDIR, $PROGRAMNAME.($^O =~ /mswin/i ?'.exe':''));
-        if ($^O =~ /mswin/i) { $param_string .= ' >'.$self->outfile().'out'; }
-        elsif ($^O =~ /unix/i) { $param_string .= ' >/dev/null 2>/dev/null'; }
+    if ($self->quiet() || $self->verbose() < 0) {
+        if ($^O =~ /mswin/i) { $param_string .= ' >'.$self->outfile().'out'; }
+        elsif ($^O =~ /unix|linux|darwin/i) { $param_string .= ' >/dev/null 2>/dev/null'; }
+	else { 
+	    $self->warn("unknown os $^O\n");
+	}
     }
     
     return $param_string;



More information about the Bioperl-guts-l mailing list