| 1 | ;;+----------------------------------------------------------------------------- |
|---|
| 2 | ;;+ Isidorus |
|---|
| 3 | ;;+ (c) 2008-2010 Marc Kuester, Christoph Ludwig, Lukas Georgieff |
|---|
| 4 | ;;+ |
|---|
| 5 | ;;+ Isidorus is freely distributable under the LLGPL license. |
|---|
| 6 | ;;+ You can find a detailed description in trunk/docs/LLGPL-LICENSE.txt and |
|---|
| 7 | ;;+ trunk/docs/LGPL-LICENSE.txt. |
|---|
| 8 | ;;+----------------------------------------------------------------------------- |
|---|
| 9 | |
|---|
| 10 | (in-package :xtm-importer) |
|---|
| 11 | |
|---|
| 12 | (defun get-uuid () |
|---|
| 13 | "Little helper funtion that gets a UUID as a string" |
|---|
| 14 | (format nil "~a" (uuid:make-v4-uuid))) |
|---|
| 15 | |
|---|
| 16 | |
|---|
| 17 | (defun import-from-xtm (xtm-path repository-path &key |
|---|
| 18 | (tm-id (error "you must provide a stable identifier (PSI-style) for this TM")) |
|---|
| 19 | (xtm-format :2.0) |
|---|
| 20 | (xtm-id (get-uuid))) |
|---|
| 21 | "Imports an XTM file into an existing repository using the correct |
|---|
| 22 | importer for the XTM version. Does *not* close the store afterwards" |
|---|
| 23 | (declare (type (or pathname string) xtm-path repository-path) |
|---|
| 24 | (String tm-id xtm-id) |
|---|
| 25 | (Keyword xtm-format)) |
|---|
| 26 | (let ((xtm-dom (dom:document-element |
|---|
| 27 | (cxml:parse-file |
|---|
| 28 | (truename xtm-path) (cxml-dom:make-dom-builder))))) |
|---|
| 29 | (open-tm-store repository-path) |
|---|
| 30 | ;create the topic stubs so that we can refer to them later on |
|---|
| 31 | (setf d:*current-xtm* xtm-id) |
|---|
| 32 | (if (eq xtm-format :2.0) |
|---|
| 33 | (importer xtm-dom :tm-id tm-id :xtm-id xtm-id) |
|---|
| 34 | (importer-xtm1.0 xtm-dom :tm-id tm-id :xtm-id xtm-id)) |
|---|
| 35 | (with-reader-lock |
|---|
| 36 | (format t "#Objects in the store: Topics: ~a, Associations: ~a~%" |
|---|
| 37 | (length (elephant:get-instances-by-class 'TopicC)) |
|---|
| 38 | (length (elephant:get-instances-by-class 'AssociationC)))))) |
|---|
| 39 | |
|---|
| 40 | |
|---|
| 41 | (defun setup-repository (xtm-path repository-path |
|---|
| 42 | &key |
|---|
| 43 | (tm-id (error "you must provide a stable identifier (PSI-style) for this TM")) |
|---|
| 44 | (xtm-id (get-uuid)) |
|---|
| 45 | (xtm-format :2.0)) |
|---|
| 46 | "Initializes a repository and imports a XTM file into it" |
|---|
| 47 | (declare (type (or pathname string) xtm-path repository-path) |
|---|
| 48 | (String tm-id xtm-id) |
|---|
| 49 | (Keyword xtm-format)) |
|---|
| 50 | (open-tm-store repository-path) |
|---|
| 51 | (init-isidorus) |
|---|
| 52 | (import-from-xtm xtm-path repository-path :tm-id tm-id :xtm-id xtm-id |
|---|
| 53 | :xtm-format xtm-format) |
|---|
| 54 | (when elephant:*store-controller* |
|---|
| 55 | (close-tm-store))) |
|---|
