Bug #68575 for XML-LibXML:

XML::LibXML::Error contains a mapping from libxml2 error domains to descriptive strings. If XML::LibXML is run against a newer version of libxml2 than the one it was written for, and that newer version adds additional error domains, you get scary-looking uninitialized-value warnings. The attached patch set does the following: - Invent a spurious descriptive string if the real value is unknown (with tests) - Add several error domains added in newer versions of libxml2 - Cleans up one or two minor issues in the vicinity

From cba05f39fdd6b46e6bfa13b3e4c2e55da769868f Mon Sep 17 00:00:00 2001 From: Aaron Crane <arc@cpan.org> Date: Sun, 29 May 2011 17:08:50 +0100 Subject: [PATCH 5/5] XML::LibXML::Error: avoid "malformed UTF-8" warnings When we're generating an error message describing character-encoding problems in the input, it's particularly inappropriate to also allow Perl to emit warnings about those problems (which can't even be fixed by XML::LibXML itself). So disable UTF-8-related warnings in the appropriate place. This makes the test suite run warning-free on my system. --- lib/XML/LibXML/Error.pm | 6 ++++++ 1 files changed, 6 insertions(+), 0 deletions(-) diff --git a/lib/XML/LibXML/Error.pm b/lib/XML/LibXML/Error.pm index 8d23cdb..d8f07bc 100644 --- a/lib/XML/LibXML/Error.pm +++ b/lib/XML/LibXML/Error.pm @@ -214,6 +214,12 @@ sub as_string { $msg.=$self->{str1}."\n"; $msg.=(" " x $self->{num1})."^\n"; } elsif (defined $self->{context}) { + # If the error relates to character-encoding problems in the context, + # then doing textual operations on it will spew warnings that + # XML::LibXML can do nothing to fix. So just disable all such + # warnings. This has the pleasing benefit of making the test suite + # run warning-free. + no warnings 'utf8'; my $context = $self->{context}; $msg.=$context."\n"; $context = substr($context,0,$self->{column}); -- 1.7.5

From f761cbddbf1fa4050ef620fc6a0f90baf38d05e2 Mon Sep 17 00:00:00 2001 From: Aaron Crane <arc@cpan.org> Date: Sun, 29 May 2011 12:46:29 +0100 Subject: [PATCH 3/5] XML::LibXML::Error: make ->domain work for unknown domains --- lib/XML/LibXML/Error.pm | 7 +++++-- t/60struct_error.t | 14 +++++++++++++- 2 files changed, 18 insertions(+), 3 deletions(-) diff --git a/lib/XML/LibXML/Error.pm b/lib/XML/LibXML/Error.pm index cfc06d0..b008edf 100644 --- a/lib/XML/LibXML/Error.pm +++ b/lib/XML/LibXML/Error.pm @@ -163,7 +163,10 @@ sub int2 { $_[0]->num2 } sub domain { my ($self)=@_; return undef unless ref($self); - return $error_domains[$self->{domain}]; + my $domain = $self->{domain}; + # Newer versions of libxml2 might yield errors in domains that aren't + # listed above. Invent something reasonable in that case. + return $domain < @error_domains ? $error_domains[$domain] : "domain_$domain"; } sub as_string { @@ -195,7 +198,7 @@ sub as_string { $where.=": element ".$self->{nodename}; } $msg.=$where.": " if $where ne ""; - $msg.=$error_domains[$self->{domain}]." ".$level." :"; + $msg.=$self->domain." ".$level." :"; my $str=$self->{message}||""; chomp($str); $msg.=" ".$str."\n"; diff --git a/t/60struct_error.t b/t/60struct_error.t index 50eb16b..44c3f0e 100644 --- a/t/60struct_error.t +++ b/t/60struct_error.t @@ -5,7 +5,7 @@ use Test; BEGIN { use XML::LibXML; if ( XML::LibXML::HAVE_STRUCT_ERRORS() ) { - plan tests => 6; + plan tests => 8; } else { plan tests => 1; } @@ -37,4 +37,16 @@ if (XML::LibXML::HAVE_STRUCT_ERRORS() ) { fail() for 1..3; } + my $fake_err = XML::LibXML::Error->new('fake error'); + my $domain_num = @XML::LibXML::Error::error_domains; # too big + $fake_err->{domain} = $domain_num; # white-box test + ok($fake_err->domain, "domain_$domain_num", + '$err->domain is reasonable on unknown domain'); + { + my $warnings = 0; + local $SIG{__WARN__} = sub { $warnings++; warn "@_\n" }; + my $s = $fake_err->as_string; + ok($warnings, 0, + 'no warnings when stringifying unknown-domain error'); + } } # HAVE_STRUCT_ERRORS -- 1.7.5

From af8b843395c94f48116dd5f5540c446d3d04600e Mon Sep 17 00:00:00 2001 From: Aaron Crane <arc@cpan.org> Date: Sun, 29 May 2011 12:38:26 +0100 Subject: [PATCH 1/5] XML::LibXML::Error: no need to AUTOLOAD ->domain There's an explicit method with that name. --- lib/XML/LibXML/Error.pm | 2 +- 1 files changed, 1 insertions(+), 1 deletions(-) diff --git a/lib/XML/LibXML/Error.pm b/lib/XML/LibXML/Error.pm index b60d6cf..38546ae 100644 --- a/lib/XML/LibXML/Error.pm +++ b/lib/XML/LibXML/Error.pm @@ -154,7 +154,7 @@ sub AUTOLOAD { return undef unless ref($self); my $sub = $AUTOLOAD; $sub =~ s/.*:://; - if ($sub=~/^(?:code|_prev|level|file|line|domain|nodename|message|column|context|str[123]|num[12])$/) { + if ($sub=~/^(?:code|_prev|level|file|line|nodename|message|column|context|str[123]|num[12])$/) { return $self->{$sub}; } else { croak("Unknown error field $sub"); -- 1.7.5

From 90421450ff684e23938751622e83c9ddbbb8ac12 Mon Sep 17 00:00:00 2001 From: Aaron Crane <arc@cpan.org> Date: Sun, 29 May 2011 12:54:02 +0100 Subject: [PATCH 4/5] XML::LibXML::Error: add domains from newer libxml2 --- lib/XML/LibXML/Error.pm | 11 +++++++++-- 1 files changed, 9 insertions(+), 2 deletions(-) diff --git a/lib/XML/LibXML/Error.pm b/lib/XML/LibXML/Error.pm index b008edf..8d23cdb 100644 --- a/lib/XML/LibXML/Error.pm +++ b/lib/XML/LibXML/Error.pm @@ -52,14 +52,21 @@ use constant XML_ERR_FROM_RELAXNGV => 19; # The Relax-NG validator module use constant XML_ERR_FROM_CATALOG => 20; # The Catalog module use constant XML_ERR_FROM_C14N => 21; # The Canonicalization module use constant XML_ERR_FROM_XSLT => 22; # The XSLT engine from libxslt -use constant XML_ERR_FROM_VALID => 23; # The validaton module +use constant XML_ERR_FROM_VALID => 23; # The DTD validation module with valid context +use constant XML_ERR_FROM_CHECK => 24; # The error-checking module +use constant XML_ERR_FROM_WRITER => 25; # The xmlwriter module +use constant XML_ERR_FROM_MODULE => 26; # The dynamically-loaded module module +use constant XML_ERR_FROM_I18N => 27; # The module handling character conversion +use constant XML_ERR_FROM_SCHEMATRONV=> 28; # The Schematron validator module @error_domains = ("", "parser", "tree", "namespace", "validity", "HTML parser", "memory", "output", "I/O", "ftp", "http", "XInclude", "XPath", "xpointer", "regexp", "Schemas datatype", "Schemas parser", "Schemas validity", "Relax-NG parser", "Relax-NG validity", - "Catalog", "C14N", "XSLT", "validity"); + "Catalog", "C14N", "XSLT", "validity", "error-checking", + "xmlwriter", "dynamic loading", "i18n", + "Schematron validity"); for my $field (qw<code _prev level file line nodename message column context str1 str2 str3 num1 num2>) { -- 1.7.5

From 498a74e696bd1db6a203d5afeee52e7c993a7600 Mon Sep 17 00:00:00 2001 From: Aaron Crane <arc@cpan.org> Date: Sun, 29 May 2011 12:41:23 +0100 Subject: [PATCH 2/5] XML::LibXML::Error: avoid AUTOLOAD Just generate the needed methods directly, rather than waiting until they're called. The two main benefits of doing this are (a) there's rather less code needed this way, and (b) the ->can method now works correctly. (Alternatively, it would be possible to override ->can to respond appropriately to the same things that AUTOLOAD would, but that just continues to add code.) --- lib/XML/LibXML/Error.pm | 23 ++++++++--------------- 1 files changed, 8 insertions(+), 15 deletions(-) diff --git a/lib/XML/LibXML/Error.pm b/lib/XML/LibXML/Error.pm index 38546ae..cfc06d0 100644 --- a/lib/XML/LibXML/Error.pm +++ b/lib/XML/LibXML/Error.pm @@ -9,7 +9,7 @@ package XML::LibXML::Error; use strict; -use vars qw($AUTOLOAD @error_domains $VERSION $WARNINGS); +use vars qw(@error_domains $VERSION $WARNINGS); use Carp; use overload '""' => \&as_string, @@ -61,6 +61,13 @@ use constant XML_ERR_FROM_VALID => 23; # The validaton module "Relax-NG parser", "Relax-NG validity", "Catalog", "C14N", "XSLT", "validity"); +for my $field (qw<code _prev level file line nodename message column context + str1 str2 str3 num1 num2>) { + my $method = sub { $_[0]{$field} }; + no strict 'refs'; + *$field = $method; +} + { sub new { @@ -149,24 +156,10 @@ use constant XML_ERR_FROM_VALID => 23; # The validaton module } -sub AUTOLOAD { - my $self=shift; - return undef unless ref($self); - my $sub = $AUTOLOAD; - $sub =~ s/.*:://; - if ($sub=~/^(?:code|_prev|level|file|line|nodename|message|column|context|str[123]|num[12])$/) { - return $self->{$sub}; - } else { - croak("Unknown error field $sub"); - } -} - # backward compatibility sub int1 { $_[0]->num1 } sub int2 { $_[0]->num2 } -sub DESTROY {} - sub domain { my ($self)=@_; return undef unless ref($self); -- 1.7.5