[otrs-cvs] otrs/Kernel/cpan-lib/XML TreePP.pm,1.2,1.2.4.1

[CVS commits notifications of OTRS.org]

Comments:
Update of /home/cvs/otrs/Kernel/cpan-lib/XML
In directory lancelot:/tmp/cvs-serv8873/Kernel/cpan-lib/XML

Modified Files:
      Tag: rel-3_0
	TreePP.pm 
Log Message:
Updated XML::TreePP to version 0.41.

Author: mb

Index: TreePP.pm
===================================================================
RCS file: /home/cvs/otrs/Kernel/cpan-lib/XML/TreePP.pm,v
retrieving revision 1.2
retrieving revision 1.2.4.1
diff -2 -u -d -r1.2 -r1.2.4.1
--- TreePP.pm	27 Nov 2009 12:16:10 -0000	1.2
+++ TreePP.pm	21 Jun 2011 07:41:56 -0000	1.2.4.1
@@ -264,5 +264,5 @@
 =head2 lwp_useragent
 
-This option forces pasrsehttp() method to use a L<LWP::UserAgent> instance.
+This option forces parsehttp() method to use a L<LWP::UserAgent> instance.
 
     my $ua = LWP::UserAgent->new();
@@ -310,4 +310,12 @@
 references up to U+007F without xml_deref per default.
 
+=head2 require_xml_decl
+
+This option requires XML declaration at the top of XML document to parse.
+
+    $tpp->set( require_xml_decl => 1 );
+
+This will die when <?xml .../?> declration not found.
+
 =head1 OPTIONS FOR WRITING XML
 
@@ -406,9 +414,16 @@
 Yusuke Kawasaki, http://www.kawa.net/
 
-=head1 COPYRIGHT AND LICENSE
+=head1 COPYRIGHT
 
-Copyright (c) 2006-2009 Yusuke Kawasaki. All rights reserved.
-This program is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself.
+The following copyright notice applies to all the files provided in
+this distribution, including binary files, unless explicitly noted
+otherwise.
+
+Copyright 2006-2010 Yusuke Kawasaki
+
+=head1 LICENSE
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
 
 =cut
@@ -420,5 +435,5 @@
 
 use vars qw( $VERSION );
-$VERSION = '0.39';
+$VERSION = '0.41';
 
 my $XML_ENCODING      = 'UTF-8';
@@ -511,5 +526,4 @@
     $apre = $ATTR_PREFIX unless defined $apre;
     local $self->{__attr_prefix_len} = length($apre);
-#    local $self->{__attr_prefix_rex} = defined $apre ? qr/^\Q$apre\E/s : undef;
     local $self->{__attr_prefix_rex} = $apre;
 
@@ -723,4 +737,9 @@
     }
 
+    # Avoid segfaults when receving random input (RT #42441)
+    if ( exists $self->{require_xml_decl} && $self->{require_xml_decl} ) {
+        return $self->die( "XML declaration not found" ) unless looks_like_xml(\$text);
+    }
+
     my $flat  = $self->xml_to_flat(\$text);
     my $class = $self->{base_class} if exists $self->{base_class};
@@ -969,4 +988,5 @@
     my $prelen = $self->{__attr_prefix_len};
     my $pregex = $self->{__attr_prefix_rex};
+    my $textnk = $self->{text_node_key};
 
     foreach my $keys ( $firstkeys, $allkeys, $lastkeys ) {
@@ -978,4 +998,5 @@
             my $val = $hash->{$key};
             if ( !defined $val ) {
+                next if ($key eq $textnk);
                 push( @$out, "<$key />" );
             }
@@ -1102,8 +1123,17 @@
 }
 
+sub looks_like_xml {
+    my $textref = shift;
+    my $args = ( $$textref =~ /^(?:\s*\xEF\xBB\xBF)?\s*<\?xml(\s+\S.*)\?>/s )[0];
+    if ( ! $args ) {
+        return;
+    }
+    return $args;
+}
+
 sub xml_decl_encoding {
     my $textref = shift;
     return unless defined $$textref;
-    my $args    = ( $$textref =~ /^(?:\s*\xEF\xBB\xBF)?\s*<\?xml(\s+\S.*)\?>/s )[0] or return;
+    my $args    = looks_like_xml($textref) or return;
     my $getcode = ( $args =~ /\s+encoding=(".*?"|'.*?')/ )[0] or return;
     $getcode =~ s/^['"]//;