[Bioperl-guts-l] [14976] bioperl-live/trunk: fixed parsing of # characters so that HTML fragments are not stripped out

[Lincoln Stein]

Revision: 14976
Author:   lstein
Date:     2008-11-01 14:28:15 -0400 (Sat, 01 Nov 2008)

Log Message:
-----------
fixed parsing of # characters so that HTML fragments are not stripped out

Modified Paths:
--------------
    bioperl-live/trunk/Bio/Graphics/FeatureFile.pm
    bioperl-live/trunk/t/BioGraphics.t
    bioperl-live/trunk/t/data/biographics/feature_data.txt

Modified: bioperl-live/trunk/Bio/Graphics/FeatureFile.pm
===================================================================
--- bioperl-live/trunk/Bio/Graphics/FeatureFile.pm	2008-10-30 21:28:26 UTC (rev 14975)
+++ bioperl-live/trunk/Bio/Graphics/FeatureFile.pm	2008-11-01 18:28:15 UTC (rev 14976)
@@ -559,7 +559,8 @@
     my $self = shift;
     local $_ = shift;
 
-    s/\#.*$// unless /\#[0-9a-f]{6}\s*$/i;   # strip right-column comments unless they look like colors
+    # strip right-column comments unless they look like colors or html fragments
+    s/\s*\#.*$// unless /\#[0-9a-f]{6}\s*$/i || /\w+\#\w+/;   
 
     if (/^\s+(.+)/ && $self->{current_tag}) { # configuration continuation line
 	my $value = $1;

Modified: bioperl-live/trunk/t/BioGraphics.t
===================================================================
--- bioperl-live/trunk/t/BioGraphics.t	2008-10-30 21:28:26 UTC (rev 14975)
+++ bioperl-live/trunk/t/BioGraphics.t	2008-11-01 18:28:15 UTC (rev 14976)
@@ -19,7 +19,7 @@
   use lib 't/lib';
   use BioperlTest;
   
-  test_begin(-tests => 42 + (IMAGE_TESTS ? 3 : 0),
+  test_begin(-tests => 45 + (IMAGE_TESTS ? 3 : 0),
              -requires_modules => [qw(GD)]);
   
   use_ok('Bio::Graphics::FeatureFile');
@@ -71,6 +71,11 @@
 is $feature->desc, "Pfam";
 is $feature->score, 20;
 
+# test handling of things that look like comments
+is $data->setting(EST=>'bgcolor'),'yellow';
+is $data->setting(EST=>'fgcolor'),'#EE00FF';
+is $data->setting(EST=>'link'),'http://www.google.com/search?q=$name#results';
+
 # test FeatureBase
 my $bfg   = 'Bio::Graphics::FeatureBase';
 $feature  = $bfg->new(-seq_id=>'chr2',-start=>201,-end=>300,-strand=>1);

Modified: bioperl-live/trunk/t/data/biographics/feature_data.txt
===================================================================
--- bioperl-live/trunk/t/data/biographics/feature_data.txt	2008-10-30 21:28:26 UTC (rev 14975)
+++ bioperl-live/trunk/t/data/biographics/feature_data.txt	2008-11-01 18:28:15 UTC (rev 14976)
@@ -11,7 +11,9 @@
 
 [EST]
 glyph = segments
-bgcolor= yellow
+bgcolor= yellow # this is a comment
+fgcolor = #EE00FF
+link    = http://www.google.com/search?q=$name#results
 connector = solid
 height = 5