From 5c2c31781078b6474459f3120d04374ee6df56ac Mon Sep 17 00:00:00 2001 From: "Skylar \"The Cobra\" Widulski" Date: Sat, 16 Dec 2023 11:32:26 -0500 Subject: [PATCH] Move libxml2.scm to its own repo Signed-off-by: Skylar "The Cobra" Widulski --- .gitmodules | 3 + README.md | 16 ++++ libxml2.scm | 210 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 229 insertions(+) create mode 100644 .gitmodules create mode 100644 README.md create mode 100644 libxml2.scm diff --git a/.gitmodules b/.gitmodules new file mode 100644 index 0000000..aee3240 --- /dev/null +++ b/.gitmodules @@ -0,0 +1,3 @@ +[submodule "gumbo-libxml"] + path = gumbo-libxml + url = https://github.com/nostrademons/gumbo-libxml diff --git a/README.md b/README.md new file mode 100644 index 0000000..b2d7f4f --- /dev/null +++ b/README.md @@ -0,0 +1,16 @@ +# guile-libxml2 +`guile-libxml2` is a small binding library for Guile Scheme. I strongly recommend you do not use this in your own project, because it is nowhere near complete, and likely will never be. It only really exists for my front-ends. + +# Building gumbo-libxml +1. `cd` into `gumbo-libxml` +2. Run the following +```bash +$ ./autogen.sh +$ ./configure +$ make +``` + +# Environment +`LIBXML2_LOCATION` - Path to `libxml2.so` (default `libxml2`, which checks `LD_LIBRARY_PATH`). + +`GUMBO_LIBXML_LOCATION` - Path to `libgumbo_xml.so` (default `./gumbo-libxml/.libs/libgumbo_xml.so`, can be edited to `libgumbo_xml`, which does the same thing as `libxml2` in `LIBXML2_LOCATION`) diff --git a/libxml2.scm b/libxml2.scm new file mode 100644 index 0000000..6065d8d --- /dev/null +++ b/libxml2.scm @@ -0,0 +1,210 @@ +;; Copyright (C) 2023 Skylar Widulski +;; +;; This file is part of MeMe +;; +;; MeMe is free software: you can redistribute it and/or modify it under the +;; terms of the GNU Affero General Public License as published by the Free +;; Software Foundation, either version 3 of the License, or (at your option) any +;; later version. +;; +;; This program is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License +;; for more details. +;; +;; You should have received a copy of the GNU Affero General Public License +;; along with this program. If not, see . + +(define-module (libxml2) + #:use-module (rnrs) + #:use-module (system foreign) + #:use-module (system foreign-library) + #:export (gumbo-libxml-parse + xml-free-doc + xml-node-list-get-string + xml-xpath-new-context + xml-xpath-eval-expression + xml-xpath-free-object + xml-child-element-count + xml-xpath-object + xml-node + xml-nodeset + next + child + child1 + attrs + name + doc + text + nodeset + nodeset-nodes + nodeset-nodes-null? + xpath-null? + dump-xml + get-xpath + dump-xpath-xml + get-xpath-string + get-xpath-nodeset + get-xpath-node)) + +(define libxml2 + (dynamic-link + (if (getenv "LIBXML2_LOCATION") + (getenv "LIBXML2_LOCATION") + "libxml2"))) + +(define gumbo-libxml + (dynamic-link + (if (getenv "GUMBO_LIBXML_LOCATION") + (getenv "GUMBO_LIBXML_LOCATION") + "./gumbo-libxml/.libs/libgumbo_xml.so"))) + +(define xml-xpath-object + (list int ; xmlXPathObjectType type + '* ; xmlNodeSetPtr nodesetval + int ; int boolval + double ; floatval + '* ; xmlChar *stringval + '* ; void *user + int ; int index + '* ; void *user2 + int ; int index2 + )) +(define xml-nodeset + (list int + int + '*)) +(define xml-node + (list '* ; void *_private + int ; xmlElementType type + '* ; char *name + '* ; _xmlNode *children + '* ; _xmlNode *last + '* ; _xmlNode *parent + '* ; _xmlNode *next + '* ; _xmlNode *prev + '* ; _xmlDoc *doc + '* ; _xmlNs *ns + '* ; xmlChar *content + '* ; _xmlDict *dict + '* ; void *psvi + '* ; _xmlAttr *properties + '*)); _xmlNs *nsDef +(define xml-buffer + (list '* ; xmlChar *content + unsigned-int ; unsigned int use + unsigned-int ; unsigned int size + int)); xmlBufferAllocationScheme alloc + +(define gumbo-libxml-parse + (pointer->procedure '* + (dynamic-func "gumbo_libxml_parse" gumbo-libxml) + (list '*))) +(define xml-free-doc + (pointer->procedure void + (dynamic-func "xmlFreeDoc" libxml2) + (list '*))) +(define xml-node-list-get-string + (pointer->procedure '* + (dynamic-func "xmlNodeListGetString" libxml2) + (list '* '* int))) +(define xml-buffer-create + (pointer->procedure '* + (dynamic-func "xmlBufferCreate" libxml2) + (list))) +(define xml-buffer-free + (pointer->procedure void + (dynamic-func "xmlBufferFree" libxml2) + (list '*))) +(define xml-node-dump + (pointer->procedure void + (dynamic-func "xmlNodeDump" libxml2) + (list '* '* '* int int))) + +(define xml-xpath-new-context + (pointer->procedure '* + (dynamic-func "xmlXPathNewContext" libxml2) + (list '*))) +(define xml-xpath-eval-expression + (pointer->procedure '* + (dynamic-func "xmlXPathEvalExpression" libxml2) + (list '* '*))) +(define xml-xpath-free-context + (pointer->procedure void + (dynamic-func "xmlXPathFreeContext" libxml2) + (list '*))) +(define xml-child-element-count + (pointer->procedure unsigned-long + (dynamic-func "xmlChildElementCount" libxml2) + (list '* int))) + +(define (next ptr times) + (if (= times 0) + (list-ref (parse-c-struct ptr xml-node) 6) + (next (next ptr 0) (- times 1)))) +(define (child ptr) + (cadddr (parse-c-struct ptr xml-node))) +(define (child1 ptr times) + (if (= times 0) + (next (child ptr) 0) + (child1 (next (child ptr) 0) (- times 1)))) +(define (attrs ptr) + (list-ref (parse-c-struct ptr xml-node) 11)) +(define (name ptr) + (pointer->string (caddr (parse-c-struct ptr xml-node)))) +(define (doc ptr) + (list-ref (parse-c-struct ptr xml-node) 8)) +(define (text ptr) + (cond + ((not (null-pointer? (xml-node-list-get-string (doc ptr) (child ptr) 1))) + (pointer->string (xml-node-list-get-string (doc ptr) (child ptr) 1))) + (else + (pointer->string (xml-node-list-get-string (doc ptr) + (child (child ptr)) 1))))) + +(define (nodeset ptr) + (cadr (parse-c-struct ptr xml-xpath-object))) +(define (nodeset-nodes ptr) + (dereference-pointer (caddr (parse-c-struct ptr xml-nodeset)))) +(define (nodeset-nodes-null? ptr) + (null-pointer? (caddr (parse-c-struct ptr xml-nodeset)))) +(define (xpath-null? xpath d) + (nodeset-nodes-null? (get-xpath-nodeset xpath d))) + +(define (dump-xml node) + (define buffer (xml-buffer-create)) + (define size (xml-node-dump buffer (doc node) node 0 1)) + (define content (pointer->string (car (parse-c-struct buffer xml-buffer)))) + (xml-buffer-free buffer) + content) + +(define (get-xpath xpath d) + (define context (xml-xpath-new-context d)) + (define result (xml-xpath-eval-expression + (string->pointer xpath) + context)) + (xml-xpath-free-context context) + result) + +(define (dump-xpath-xml xpath d) + (define buffer (xml-buffer-create)) + (define nodes (get-xpath-node xpath d)) + (define size (xml-node-dump buffer (doc nodes) nodes 0 1)) + (define content (pointer->string (car (parse-c-struct buffer xml-buffer)))) + (xml-buffer-free buffer) + content) + +(define (get-xpath-string xpath d attr?) + (pointer->string + (xml-node-list-get-string + (doc (get-xpath-node xpath d)) + (if attr? + (child (get-xpath-node xpath d)) + (get-xpath-node xpath d)) + 1))) + +(define (get-xpath-nodeset xpath d) + (nodeset (get-xpath xpath d))) + +(define (get-xpath-node xpath d) + (nodeset-nodes (get-xpath-nodeset xpath d)))