Fix Yahoo::Search::XML to return UTF-8 strings. RT#45029 RT#35213 RT#…

…31618 Also improve error message handling.
timbunce · Jun 11, 2010 · 677f719 · 677f719
1 parent 0a82527
commit 677f719
Show file tree

Hide file tree

Showing 5 changed files with 29 additions and 7 deletions.
diff --git a/Changes b/Changes
@@ -4,6 +4,10 @@ Changes - List of significant changes to Yahoo::Search
 
 =head2 Changes in 1.11.1
 
+    Fixed to return UTF-8 strings when using the default internal
+        Yahoo::Search::XML parser, like it does when using the XML::Simple
+        parser.  Added tests for same. RT#45029 RT#35213 RT#31618
+
     Added support for Region parameter thanks to Hendrik Weimer.
         RT#54591
 

diff --git a/dist.ini b/dist.ini
@@ -11,6 +11,8 @@ copyright_holder = Tim Bunce <Tim.Bunce@pobox.com>
 LWP::UserAgent = 5.835
 HTTP::Request = 5.835
 URI = 1.54
+Encode = 0
+Test::More = 0.86
 
 [NextRelease]
 [MetaJSON]

diff --git a/lib/Yahoo/Search/Request.pm b/lib/Yahoo/Search/Request.pm
@@ -302,23 +302,23 @@ sub Fetch
             ##
             if (not _have_XML_Simple())
             {
-                warn "Yahoo::Search::XML is having trouble with the XML returned from Yahoo; try installing XML::Simple and setting \$Yahoo::Search::UseXmlSimple to true, and filing a bug report with jfriedl\@yahoo.com.\n";
+                warn "Yahoo::Search::XML is having trouble with the XML returned from Yahoo ($orig_error); try installing XML::Simple and setting \$Yahoo::Search::UseXmlSimple to true, and filing a bug report.\n";
                 $@ = "Yahoo::Request: Error processing XML: $orig_error";
                 return ();
             }
 
             $ResultHash = eval { XML::Simple::XMLin($xml) };
 
             if (not $ResultHash) {
-                $@ = "Yahoo::Request: Error processing XML (even tried XML::Simple): $orig_error";
+                $@ .= "Yahoo::Request: Error processing XML (even tried XML::Simple): $orig_error";
                 return ();
             }
             ##
             ## XML::Simple could parse it, but Yahoo::Search::XML couldn't,
             ## so it must be a bug with the former... )_:
             ##
             $Yahoo::Search::UseXmlSimple = 1;
-            warn "Yahoo::Search::XML is having trouble with the XML returned from Yahoo, so reverting to XML::Simple; suggest setting \$Yahoo::Search::UseXmlSimple to true and filing a bug report with jfriedl\@yahoo.com.\n";
+            warn "Yahoo::Search::XML is having trouble with the XML returned from Yahoo ($orig_error), so reverting to XML::Simple; suggest setting \$Yahoo::Search::UseXmlSimple to true and filing a bug report.\n";
         }
     }
 

diff --git a/lib/Yahoo/Search/XML.pm b/lib/Yahoo/Search/XML.pm
@@ -1,8 +1,11 @@
 package Yahoo::Search::XML;
 use strict;
+use Encode;
 
 our $VERSION = "20060729.004";
 
+my %enc_cache;
+
 ##
 ## Version history:
 ##
@@ -169,8 +172,18 @@ sub Parse($)
 
     @stack = {};
 
-    ## skip past the leading <?xml> tag
-    $xml =~ m/\A <\?xml.*?> /xgcs;
+    ## skip past the leading <?xml version="1.0" encoding="UTF-8"?> tag
+    if ($xml =~ m/\A <\?xml(.*?)> /xgcs) {
+        my $xml_header = $1;
+        if ($xml_header =~ /encoding="(.*?)"/) {
+            my $enc = $enc_cache{$1} = find_encoding($1);
+            # decode the bytes into a perl utf8 string
+            # taking care to preserve the pos-ition.
+            my $pos = pos($xml);
+            $xml = $enc->decode($xml);
+            pos($xml) = $pos;
+        }
+    }
 
     while (pos($xml) < length($xml))
     {

diff --git a/t/20-utf8.t b/t/20-utf8.t
@@ -13,7 +13,9 @@ my $utf8_string = "dudenstraße";
 ok Encode::is_utf8($utf8_string, 1), 'is_utf8';
 my $count = 2;
 
-for $Yahoo::Search::UseXmlSimple (0, 1) {
+for my $UseXmlSimple (0, 1) {
+    $Yahoo::Search::UseXmlSimple = $UseXmlSimple;
+    note "Testing with Yahoo::Search::UseXmlSimple = $Yahoo::Search::UseXmlSimple\n";
 
     my @Results = Yahoo::Search->Results(
         Doc => $utf8_string,
@@ -23,10 +25,11 @@ for $Yahoo::Search::UseXmlSimple (0, 1) {
         skip "$@", 3 if !@Results && $@;
 
         is @Results, $count;
+        #print Dumper(\@Results);
 
         my @Summary = map { $_->Summary } @Results;
         is @Summary, $count, 'got summaries';
-        print Dumper(\@Summary);
+        #print Dumper(\@Summary);
 
         #use DBI; warn DBI::neat_list(\@Summary);
         my @utf8_matches = grep { Encode::is_utf8($_, 1) } @Summary;