[Bioperl-guts-l] bioperl-live/Bio/AlignIO fasta.pm,1.19,1.20

Jason Stajich jason at pub.open-bio.org
Sun Nov 6 16:32:08 EST 2005


Update of /home/repository/bioperl/bioperl-live/Bio/AlignIO
In directory pub.open-bio.org:/tmp/cvs-serv14986/Bio/AlignIO

Modified Files:
	fasta.pm 
Log Message:
specify a width in an alignment writing and use regexp to format instead of while loop


Index: fasta.pm
===================================================================
RCS file: /home/repository/bioperl/bioperl-live/Bio/AlignIO/fasta.pm,v
retrieving revision 1.19
retrieving revision 1.20
diff -C2 -d -r1.19 -r1.20
*** fasta.pm	20 Oct 2005 18:12:16 -0000	1.19
--- fasta.pm	6 Nov 2005 21:32:06 -0000	1.20
***************
*** 48,52 ****
  
  package Bio::AlignIO::fasta;
! use vars qw(@ISA $MATCHPATTERN);
  use strict;
  
--- 48,52 ----
  
  package Bio::AlignIO::fasta;
! use vars qw(@ISA $MATCHPATTERN $WIDTH);
  use strict;
  
***************
*** 57,60 ****
--- 57,61 ----
  
  $MATCHPATTERN = '^A-Za-z\.\-';
+ $WIDTH = 60;
  
  =head2 next_aln
***************
*** 65,74 ****
   Returns : Bio::Align::AlignI object - returns 0 on end of file
  	        or on error
!  Args    : NONE
! 
  =cut
  
  sub next_aln {
  	my $self = shift;
  	my ($start, $end, $name, $seqname, $seq, $seqchar, $entry, 
  		 $tempname, $tempdesc, %align, $desc, $maxlen);
--- 66,78 ----
   Returns : Bio::Align::AlignI object - returns 0 on end of file
  	        or on error
!  Args    : -width => optional argument to specify the width sequence
!                      will be written (60 chars by default)
  =cut
  
  sub next_aln {
  	my $self = shift;
+ 	my ($width) = $self->_rearrange([qw(WIDTH)], at _);
+ 	$self->width($width || $WIDTH);
+ 
  	my ($start, $end, $name, $seqname, $seq, $seqchar, $entry, 
  		 $tempname, $tempdesc, %align, $desc, $maxlen);
***************
*** 138,146 ****
  	unless ( length($seqchar) == 0 && length($seqname) == 0 ) {
  		$seq = new Bio::LocatableSeq(-seq         => $seqchar,
! 											  -display_id  => $seqname,
! 											  -description => $desc,
! 											  -start       => $start,
! 											  -end         => $end,
! 											 );
  		$aln->add_seq($seq);
  	}
--- 142,150 ----
  	unless ( length($seqchar) == 0 && length($seqname) == 0 ) {
  		$seq = new Bio::LocatableSeq(-seq         => $seqchar,
! 					     -display_id  => $seqname,
! 					     -description => $desc,
! 					     -start       => $start,
! 					     -end         => $end,
! 					     );
  		$aln->add_seq($seq);
  	}
***************
*** 171,174 ****
--- 175,179 ----
  sub write_aln {
      my ($self, at aln) = @_;
+     my $width = $self->width;
      my ($seq,$desc,$rseq,$name,$count,$length,$seqsub);
  
***************
*** 186,196 ****
  	    $desc = $rseq->description || '';
  	    $self->_print (">$name $desc\n") or return ;	
! 	    $count =0;
  	    $length = length($seq);
! 	    while( ($count * 60 ) < $length ) {
! 		$seqsub = substr($seq,$count*60,60);
! 		$self->_print ("$seqsub\n") or return ;
! 		$count++;
  	    }
  	}
      }
--- 191,202 ----
  	    $desc = $rseq->description || '';
  	    $self->_print (">$name $desc\n") or return ;	
! 	    $count = 0;
  	    $length = length($seq);
! 	    if(defined $seq && $length > 0) {
! 		$seq =~ s/(.{1,$width})/$1\n/g;
! 	    } else {
! 		$seq = "\n";
  	    }
+ 	    $self->_print($seq);
  	}
      }
***************
*** 213,216 ****
--- 219,241 ----
  	$seq =~ s/[^A-Z]//gi;
  	return CORE::length($seq);
+ }
+ 
+ =head2 width
+ 
+  Title   : width
+  Usage   : $obj->width($newwidth)
+            $width = $obj->width;
+  Function: Get/set width of alignment
+  Returns : integer value of width 
+  Args    : on set, new value (a scalar or undef, optional)
+ 
+ 
+ =cut
+ 
+ sub width{
+     my $self = shift;
+ 
+     return $self->{'_width'} = shift if @_;
+     return $self->{'_width'} || $WIDTH;
  }
  



More information about the Bioperl-guts-l mailing list