209 lines
6.6 KiB
Scheme
209 lines
6.6 KiB
Scheme
;; Copyright (C) 2024 Skylar Widulski <cobra@vern.cc>
|
|
;;
|
|
;; This program 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 <https://www.gnu.org/licenses/>.
|
|
|
|
(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")
|
|
"./guile-libxml2/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)))
|