[Bioperl-guts-l] bioperl commit

[Jason Stajich]

jason
Sun Sep 19 23:13:17 EDT 2004
Update of /home/repository/bioperl/bioperl-live/Bio/Tree
In directory pub.open-bio.org:/tmp/cvs-serv3691/Bio/Tree

Modified Files:
	NodeI.pm Node.pm 
Log Message:
support new method for auto-quoting ids which have normally unallowed values in node ids and labels

bioperl-live/Bio/Tree NodeI.pm,1.26,1.27 Node.pm,1.33,1.34
===================================================================
RCS file: /home/repository/bioperl/bioperl-live/Bio/Tree/NodeI.pm,v
retrieving revision 1.26
retrieving revision 1.27
diff -u -r1.26 -r1.27
--- /home/repository/bioperl/bioperl-live/Bio/Tree/NodeI.pm	2003/09/25 16:07:44	1.26
+++ /home/repository/bioperl/bioperl-live/Bio/Tree/NodeI.pm	2004/09/20 03:13:17	1.27
@@ -226,7 +226,7 @@
 
 sub to_string{
    my ($self) = @_;
-   return join('',defined $self->id ? $self->id : '',
+   return join('',defined $self->id_output ? $self->id_output : '',
 		  defined $self->branch_length ? ':' . $self->branch_length 
 		  : ' ')
 }
@@ -468,4 +468,33 @@
     shift->throw_not_implemented();
 }
 
+ 
+=head2 Helper Functions
+
+
+=head2 id_output
+
+ Title   : id_output
+ Usage   : my $id = $node->id_output;
+ Function: Return an id suitable for output in format like newick
+           so that if it contains spaces or ():; characters it is properly 
+           quoted
+ Returns : $id string if $node->id has a value
+ Args    : none
+
+
+=cut
+
+sub id_output{
+    my $node = shift;
+    my $id = $node->id;
+    return unless( defined $id && length($id ) );
+    # single quotes must become double quotes
+    # $id =~ s/'/''/g;
+    if( $id =~ /[\(\);:,\s]/ ) {
+	$id = '"'.$id.'"';
+    }
+    return $id;
+}
+
 1;

===================================================================
RCS file: /home/repository/bioperl/bioperl-live/Bio/Tree/Node.pm,v
retrieving revision 1.33
retrieving revision 1.34
diff -u -r1.33 -r1.34
--- /home/repository/bioperl/bioperl-live/Bio/Tree/Node.pm	2004/07/18 17:25:58	1.33
+++ /home/repository/bioperl/bioperl-live/Bio/Tree/Node.pm	2004/09/20 03:13:17	1.34
@@ -380,29 +380,51 @@
  Function: The human readable identifier for the node 
  Returns : value of human readable id
  Args    : newvalue (optional)
- Note    : id cannot contain the chracters '();:'
 
 "A name can be any string of printable characters except blanks,
 colons, semicolons, parentheses, and square brackets. Because you may
 want to include a blank in a name, it is assumed that an underscore
 character ("_") stands for a blank; any of these in a name will be
-converted to a blank when it is read in."
+converted to a blank when it is read in."  
 
 from L<http://evolution.genetics.washington.edu/phylip/newicktree.html>
 
+Also note that these objects now support spaces, ();: because we can
+automatically quote the strings if they contain these characters.  The
+L<output_id()> method does this for you so use the id() method to get
+the raw string while L<output_id()> to get the pre-escaped string.
+
 =cut
 
 sub id{
     my ($self, $value) = @_;
     if ($value) {
-        $self->warn("Illegal characters ();:  and space in the id [$value], converting to _ ")
-            if $value =~ /\(\);:/ and $self->verbose >= 0;
-        $value =~ s/[\(\);:\s]/_/g;
+        #$self->warn("Illegal characters ();:  and space in the id [$value], converting to _ ")
+	# if $value =~ /\(\);:/ and $self->verbose >= 0;
+        #$value =~ s/[\(\);:\s]/_/g;
         $self->{'_id'} = $value;
     }
     return $self->{'_id'};
 }
 
+=head2 Helper Functions
+
+
+=head2 id_output
+
+ Title   : id_output
+ Usage   : my $id = $node->id_output;
+ Function: Return an id suitable for output in format like newick
+           so that if it contains spaces or ():; characters it is properly 
+           quoted
+ Returns : $id string if $node->id has a value
+ Args    : none
+
+
+=cut
+
+# implemented in NodeI interface 
+
 =head2 internal_id
 
  Title   : internal_id
@@ -642,4 +664,5 @@
     $self->{'_desc'} = {};
 }
 
+
 1;