[bknr-cvs] hans changed trunk/bknr/datastore/src/xml-impex/xml-

[BKNR Commits]

Revision: 4548
Author: hans
URL: http://bknr.net/trac/changeset/4548

Try to resurrect bknr.impex, but not done.

U   trunk/bknr/datastore/src/xml-impex/xml-class.lisp
U   trunk/bknr/datastore/src/xml-impex/xml-import.lisp

Modified: trunk/bknr/datastore/src/xml-impex/xml-class.lisp
===================================================================
--- trunk/bknr/datastore/src/xml-impex/xml-class.lisp	2010-05-23 05:12:23 UTC (rev 4547)
+++ trunk/bknr/datastore/src/xml-impex/xml-class.lisp	2010-05-23 05:12:46 UTC (rev 4548)
@@ -9,7 +9,8 @@
    (unique-id-reader :initarg :unique-id-reader :initform nil
 		     :documentation "if set to a function, this
 signals that the function can be used as a unique index-reader when
-used in XML update operations.")))
+used in XML update operations.")
+   (dtd-name :reader xml-class-dtd-name)))
 
 (defmethod xml-class-unique-id-slot ((class xml-class))
   (first (slot-value class 'unique-id-slot)))
@@ -130,12 +131,14 @@
       (error "Class ~A has more than one parent slot: ~A." class parent-slots))
     (first parent-slots)))
 
-(defmethod initialize-instance :after ((class xml-class) &key element &allow-other-keys)
-  (setf (xml-class-element class) (or (first element) (string-downcase (class-name class))))
+(defmethod initialize-instance :after ((class xml-class) &key element dtd-name)
+  (setf (slot-value class 'dtd-name) (symbol-value (first dtd-name))
+        (xml-class-element class) (or (first element) (string-downcase (class-name class))))
   (xml-class-finalize class))
 
-(defmethod reinitialize-instance :after ((class xml-class) &key element &allow-other-keys)
-  (setf (xml-class-element class) (or (first element) (string-downcase (class-name class))))
+(defmethod reinitialize-instance :after ((class xml-class) &key element dtd-name)
+  (setf (slot-value class 'dtd-name) (symbol-value (first dtd-name))
+        (xml-class-element class) (or (first element) (string-downcase (class-name class))))
   (xml-class-finalize class))
 
 (defmethod xml-class-finalize ((class xml-class))

Modified: trunk/bknr/datastore/src/xml-impex/xml-import.lisp
===================================================================
--- trunk/bknr/datastore/src/xml-impex/xml-import.lisp	2010-05-23 05:12:23 UTC (rev 4547)
+++ trunk/bknr/datastore/src/xml-impex/xml-import.lisp	2010-05-23 05:12:46 UTC (rev 4548)
@@ -182,6 +182,7 @@
     (dolist (class classes)
       (setf (gethash (xml-class-element class) class-hash) class))
     (let ((importer (make-instance importer-class
+                                   :dtd (parse-dtd-file (xml-class-dtd-name (first classes)))
                                    :class-hash class-hash)))
       (cxml:parse-file xml-file (cxml:make-recoder importer recoder))
       (importer-root-elt importer))))