Browse files

Changes to DTD verification

Addded get-dtd in order to avoid direct calls to cxml:parse-dtd-file
in cases where it is not absolutely certain that there is a DTD file
associated with the class: while for XML import there needs to be a
DTD, XML export can be useful to serialise any object, even without a
  • Loading branch information...
1 parent 0cab7ec commit 6a9115b87931b387d8b3a55cde96231a3643227a @fsmunoz fsmunoz committed with Jun 3, 2010
Showing with 16 additions and 4 deletions.
  1. +16 −4 src/xml-impex/xml-class.lisp
@@ -141,6 +141,17 @@ through the object-id-slot (either an element or an attribute)")
(xml-class-element class) (or (first element) (string-downcase (class-name class))))
(xml-class-finalize class))
+(defun get-dtd (dtd)
+ (cond ((or (stringp dtd)
+ (pathnamep dtd))
+ (cxml:parse-dtd-file dtd))
+ ((typep dtd 'cxml::dtd) dtd)
+ (t (let ((dtd (eval dtd)))
+ (unless (typep dtd 'cxml::dtd)
+; (error "DTD ~A is not a CXML dtd." dtd))
+ (warn "DTD ~A is not a CXML dtd." dtd))
+ dtd))))
(defun get-dtd-elmdef (dtd elmdef)
"Finds an element definition in a DTD. Returns a cxml:elmdef"
(typecase elmdef
@@ -186,10 +197,11 @@ pairs, representing the childs and their containment definition"
(defmethod xml-class-finalize ((class xml-class))
(unless (class-finalized-p class)
(finalize-inheritance class))
- (let ((slots (class-slots class))
- (elmdef (get-dtd-elmdef
- (cxml::parse-dtd-file (xml-class-dtd-name class)) (xml-class-element class))))
+ (let* ((slots (class-slots class))
+ (dtd (get-dtd (xml-class-dtd-name class)))
+ (elmdef (when dtd (get-dtd-elmdef dtd (xml-class-element class)))))
(unless elmdef
(return-from xml-class-finalize))
;;; check attributes

0 comments on commit 6a9115b

Please sign in to comment.