diff options
author | dakkar <dakkar@thenautilus.net> | 2015-09-15 16:38:40 +0100 |
---|---|---|
committer | dakkar <dakkar@thenautilus.net> | 2015-09-15 16:38:40 +0100 |
commit | 38de66122cc36d5f1d457760864d0931696ed06e (patch) | |
tree | a6f5c197489a11ff03cdda530ea527767ebd73a5 | |
parent | filesets! don't work (diff) | |
download | WebCoso-p6-master.tar.gz WebCoso-p6-master.tar.bz2 WebCoso-p6-master.zip |
-rw-r--r-- | lib/XML/LibXML.pm | 50 | ||||
-rw-r--r-- | t/tests/xml.t | 19 |
2 files changed, 69 insertions, 0 deletions
diff --git a/lib/XML/LibXML.pm b/lib/XML/LibXML.pm new file mode 100644 index 0000000..a9c8fbb --- /dev/null +++ b/lib/XML/LibXML.pm @@ -0,0 +1,50 @@ +# -*- mode: perl6 -*- +use NativeCall; + +class XML::LibXML::Node is repr('CStruct') { + sub xmlFreeNode(XML::LibXML::Node $doc) is native('libxml2') {*} + submethod DESTROY { xmlFreeNode(self) } + + has Pointer $!_private; + has int $.xmlElementType; + has Str $.name; + # etc etc, don't try to create this +} + +class XML::LibXML::Document is repr('CPointer') { + sub xmlFreeDoc(XML::LibXML::Document $doc) is native('libxml2') {*} + submethod DESTROY { xmlFreeDoc(self) } + + sub xmlDocGetRootElement(XML::LibXML::Document $doc) + returns XML::LibXML::Node is native('libxml2') {*} + method rootElement() { + return xmlDocGetRootElement(self); + } +} + +class XML::LibXML::Context is repr('CStruct') { + sub xmlFreeParserCtxt(XML::LibXML::Context $ctxt) is native('libxml2') {*} + submethod DESTROY { xmlFreeParserCtxt(self) } + + sub xmlParseDocument(XML::LibXML::Context $ctxt) is native('libxml2') {*} + method parse() { xmlParseDocument(self) } + + has Pointer $!sax; # currently unused + has Pointer $!userData; # useless? + has XML::LibXML::Document $.myDoc; + # etc etc, don't try to create this +} + +class XML::LibXML { + sub xmlCreateMemoryParserCtxt(Blob $docbuf, int $len) returns XML::LibXML::Context is native('libxml2') {*} + + method parse(Str $docstring) { + my Blob $docbuf = $docstring.encode('utf8'); + my $ctxt = xmlCreateMemoryParserCtxt( + $docbuf, + $docbuf.bytes, + ); + $ctxt.parse(); + return $ctxt.myDoc; + } +} diff --git a/t/tests/xml.t b/t/tests/xml.t new file mode 100644 index 0000000..0a147b4 --- /dev/null +++ b/t/tests/xml.t @@ -0,0 +1,19 @@ +# -*- mode: perl6 -*- +use Test; +use lib 't/lib'; +use XML::LibXML; + +my XML::LibXML $p .= new; +my $d = $p.parse(q:to/XML/); +<?xml version="1.0"?> +<rootNode/> +XML + +is( + $d.rootElement.name, + 'rootNode', + 'parsed ok', +); + +done-testing; + |