OSCL/CXML
2
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

XMLS compatibility is not <i>bug-for-bug</i>-compatible with

Browse Source 
XMLS any more.  There is now a mode using pairs of local name
        and namespace URI, and a second mode using qualified names
        only.  The old behaviour using pairs of prefix and local names
        was removed.  (Thanks to Douglas Crosher.)
This commit is contained in:
dlichteblau
2007-06-16 11:07:58 +00:00
parent 0d4ab8c766
commit ee394c591d
4 changed files with 156 additions and 45 deletions
Download Patch File Download Diff File Expand all files Collapse all files

7
doc/index.xml
View File

@ -61,6 +61,13 @@
<ul class="nomargin">
<li>Serialization no longer defaults to canonical form.</li>
<li>Fixed octet array argument to make-source.</li>
<li>
XMLS compatibility is not <i>bug-for-bug</i>-compatible with
XMLS any more. There is now a mode using pairs of local name
and namespace URI, and a second mode using qualified names
only. The old behaviour using pairs of prefix and local names
was removed. (Thanks to Douglas Crosher.)
</li>
</ul>
<p class="nomargin"><tt>rel-2007-05-26</tt></p>
<ul class="nomargin">

43
doc/xmls-compat.xml
View File

@ -16,7 +16,28 @@
DOM functions cannot be implemented on them.
</p>
<p>
<div class="def">Function CXML-XMLS:MAKE-XMLS-BUILDER (&amp;key include-default-values)</div>
<b>New namespace handling:</b>
XMLS compatibility is not <i>bug-for-bug</i>-compatible with
XMLS any more. There is now a mode using pairs of local name
and namespace URI, and a second mode using qualified names
only. The old behaviour using pairs of prefix and local names
was removed.
</p>
<p>
<strike>
fixme: It is unclear to me how namespaces are meant to
work in xmls, since xmls documentation differs from how xmls
actually works in current releases. Usually applications need to
know both the namespace prefix <em>and</em> the namespace URI. We
currently follow the xmls <em>implementation</em> and use the
namespace prefix instead of following its <em>documentation</em> which
shows the URI. We do not follow xmls in munging xmlns attribute
values. Attributes themselves have namespaces and it is not clear
to me how that works in xmls.
</strike>
</p>
<p>
<div class="def">Function CXML-XMLS:MAKE-XMLS-BUILDER (&amp;key include-default-values include-namespace-uri)</div>
Create a SAX handler which builds XMLS list structures.&#160;
If <tt>include-default-values</tt> is true, default values for
attributes declared in a DTD are included as attributes in the
@ -24,12 +45,19 @@
and can be set to <tt>nil</tt> to suppress inclusion of default
values.
</p>
<p>
If <tt>include-namespace-uri</tt> is true (the default), node
names and attribute names are pairs of local name and namespace
URI. (Except for attributes without a namespace, which are named
using a string.) Otherwise, nodes and attributes are named by
their qualified name.
</p>
<p>
Example:
</p>
<pre>(cxml:parse-file "test.xml" (cxml-xmls:make-xmls-builder))</pre>
<p>
<div class="def">Function CXML-XMLS:MAP-NODE (handler node &amp;key include-xmlns-attributes)</div>
<div class="def">Function CXML-XMLS:MAP-NODE (handler node &amp;key include-xmlns-attributes include-namespace-uri)</div>
Traverse an XMLS document/node and call SAX functions as if an XML
representation of the document were processed by a SAX parser.
</p>
@ -51,17 +79,6 @@
The node list's <tt>car</tt> can also be a cons of local <tt>name</tt>
and namespace prefix <tt>ns</tt>.
</p>
<p>
<em>fixme:</em> It is unclear to me how namespaces are meant to
work in xmls, since xmls documentation differs from how xmls
actually works in current releases. Usually applications need to
know both the namespace prefix <em>and</em> the namespace URI. We
currently follow the xmls <em>implementation</em> and use the
namespace prefix instead of following its <em>documentation</em> which
shows the URI. We do not follow xmls in munging xmlns attribute
values. Attributes themselves have namespaces and it is not clear
to me how that works in xmls.
</p>
<p>
<div class="def">Accessor CXML-XMLS:NODE-NAME (node)</div>
<div class="def">Accessor CXML-XMLS:NODE-NS (node)</div>

11
xml/xmlns-normalizer.lisp
View File

@ -34,7 +34,7 @@
(make-instance 'namespace-normalizer
:xmlns-stack (list (mapcar (lambda (cons)
(make-xmlns-attribute (car cons) (cdr cons)))
*namespace-bindings*))
*initial-namespace-bindings*))
:chained-handler chained-handler))
(defun normalizer-find-prefix (handler prefix)
@ -74,7 +74,6 @@
(defmethod sax:start-element
((handler namespace-normalizer) uri lname qname attrs)
(declare (ignore qname))
(when (null uri)
(setf uri #""))
(let ((normal-attrs '()))
@ -85,8 +84,12 @@
(push a normal-attrs)))
(flet ((push-namespace (prefix uri)
(let ((new (make-xmlns-attribute prefix uri)))
(push new (car (xmlns-stack handler)))
(push new attrs))))
(unless (find (sax:attribute-qname new)
attrs
:test #'rod=
:key #'sax:attribute-qname)
(push new (car (xmlns-stack handler)))
(push new attrs)))))
(multiple-value-bind (prefix local-name) (split-qname qname)
(setf lname local-name)
(let ((binding (normalizer-find-prefix handler prefix)))

140
xml/xmls-compat.lisp
View File

@ -69,32 +69,50 @@
(root :initform nil :accessor root)
(include-default-values :initform t
:initarg :include-default-values
:accessor include-default-values)))
:accessor include-default-values)
(include-namespace-uri :initform t
:initarg :include-namespace-uri
:accessor include-namespace-uri)))
(defun make-xmls-builder (&key (include-default-values t))
(make-instance 'xmls-builder :include-default-values include-default-values))
(defun make-xmls-builder (&key (include-default-values t)
(include-namespace-uri t))
"Make a XMLS style builder. When 'include-namespace-uri is true a modified
XMLS tree is generated that includes the element namespace URI rather than
the qualified name prefix and also includes the namespace URI for attributes."
(make-instance 'xmls-builder
:include-default-values include-default-values
:include-namespace-uri include-namespace-uri))
(defmethod sax:end-document ((handler xmls-builder))
(root handler))
(defmethod sax:start-element
((handler xmls-builder) namespace-uri local-name qname attributes)
(declare (ignore namespace-uri))
(setf local-name (or local-name qname))
(let* ((attributes
(let* ((include-default-values (include-default-values handler))
(include-namespace-uri (include-namespace-uri handler))
(attributes
(loop
for attr in attributes
when (or (sax:attribute-specified-p attr)
(include-default-values handler))
for attr-namespace-uri = (sax:attribute-namespace-uri attr)
for attr-local-name = (sax:attribute-local-name attr)
when (and (or (sax:attribute-specified-p attr)
include-default-values)
#+(or)
(or (not include-namespace-uri)
(not attr-namespace-uri)
attr-local-name))
collect
(list (sax:attribute-qname attr)
(list (cond (include-namespace-uri
(cond (attr-namespace-uri
(cons attr-local-name attr-namespace-uri))
(t
(sax:attribute-qname attr))))
(t
(sax:attribute-qname attr)))
(sax:attribute-value attr))))
(namespace (when include-namespace-uri namespace-uri))
(node (make-node :name local-name
:ns (let ((lq (length qname))
(ll (length local-name)))
(if (eql lq ll)
nil
(subseq qname 0 (- lq ll 1))))
:ns namespace
:attrs attributes))
(parent (car (element-stack handler))))
(if parent
@ -129,34 +147,100 @@
(defun map-node
(handler node
&key (include-xmlns-attributes sax:*include-xmlns-attributes*))
&key (include-xmlns-attributes sax:*include-xmlns-attributes*)
(include-namespace-uri t))
(if include-namespace-uri
(map-node/lnames (cxml:make-namespace-normalizer handler)
node
include-xmlns-attributes)
(map-node/qnames handler node include-xmlns-attributes)))
(defun map-node/lnames (handler node include-xmlns-attributes)
(sax:start-document handler)
(labels ((walk (node)
(unless (node-ns node)
(error "serializing with :INCLUDE-NAMESPACE-URI, but node ~
was created without namespace URI"))
(let* ((attlist
(compute-attributes/lnames node include-xmlns-attributes))
(uri (node-ns node))
(lname (node-name node))
(qname lname) ;let the normalizer fix it
)
(sax:start-element handler uri lname qname attlist)
(dolist (child (node-children node))
(typecase child
(list (walk child))
((or string rod)
(sax:characters handler (string-rod child)))))
(sax:end-element handler uri lname qname))))
(walk node))
(sax:end-document handler))
(defun map-node/qnames (handler node include-xmlns-attributes)
(sax:start-document handler)
(labels ((walk (node)
(when (node-ns node)
(error "serializing without :INCLUDE-NAMESPACE-URI, but node ~
was created with a namespace URI"))
(let* ((attlist
(compute-attributes node include-xmlns-attributes))
(lname (rod (node-name node)))
(qname (if (node-ns node)
(concatenate 'rod
(rod (node-ns node))
(rod ":")
lname)
lname)))
(compute-attributes/qnames node include-xmlns-attributes))
(qname (string-rod (node-name node)))
(lname (nth-value 1 (cxml::split-qname qname))))
(sax:start-element handler nil lname qname attlist)
(dolist (child (node-children node))
(typecase child
(list (walk child))
((or string rod) (sax:characters handler (rod child)))))
((or string rod)
(sax:characters handler (string-rod child)))))
(sax:end-element handler nil lname qname))))
(walk node))
(sax:end-document handler))
(defun compute-attributes (node xmlnsp)
(defun compute-attributes/lnames (node xmlnsp)
(remove nil
(mapcar (lambda (a)
(destructuring-bind (name value) a
(if (or xmlnsp (not (cxml::xmlns-attr-p (rod name))))
(sax:make-attribute :qname (rod name)
:value (rod value)
(unless (listp name)
(setf name (cons name nil)))
(destructuring-bind (lname &rest uri) name
(cond
((not (equal uri "http://www.w3.org/2000/xmlns/"))
(sax:make-attribute
;; let the normalizer fix the qname
:qname (if uri
(string-rod (concatenate 'string
"dummy:"
lname))
(string-rod lname))
:local-name (string-rod lname)
:namespace-uri uri
:value (string-rod value)
:specified-p t))
(xmlnsp
(sax:make-attribute
:qname (string-rod
(if lname
(concatenate 'string "xmlns:" lname)
"xmlns"))
:local-name (string-rod lname)
:namespace-uri uri
:value (string-rod value)
:specified-p t))))))
(node-attrs node))))
(defun compute-attributes/qnames (node xmlnsp)
(remove nil
(mapcar (lambda (a)
(destructuring-bind (name value) a
(when (listp name)
(error "serializing without :INCLUDE-NAMESPACE-URI, ~
but attribute was created with a namespace ~
URI"))
(if (or xmlnsp
(not (cxml::xmlns-attr-p (string-rod name))))
(sax:make-attribute :qname (string-rod name)
:value (string-rod value)
:specified-p t)
nil)))
(node-attrs node))))