从Common (闭包XML )中的节点中提取XML数据

Question

这是一个函数，用于获取XML元素(以闭包XML格式表示)和名称，并在该XML元素中(在标记或属性中)查找该名称中的简单数据。它很管用，但我对LISP还不熟悉--它能写得更优雅些吗？

(defun find-data-inside-xml (element name)
  ;; Maybe there's an attribute?
  (if (dom:has-attribute element name) (dom:get-attribute element name)
  ;; There isn't, we have to do it the ugly way. Find suitable subnodes.
    (let ((candidate-values (loop for node across (dom:child-nodes element) 
                           when (string= (dom:node-name node) name) collect node)))
     ;; Check there was only one of them.
     (cond
        ((> (length candidate-values) 1) (error "XML element has multiple ~S elements." name))
        ((= (length candidate-values) 0) (error "XML element missing ~S element." name))
        (t (let ((cand-children (dom:child-nodes (car candidate-values))))
            ;; Check the one there was, has only one child node.
            (cond
             ((> (length cand-children) 1) (error "XML ~S element has complex content." name))
             ((= (length cand-children) 0) (error "~S element has no content." name))
             (t (let ((content-node (elt cand-children 0)))
                 ;; If that child node is text, that's our value. Otherwise, error.
                 (if (eq (dom:node-type content-node) :text)
                     (dom:node-value content-node)
                     (error "~S element value is not text." name)))))))))))

Answer 1

• 您可以使用REMOVE代替循环。
• 您可以用断言替换CONDs和IFs以及错误。
• 先换车

具体的函数使代码的意图更加清晰。

未经测试：

(defun find-data-inside-xml (element name)
  (if (dom:has-attribute element name)
      (dom:get-attribute element name)
    (let* ((candidates (remove name (dom:child-nodes element)
                               :key #'dom:node-name
                               :test-not #'string=))
           (n-candidates (length candidates)))
      (assert (not (> n-candidates 1)) ()
              "XML element has multiple ~S elements." name)
      (assert (not (= n-candidates 0)) ()
              "XML element missing ~S element."       name)
      (let* ((candidate-children (dom:child-nodes (first candidate-values)))
             (n-candidate-children (length candidate-children)))
        (assert (not (> n-candidate-children 1)) ()
                "XML ~S element has complex content." name)
        (assert (not (= n-candidate-children 0)) ()
                "~S element has no content."          name)
        (let ((content-node (elt candidate-children 0)))
          (assert (eq (dom:node-type content-node) :text) ()
                   "~S element value is not text." name)
          (dom:node-value content-node))))))

有时，人们也会看到一些宏观的东西，以使代码级别的意图更加清晰。但这还有其他代价：

(defmacro with-length-checked ((varn var &rest exprs) &body body)
  (let ((asserts (loop for (test test-a msg . args) in exprs
                       collect `(assert (not (,test ,var ,test-a)) ,msg ,@args))))
    `(let ((,var (length ,varn)))
       ,@asserts
       ,@body)))

(defun find-data-inside-xml (element name)
  (if (dom:has-attribute element name)
      (dom:get-attribute element name)
    (let ((candidates (remove name (dom:child-nodes element)
                              :key #'dom:node-name
                              :test-not #'string=)))
      (with-length-checked (candidates n-candidates
                            (> 1 "XML element has multiple ~S elements." name)
                            (= 0 "XML element missing ~S element."       name))
        (let ((candidate-children   (dom:child-nodes (first candidate-values))))
          (with-length-checked (candidate-children n-candidate-children
                                (> 1 "XML ~S element has complex content." name)
                                (= 0  "~S element has no content."         name))
             (let ((content-node (elt candidate-children 0)))
               (assert (eq (dom:node-type content-node) :text) ()
                 "~S element value is not text." name)
               (dom:node-value content-node))))))))