fix perl_to_xml for blessed objects inside arrays

karpet · Nov 15, 2013 · 643d350 · 643d350
1 parent b987172
commit 643d350
Show file tree

Hide file tree

Showing 3 changed files with 31 additions and 4 deletions.
diff --git a/Changes b/Changes
@@ -2,6 +2,7 @@ Revision history for Perl extension Search::HiLiter.
 
 0.98 xxx
  - add new method as_sentences() to TokenListUtils
+ - fix perl_to_xml for blessed objects
 
 0.97 4 Oct 2013
  - fix_cp1252_codepoints_in_utf8 now operates on bytes internally in regex

diff --git a/lib/Search/Tools/XML.pm b/lib/Search/Tools/XML.pm
@@ -878,12 +878,22 @@ sub _array_to_xml {
     my ( $self, $perl, $root, $xml_ref, $strip_plural, $escape, $wrap_array )
         = @_;
     for my $thing (@$perl) {
-        if ( ref $thing and length($root) and $wrap_array ) {
+        if (    ref $thing
+            and ( ref $thing eq 'ARRAY' or ref $thing eq 'HASH' )
+            and length($root)
+            and $wrap_array )
+        {
+            #warn "<$root> ref $thing == " . ref($thing);
             $$xml_ref .= $self->start_tag($root);
         }
         $self->_ref_to_xml( $thing, $root, $xml_ref, $strip_plural, $escape,
             $wrap_array );
-        if ( ref $thing and length($root) and $wrap_array ) {
+        if (    ref $thing
+            and ( ref $thing eq 'ARRAY' or ref $thing eq 'HASH' )
+            and length($root)
+            and $wrap_array )
+        {
+            #warn "</$root> ref $thing == " . ref($thing);
             $$xml_ref .= $self->end_tag($root);
         }
     }

diff --git a/t/30-perl-to-xml.t b/t/30-perl-to-xml.t
@@ -2,11 +2,19 @@
 
 use strict;
 use warnings;
-use Test::More tests => 9;
+use Test::More tests => 10;
 use Data::Dump qw( dump );
 use Search::Tools::XML;
 my $utils = 'Search::Tools::XML';
 
+{
+
+    package My::Blessed::Object;
+    use overload
+        '""'     => sub { ref shift },
+        fallback => 1;
+}
+
 my $data1 = {
     foo   => 'bar',
     array => [
@@ -38,6 +46,7 @@ my $data2 = {
                 }
             ],
         },
+        bless( {}, "My::Blessed::Object" ),
         'red', 'blue',
     ],
 };
@@ -46,8 +55,15 @@ my $data2 = {
 ok( my $data2_xml = $utils->perl_to_xml( $data2, 'data2', 1 ),
     "data2 to xml" );
 
-like( $data2_xml, qr(<arrays count="5">),       "data2 xml" );
+#diag( $utils->tidy($data2_xml) );
+
+like( $data2_xml, qr(<arrays count="6">),       "data2 xml" );
 like( $data2_xml, qr(<foos count="1">.*?<foo>), "data2 xml" );
+like(
+    $data2_xml,
+    qr(<array>My::Blessed::Object</array>),
+    "data2 xml blessed object"
+);
 
 ################
 # new style