[Bioperl-guts-l] [14804] bioperl-live/trunk/Bio: added nowarnonempty arg to Bio::PrimarySeq

miraceti at dev.open-bio.org miraceti at dev.open-bio.org
Fri Aug 15 17:57:41 EDT 2008


Revision: 14804
Author:   miraceti
Date:     2008-08-15 17:57:41 -0400 (Fri, 15 Aug 2008)

Log Message:
-----------
added nowarnonempty arg to Bio::PrimarySeq

Modified Paths:
--------------
    bioperl-live/trunk/Bio/PrimarySeq.pm
    bioperl-live/trunk/Bio/TreeIO/phyloxml.pm

Modified: bioperl-live/trunk/Bio/PrimarySeq.pm
===================================================================
--- bioperl-live/trunk/Bio/PrimarySeq.pm	2008-08-15 19:39:05 UTC (rev 14803)
+++ bioperl-live/trunk/Bio/PrimarySeq.pm	2008-08-15 21:57:41 UTC (rev 14804)
@@ -152,6 +152,7 @@
            -alphabet    => sequence type (alphabet) (dna|rna|protein)
            -id          => alias for display id
            -is_circular => boolean field for whether or not sequence is circular
+           -nowarnonempty => boolean field for whether or not to warn when sequence is empty
 
 =cut
 
@@ -159,10 +160,11 @@
 sub new {
     my ($class, @args) = @_;
     my $self = $class->SUPER::new(@args);
+    $self->verbose(1);
 
     my($seq,$id,$acc,$pid,$ns,$auth,$v,$oid,
        $desc,$description,
-       $alphabet,$given_id,$is_circular,$direct,$ref_to_seq,$len) =
+       $alphabet,$given_id,$is_circular,$direct,$ref_to_seq,$len,$nowarnonempty) =
 	$self->_rearrange([qw(SEQ
 			      DISPLAY_ID
 			      ACCESSION_NUMBER
@@ -179,13 +181,19 @@
 			      DIRECT
 			      REF_TO_SEQ
 			      LENGTH
+            NOWARNONEMPTY
 			      )],
 			  @args);
+  
+    # nowarnonempty: private var, no need for accessor
+    # but need to be set before calling _guess_alphabet
+    $self->{'nowarnonempty'} = $nowarnonempty; 
+
     if( defined $id && defined $given_id ) {
-		 if( $id ne $given_id ) {
-			 $self->throw("Provided both id and display_id constructor ".
-							  "functions. [$id] [$given_id]");
-		 }
+      if( $id ne $given_id ) {
+        $self->throw("Provided both id and display_id constructor ".
+            "functions. [$id] [$given_id]");
+      }
     }
     if( defined $given_id ) { $id = $given_id; }
 
@@ -201,10 +209,10 @@
     # and sequence is ok
 
     if( $direct && $ref_to_seq) {
-		 $self->{'seq'} = $$ref_to_seq;
-		 if( ! $alphabet ) {
-		     $self->_guess_alphabet();
-		 } # else it has been set already above
+      $self->{'seq'} = $$ref_to_seq;
+        if( ! $alphabet ) {
+          $self->_guess_alphabet();
+        } # else it has been set already above
     } else {
 		 #	print STDERR "DEBUG: setting sequence to [$seq]\n";
 		 # note: the sequence string may be empty
@@ -222,6 +230,7 @@
     defined($v)  && $self->version($v);
     defined($oid) && $self->object_id($oid);
 
+
     return $self;
 }
 
@@ -626,6 +635,7 @@
     return $self->{'is_circular'};
 }
 
+
 =head1 Methods for Bio::IdentifiableI compliance
 
 =cut
@@ -831,9 +841,11 @@
 
    my $total = CORE::length($str);
    if( $total == 0 ) {
+     if (!$self->{'nowarnonempty'}) {
        $self->warn("Got a sequence with no letters in it ".
-		   "cannot guess alphabet");
-       return '';
+           "cannot guess alphabet");
+     }
+     return '';
    }
 
    my $u = ($str =~ tr/Uu//);

Modified: bioperl-live/trunk/Bio/TreeIO/phyloxml.pm
===================================================================
--- bioperl-live/trunk/Bio/TreeIO/phyloxml.pm	2008-08-15 19:39:05 UTC (rev 14803)
+++ bioperl-live/trunk/Bio/TreeIO/phyloxml.pm	2008-08-15 21:57:41 UTC (rev 14804)
@@ -688,7 +688,9 @@
           my @strac = $molseq[0]->get_Annotations('_text');
           $str = $strac[0]->value();
         }
-        my $newseq = Bio::Seq->new(-seq => $str, -annotation=>$ac);
+        my $newseq = Bio::Seq->new( -seq => $str, 
+                                    -annotation=>$ac, 
+                                    -nowarnonempty=>1);
         $tnode->sequence($newseq);
         $ac->remove_Annotations('mol_seq');
         $tnode->annotation->remove_Annotations($current);




More information about the Bioperl-guts-l mailing list