New libxml v2.14+ balanced chunk parsing implementation

dwarring · dwarring · commit 7679fe4ea1bb · 2024-11-01T18:24:19.000+13:00
diff --git a/lib/LibXML/DocumentFragment.rakumod b/lib/LibXML/DocumentFragment.rakumod
@@ -2,6 +2,7 @@
 unit class LibXML::DocumentFragment;
 
 use LibXML::Node;
+use LibXML::Enums;
 use LibXML::Raw;
 use LibXML::_ParentNode;
 use LibXML::_Rawish;
@@ -66,13 +67,13 @@ class ParserContext is LibXML::Parser::Context {
     has Int $.stat is rw;
     has Str $.string;
     has Pointer $.user-data;
-    has Pointer[xmlNode] $.nodes is rw .= new();
+    has xmlNode $.nodes is rw;
     my Lock:D $lock .= new;
 
     submethod DESTROY {
         $lock.protect: {
             if $!nodes {
-                $!nodes.deref.FreeList(); ;
+                $!nodes.FreeList();
             }
         }
     }
@@ -81,8 +82,8 @@ class ParserContext is LibXML::Parser::Context {
         my xmlNode $rv;
         $lock.protect: {
             if $!nodes {
-                $rv = $!nodes.deref;
-                $!nodes .= new();
+                $rv = $!nodes;
+                $!nodes = Nil;
             }
         }
         $rv;
@@ -123,7 +124,7 @@ proto method parse(
 
 multi method parse(
   ::?CLASS:U:
-  Str:D() :$string, 
+  Str:D() :$string,
   Bool :balanced($)! where .so,
   Pointer :$user-data,
  |c) is hidden-from-backtrace {
@@ -143,16 +144,31 @@ multi method parse(
     $ctx.do: {
         # simple closures tend to leak on native callbacks. use dynamic variables
         my $ctx := $*XML-CONTEXT;
-        my xmlSAXHandler $sax = .raw with $ctx.sax-handler;
-        my $doc = $ctx.doc-frag.raw.doc;
-        my Pointer $user-data = $ctx.user-data;
-        temp LibXML::Raw.KeepBlanksDefault = $ctx.keep-blanks;
 
-        $ctx.stat = ($doc // xmlDoc).xmlParseBalancedChunkMemoryRecover(
-            ($sax // xmlSAXHandler), ($ctx.user-data // Pointer), 0, $ctx.string, $ctx.nodes, +$ctx.recover
-        );
-    };
+        if $.config.version >= v2.14.0 {
+            my xmlDoc:D $doc = self.raw.doc // xmlDoc.new;
+            my $raw = ($doc.type == XML_HTML_DOCUMENT_NODE
+                ?? htmlParserCtxt.new
+                !! xmlParserCtxt.new);
+            my xmlParserInput $input .= new: :$string;
+            $raw.myDoc = $doc;
+            $ctx.set-raw: $raw;
+            $ctx.nodes = $raw.ParseContent($input, $doc, 0);
+        }
+        else {
+            my xmlSAXHandler $sax = .raw with $ctx.sax-handler;
+            my $doc = $ctx.doc-frag.raw.doc;
+            my Pointer $user-data = $ctx.user-data;
+            temp LibXML::Raw.KeepBlanksDefault = $ctx.keep-blanks;
+            my Pointer[xmlNode] $nodes-p .= new;
+            $ctx.stat = ($doc // xmlDoc).xmlParseBalancedChunkMemoryRecover(
+                            ($sax // xmlSAXHandler), ($ctx.user-data // Pointer), 0, $ctx.string, $nodes-p, +$ctx.recover
+                        );
+            $ctx.nodes = $nodes-p ?? $nodes-p.deref !! Nil;
+        }
 
+        LEAVE .close() with $ctx;
+    }
     # just in case, we didn't catch the error
     die "balanced parse failed with status {$ctx.stat}"
         if $ctx.stat && !$ctx.recover;
diff --git a/lib/LibXML/Raw.rakumod b/lib/LibXML/Raw.rakumod
@@ -382,7 +382,12 @@ class xmlParserInput is export {
     has int32                    $.standalone; # Was that entity marked standalone
     has int32                            $.id; # a unique identifier for the entity
 
+    # since libxml 2.14.0
+    our sub NewFromString(Str $url, Str $str, int32 $flags --> ::?CLASS) is native($XML2) is symbol('xmlNewInputFromString') {*}
     method Free is native($XML2) is symbol('xmlFreeInputStream') {*}
+    method new(Str:D :$string!, Str :$url, UInt:D :$flags = 0) {
+        NewFromString($url, $string, $flags);
+    }
 }
 
 #| An XML Element content as stored after parsing an element definition
@@ -1632,6 +1637,8 @@ class xmlParserCtxt is export {
     method UseOptions(int32 --> int32) is native($XML2) is symbol('xmlCtxtUseOptions') { * }
     method NewInputStream(xmlParserInputBuffer, int32 $enc --> xmlParserInput) is native($XML2) is symbol('xmlNewIOInputStream') is export {*}
     method NewInputFile(Str --> xmlParserInput) is native($XML2) is export is symbol('xmlNewInputFromFile') {*}
+    # available since libxml2 v2.14.0
+    method ParseContent(xmlParserInput, xmlNode, int32 $has-text-decl --> xmlNode) is native($XML2) is export is symbol('xmlCtxtParseContent') {*}
     # deprecated
     method SetStructuredErrorFunc( &error-func (xmlParserCtxt $, xmlError $)) is native($XML2) is symbol('xmlSetStructuredErrorFunc') {*};
     # recommended libxml 2.13.0+
diff --git a/t/02parse.t b/t/02parse.t
@@ -124,8 +124,7 @@ my %goodPushWF = (
 );
 
 my $goodfile = "samples/dromeds.xml";
-my $badfile1 = "samples/bad.xml";
-my $badfile2 = "does_not_exist.xml";
+my $badfile = "samples/bad.xml";
 
 my LibXML $parser .= new();
 
@@ -201,7 +200,7 @@ subtest 'pedantic-parser', {
 subtest 'parse :file', {
     lives-ok {my LibXML::Document:D $ = $parser.parse(:file($goodfile));}
 
-    throws-like( { $parser.parse(:file($badfile1))},
+    throws-like( { $parser.parse(:file($badfile))},
                  X::LibXML::Parser,
                  "Error thrown with bad xml file");
 
@@ -231,12 +230,12 @@ else {
         isa-ok $io, IO::Handle;
         lives-ok {my LibXML::Document:D $ = $parser.parse: :$io;}
 
-        $io = $badfile1.IO;
+        $io = $badfile.IO;
         isa-ok $io, IO::Path;
         throws-like(
             { $parser.parse: :$io; },
             X::LibXML::Parser, :message(rx/:s Extra content at the end of the document/),
-            "error parsing bad file from file handle of $badfile1"
+            "error parsing bad file from file handle of $badfile"
         );
     }
 }
@@ -301,7 +300,7 @@ subtest 'x-include processing', {
     throws-like { $doc = $parser.parse: :string( $badXInclude ); },
         X::LibXML::Parser,
         :message(rx/'samples/bad.xml:3: parser error : Extra content at the end of the document'/),
-         "error parsing $badfile1 in include";
+         "error parsing $badfile in include";
     ok !$doc.defined, "no doc returned";
 
     # some bad stuff
@@ -536,7 +535,6 @@ subtest 'parse well balanced chunks', {
         "<ouch>",
         "<ouch>bar",
         "bar</ouch>",
-        "<ouch/>&foo;", # undefined entity
         "&",            # bad char
        ## "h\x[e4]h?",         # bad encoding
         "<!--->",       # bad stays bad ;)
@@ -564,7 +562,7 @@ subtest 'parse well balanced chunks', {
                         next;
                     }
                 }
-                fail("Unexpected fragment without child nodes");
+                flunk("Unexpected fragment without child nodes");
             }
         }
 
@@ -916,5 +914,3 @@ subtest 'Perl fossil', {
     };
    
 }
-
-
