Changeset 234 for branches/new-datamodel


Ignore:
Timestamp:
03/20/10 20:33:55 (15 years ago)
Author:
lgiessmann
Message:

new-datamodel: implemented "make-topic" and other helper functions for "make-cosntruct"; fixed a bug in "add-topic-identifier", "add-psi", "add-item-identifier" and "add-locator" with "merge-constructs"

Location:
branches/new-datamodel/src
Files:
8 edited

Legend:

Unmodified
Added
Removed
  • TabularUnified branches/new-datamodel/src/json/json_importer.lisp

    r177 r234  
    3333            (associations-values (getf fragment-values :associations))
    3434            (rev (get-revision))) ; creates a new revision, equal for all elements of the passed fragment
    35         (elephant:ensure-transaction (:txn-nosync nil)
    36           (xml-importer:with-tm (rev xtm-id (first (getf fragment-values :tm-ids)))
    37             (loop for topicStub-values in (append topicStubs-values (list topic-values))
    38                do (json-to-stub topicStub-values rev :tm xml-importer::tm :xtm-id xtm-id))
    39             (json-merge-topic topic-values rev :tm xml-importer::tm :xtm-id xtm-id)
    40             (loop for association-values in associations-values
    41                do (json-to-association association-values rev :tm xml-importer::tm))))))))
     35        (let ((psi-of-topic
     36               (let ((psi-uris (getf topic-values :subjectIdentifiers)))
     37                 (when psi-uris
     38                   (first psi-uris)))))
     39          (elephant:ensure-transaction (:txn-nosync nil)
     40            (xml-importer:with-tm (rev xtm-id (first (getf fragment-values :tm-ids)))
     41              (loop for topicStub-values in (append topicStubs-values (list topic-values))
     42                 do (json-to-stub topicStub-values rev :tm xml-importer::tm :xtm-id xtm-id))
     43              (json-merge-topic topic-values rev :tm xml-importer::tm :xtm-id xtm-id)
     44              (loop for association-values in associations-values
     45                 do (json-to-association association-values rev :tm xml-importer::tm))))
     46          (when psi-of-topic
     47            (create-latest-fragment-of-topic psi-of-topic)))))))
    4248
    4349
  • TabularUnified branches/new-datamodel/src/model/changes.lisp

    r188 r234  
    278278
    279279(defun create-latest-fragment-of-topic (topic-psi)
    280   "returns the latest fragment of the passed topic-psi"
     280  "Returns the latest fragment of the passed topic-psi"
    281281  (declare (string topic-psi))
    282282  (let ((topic
     
    301301                             :referenced-topics (find-referenced-topics topic)
    302302                             :topic topic)))))))
     303
     304
     305(defun get-latest-fragment-of-topic (topic-psi)
     306  "Returns the latest existing fragment of the passed topic-psi."
     307  (declare (string topic-psi))
     308  (let ((topic
     309         (get-item-by-psi topic-psi)))
     310    (when topic
     311      (let ((existing-fragments
     312             (elephant:get-instances-by-value 'FragmentC 'topic topic)))
     313        (when existing-fragments
     314          (first (sort existing-fragments
     315                       #'(lambda(frg-1 frg-2)
     316                           (> (revision frg-1) (revision frg-2))))))))))
  • TabularUnified branches/new-datamodel/src/model/datamodel.lisp

    r233 r234  
    9393           :string-integer-p
    9494           :with-revision
     95           :get-latest-fragment-of-topic
     96           :create-latest-fragment-of-topic
    9597           :PointerC-p
    9698           :IdentifierC-p
     
    123125
    124126
    125 ;;TODO: check merge-constructs in add-topic-identifier, add-item-identifier
    126 ;;      (can merge the parent construct and the parent's parent construct),
    127 ;;      add-psi, add-locator
     127;;TODO: check merge-constructs in add-topic-identifier,
     128;;      add-item-identifier/add-reifier (can merge the parent construct
     129;;      and the parent's parent construct), add-psi, add-locator
     130;;      (--> duplicate-identifier-error)
    128131;;TODO: finalize add-reifier
    129132;;TODO: replace add-to-version-history in VersionedAssociationC with a pseudo
     
    10081011(defmethod equivalent-construct ((construct TopicC)
    10091012                                 &key (start-revision 0) (psis nil)
    1010                                  (locators nil) (item-identifiers nil))
     1013                                 (locators nil) (item-identifiers nil)
     1014                                 (topic-identifiers nil))
    10111015  "Isidorus handles Topic-equality only by the topic's identifiers
    10121016   'psis', 'subject locators' and 'item identifiers'. Names and occurences
     
    10141018   all its charactersitics. T is returned if the topic owns one of the given
    10151019   identifier-URIs."
    1016   (declare (integer start-revision) (list psis locators item-identifiers))
     1020  (declare (integer start-revision) (list psis locators item-identifiers
     1021                                          topic-identifiers))
    10171022  (when
    10181023      (intersection
    10191024       (union (union (psis construct :revision start-revision)
    10201025                     (locators construct :revision start-revision))
    1021               (item-identifiers construct :revision start-revision))
    1022        (union (union psis locators) item-identifiers))
     1026              (union (item-identifiers construct :revision start-revision)
     1027                     (topic-identifiers construct :revision start-revision)))
     1028       (union (union psis locators) (union item-identifiers topic-identifiers)))
    10231029    t))
    10241030
     
    10891095             (when (not (eql id-owner construct))
    10901096               id-owner))))
    1091       (cond (construct-to-be-merged
    1092              (merge-constructs construct construct-to-be-merged :revision revision))
    1093             ((find topic-identifier all-ids)
    1094              (let ((ti-assoc (loop for ti-assoc in (slot-p construct
    1095                                                            'topic-identifiers)
    1096                                 when (eql (identifier ti-assoc)
    1097                                           topic-identifier)
    1098                                 return ti-assoc)))
    1099                (add-to-version-history ti-assoc :start-revision revision)))
    1100             (t
    1101              (let ((assoc
    1102                     (make-instance 'TopicIdAssociationC
    1103                                    :parent-construct construct
    1104                                    :identifier topic-identifier)))
    1105                (add-to-version-history assoc :start-revision revision))))
    1106       (when (typep construct 'TopicC)
    1107         (add-to-version-history construct :start-revision revision))
    1108       construct)))
     1097      (let ((merged-construct construct))
     1098        (cond (construct-to-be-merged
     1099               (setf merged-construct
     1100                     (merge-constructs construct construct-to-be-merged
     1101                                       :revision revision)))
     1102              ((find topic-identifier all-ids)
     1103               (let ((ti-assoc (loop for ti-assoc in (slot-p construct
     1104                                                             'topic-identifiers)
     1105                                  when (eql (identifier ti-assoc)
     1106                                            topic-identifier)
     1107                                  return ti-assoc)))
     1108                 (add-to-version-history ti-assoc :start-revision revision)))
     1109              (t
     1110               (let ((assoc (make-instance 'TopicIdAssociationC
     1111                                           :parent-construct construct
     1112                                           :identifier topic-identifier)))
     1113                 (add-to-version-history assoc :start-revision revision))))
     1114        (add-to-version-history merged-construct :start-revision revision)
     1115        merged-construct))))
    11091116
    11101117
     
    11451152             (when (not (eql id-owner construct))
    11461153               id-owner))))
    1147       (cond (construct-to-be-merged
    1148              (merge-constructs construct construct-to-be-merged
    1149                                :revision revision))
    1150             ((find psi all-ids)
    1151              (let ((psi-assoc (loop for psi-assoc in (slot-p construct 'psis)
    1152                                 when (eql (identifier psi-assoc) psi)
    1153                                 return psi-assoc)))
    1154                (add-to-version-history psi-assoc :start-revision revision)))
    1155             (t
    1156              (let ((assoc
    1157                     (make-instance 'PersistentIdAssociationC
    1158                                    :parent-construct construct
    1159                                    :identifier psi)))
    1160                (add-to-version-history assoc :start-revision revision))))
    1161       (add-to-version-history construct :start-revision revision)
    1162       construct)))
     1154      (let ((merged-construct construct))
     1155        (cond (construct-to-be-merged
     1156               (setf merged-construct
     1157                     (merge-constructs construct construct-to-be-merged
     1158                                       :revision revision)))
     1159              ((find psi all-ids)
     1160               (let ((psi-assoc (loop for psi-assoc in (slot-p construct 'psis)
     1161                                   when (eql (identifier psi-assoc) psi)
     1162                                   return psi-assoc)))
     1163                 (add-to-version-history psi-assoc :start-revision revision)))
     1164              (t
     1165               (let ((assoc (make-instance 'PersistentIdAssociationC
     1166                                           :parent-construct construct
     1167                                           :identifier psi)))
     1168                 (add-to-version-history assoc :start-revision revision))))
     1169        (add-to-version-history merged-construct :start-revision revision)
     1170        merged-construct))))
    11631171
    11641172
     
    11991207             (when (not (eql id-owner construct))
    12001208               id-owner))))
    1201       (cond (construct-to-be-merged
    1202              (merge-constructs construct construct-to-be-merged
    1203                                :revision revision))
    1204             ((find locator all-ids)
    1205              (let ((loc-assoc (loop for loc-assoc in (slot-p construct 'locators)
    1206                                 when (eql (identifier loc-assoc) locator)
    1207                                 return loc-assoc)))
    1208                (add-to-version-history loc-assoc :start-revision revision)))
    1209             (t
    1210              (let ((assoc
    1211                     (make-instance 'SubjectLocatorAssociationC
    1212                                    :parent-construct construct
    1213                                    :identifier locator)))
    1214                (add-to-version-history assoc :start-revision revision))))
    1215       (add-to-version-history construct :start-revision revision)
    1216       construct)))
     1209      (let ((merged-construct construct))
     1210        (cond (construct-to-be-merged
     1211               (setf merged-construct
     1212                     (merge-constructs construct construct-to-be-merged
     1213                                       :revision revision)))
     1214              ((find locator all-ids)
     1215               (let ((loc-assoc
     1216                      (loop for loc-assoc in (slot-p construct 'locators)
     1217                         when (eql (identifier loc-assoc) locator)
     1218                         return loc-assoc)))
     1219                 (add-to-version-history loc-assoc :start-revision revision)))
     1220              (t
     1221               (let ((assoc
     1222                      (make-instance 'SubjectLocatorAssociationC
     1223                                     :parent-construct construct
     1224                                     :identifier locator)))
     1225                 (add-to-version-history assoc :start-revision revision))))
     1226        (add-to-version-history merged-construct :start-revision revision)
     1227        merged-construct))))
    12171228
    12181229
     
    14811492
    14821493(defmethod equivalent-construct ((construct CharacteristicC)
    1483                                  &key (start-revision 0) (reifier nil)
    1484                                  (item-identifiers nil) (charvalue "")
     1494                                 &key (start-revision 0) (charvalue "")
    14851495                                 (instance-of nil) (themes nil))
    14861496  "Equality rule: Characteristics are equal if charvalue, themes and
    14871497    instance-of are equal."
    1488   (declare (string charvalue) (list themes item-identifiers)
     1498  (declare (string charvalue) (list themes)
    14891499           (integer start-revision)
    1490            (type (or null TopicC) instance-of reifier))
    1491   (or (and (string= (charvalue construct) charvalue)
    1492            (equivalent-scopable-construct construct themes
    1493                                           :start-revision start-revision)
    1494            (equivalent-typable-construct construct instance-of
    1495                                          :start-revision start-revision))
    1496       (equivalent-reifiable-construct construct reifier item-identifiers
    1497                                       :start-revision start-revision)))
     1500           (type (or null TopicC) instance-of))
     1501  ;; item-identifiers and reifers are not checked because the equality have to
     1502  ;; be variafied without them
     1503  (and (string= (charvalue construct) charvalue)
     1504       (equivalent-scopable-construct construct themes
     1505                                      :start-revision start-revision)
     1506       (equivalent-typable-construct construct instance-of
     1507                                     :start-revision start-revision)))
    14981508
    14991509
     
    15791589
    15801590(defmethod equivalent-construct ((construct OccurrenceC)
    1581                                  &key (start-revision 0) (reifier nil)
    1582                                  (item-identifiers nil) (charvalue "")
     1591                                 &key (start-revision 0) (charvalue "")
    15831592                                 (themes nil) (instance-of nil)
    15841593                                 (datatype ""))
    15851594  "Occurrences are equal if their charvalue, datatype, themes and
    15861595    instance-of properties are equal."
    1587   (declare (type (or null TopicC) instance-of reifier) (string datatype)
    1588            (list item-identifiers)
     1596  (declare (type (or null TopicC) instance-of) (string datatype)
    15891597           (ignorable start-revision charvalue themes instance-of))
    15901598  (let ((equivalent-characteristic (call-next-method)))
    1591     (or (and equivalent-characteristic
    1592              (string= (datatype construct) datatype))
    1593         (equivalent-reifiable-construct construct reifier item-identifiers
    1594                                         :start-revision start-revision))))
     1599    ;; item-identifiers and reifers are not checked because the equality have to
     1600    ;; be variafied without them
     1601    (and equivalent-characteristic
     1602         (string= (datatype construct) datatype))))
    15951603
    15961604
     
    16031611
    16041612(defmethod equivalent-construct ((construct VariantC)
    1605                                  &key (start-revision 0) (reifier nil)
    1606                                  (item-identifiers nil) (charvalue "")
     1613                                 &key (start-revision 0) (charvalue "")
    16071614                                 (themes nil) (datatype ""))
    16081615  "Variants are equal if their charvalue, datatype and themes
    16091616   properties are equal."
    1610   (declare (string datatype) (list item-identifiers)
    1611            (ignorable start-revision charvalue themes)
    1612            (type (or null TopicC) reifier))
     1617  (declare (string datatype) (ignorable start-revision charvalue themes))
     1618  ;; item-identifiers and reifers are not checked because the equality have to
     1619  ;; be variafied without them
    16131620  (let ((equivalent-characteristic (call-next-method)))
    1614     (or (and equivalent-characteristic
    1615              (string= (datatype construct) datatype))
    1616         (equivalent-reifiable-construct construct reifier item-identifiers
    1617                                         :start-revision start-revision))))
     1621    (and equivalent-characteristic
     1622         (string= (datatype construct) datatype))))
    16181623
    16191624
     
    16311636
    16321637
     1638(defgeneric initialize-name (construct variants &key start-revision)
     1639  (:documentation "Adds all given variants to the passed construct.")
     1640  (:method ((construct NameC) (variants list)
     1641            &key (start-revision *TM-REVISION*))
     1642    (dolist (variant variants)
     1643      (add-variant construct variant :revision start-revision))
     1644    construct))
     1645
     1646
    16331647(defmethod equivalent-construct ((construct NameC)
    1634                                  &key (start-revision 0) (reifier nil)
    1635                                  (item-identifiers nil) (charvalue "")
     1648                                 &key (start-revision 0) (charvalue "")
    16361649                                 (themes nil) (instance-of nil))
    16371650  "Names are equal if their charvalue, instance-of and themes properties
    16381651   are equal."
    16391652  (declare (type (or null TopicC) instance-of)
    1640            (ignorable start-revision charvalue instance-of themes
    1641                       reifier item-identifiers))
     1653           (ignorable start-revision charvalue instance-of themes))
    16421654  (call-next-method))
    16431655 
     
    17101722
    17111723(defmethod equivalent-construct ((construct AssociationC)
    1712                                  &key (start-revision 0) (reifier nil)
    1713                                  (item-identifiers nil) (roles nil)
     1724                                 &key (start-revision 0) (roles nil)
    17141725                                 (instance-of nil) (themes nil))
    17151726  "Associations are equal if their themes, instance-of and roles
    17161727   properties are equal."
    1717   (declare (integer start-revision) (list roles themes item-identifiers)
    1718            (type (or null TopicC) instance-of reifier))
    1719   (or
    1720    (and
    1721     (not (set-exclusive-or roles (roles construct :revision start-revision)))
    1722     (equivalent-typable-construct construct instance-of
    1723                                   :start-revision start-revision)
    1724     (equivalent-scopable-construct construct themes
    1725                                    :start-revision start-revision))
    1726    (equivalent-reifiable-construct construct reifier item-identifiers
    1727                                    :start-revision start-revision)))
     1728  (declare (integer start-revision) (list roles themes)
     1729           (type (or null TopicC) instance-of))
     1730  ;; item-identifiers and reifers are not checked because the equality have to
     1731  ;; be variafied without them
     1732  (and
     1733   (not (set-exclusive-or roles (roles construct :revision start-revision)))
     1734   (equivalent-typable-construct construct instance-of
     1735                                 :start-revision start-revision)
     1736   (equivalent-scopable-construct construct themes
     1737                                  :start-revision start-revision)))
    17281738
    17291739
     
    18011811
    18021812(defmethod equivalent-construct ((construct RoleC)
    1803                                 &key (start-revision 0) (reifier nil)
    1804                                  (item-identifiers nil) (player nil)
     1813                                &key (start-revision 0) (player nil)
    18051814                                 (instance-of nil))
    18061815  "Roles are equal if their instance-of and player properties are equal."
    1807   (declare (integer start-revision)
    1808            (type (or null TopicC) player instance-of reifier)
    1809            (list item-identifiers))
    1810   (or (and (equivalent-typable-construct construct instance-of
    1811                                          :start-revision start-revision)
    1812            (eql player (player construct :revision start-revision)))
    1813       (equivalent-reifiable-construct construct reifier item-identifiers
    1814                                       :start-revision start-revision)))
     1816  (declare (integer start-revision) (type (or null TopicC) player instance-of))
     1817  ;; item-identifiers and reifers are not checked because the equality have to
     1818  ;; be variafied without them
     1819  (and (equivalent-typable-construct construct instance-of
     1820                                     :start-revision start-revision)
     1821       (eql player (player construct :revision start-revision))))
    18151822
    18161823
     
    19501957
    19511958
     1959(defgeneric initialize-reifiable (construct item-identifiers reifier
     1960                                            &key start-revision)
     1961  (:documentation "Adds all item-identifiers and the reifier to the passed
     1962                   construct.")
     1963  (:method ((construct ReifiableConstructC) item-identifiers reifier
     1964            &key (start-revision *TM-REVISION*))
     1965    (declare (integer start-revision) (list item-identifiers)
     1966             (type (or null TopicC) reifier))
     1967    (let ((merged-construct construct))
     1968      (dolist (ii item-identifiers)
     1969        (setf merged-construct
     1970              (add-item-identifier merged-construct ii
     1971                                   :revision start-revision)))
     1972      (when reifier
     1973        (setf merged-construct (add-reifier merged-construct reifier
     1974                                            :revision start-revision)))
     1975      merged-construct)))
     1976
     1977
    19521978(defgeneric equivalent-reifiable-construct (construct reifier item-identifiers
    19531979                                                      &key start-revision)
     
    20112037             (when (not (eql id-owner construct))
    20122038               id-owner))))
    2013       (cond (construct-to-be-merged
    2014              (merge-constructs construct construct-to-be-merged
    2015                                :revision revision))
    2016             ((find item-identifier all-ids)
    2017              (let ((ii-assoc (loop for ii-assoc in (slot-p construct
    2018                                                            'item-identifiers)
    2019                                 when (eql (identifier ii-assoc) item-identifier)
    2020                                 return ii-assoc)))
    2021                (add-to-version-history ii-assoc :start-revision revision)))
    2022             (t
    2023              (let ((assoc
    2024                     (make-instance 'ItemIdAssociationC
    2025                                    :parent-construct construct
    2026                                    :identifier item-identifier)))
    2027                (add-to-version-history assoc :start-revision revision))))
    2028       (when (or (typep construct 'TopicC)
    2029                 (typep construct 'AssociationC)
    2030                 (typep construct 'TopicMapC))
    2031         (add-to-version-history construct :start-revision revision))
    2032       construct)))
     2039      (let ((merged-construct construct))
     2040        (cond (construct-to-be-merged
     2041               (setf merged-construct
     2042                     (merge-constructs construct construct-to-be-merged
     2043                                       :revision revision)))
     2044              ((find item-identifier all-ids)
     2045               (let ((ii-assoc
     2046                      (loop for ii-assoc in (slot-p construct 'item-identifiers)
     2047                         when (eql (identifier ii-assoc) item-identifier)
     2048                         return ii-assoc)))
     2049                 (add-to-version-history ii-assoc :start-revision revision)))
     2050              (t
     2051               (let ((assoc (make-instance 'ItemIdAssociationC
     2052                                           :parent-construct construct
     2053                                           :identifier item-identifier)))
     2054                 (add-to-version-history assoc :start-revision revision))))
     2055        (when (or (typep merged-construct 'TopicC)
     2056                  (typep merged-construct 'AssociationC)
     2057                  (typep merged-construct 'TopicMapC))
     2058          (add-to-version-history merged-construct :start-revision revision))
     2059        merged-construct))))
    20332060
    20342061
     
    20632090               (when inner-construct
    20642091                 (list inner-construct)))))
    2065         (cond ((find construct all-constructs)
    2066                (let ((reifier-assoc
    2067                       (loop for reifier-assoc in
    2068                            (slot-p merged-reifier-topic 'reified-construct)
    2069                          when (eql (reifiable-construct reifier-assoc)
    2070                                    construct)
    2071                          return reifier-assoc)))
    2072                  (add-to-version-history reifier-assoc :start-revision revision)
    2073                  construct))
    2074               (all-constructs
    2075                (merge-constructs (first all-constructs) construct))
    2076               (t
    2077                (let ((assoc
    2078                      (make-instance 'ReifierAssociationC
    2079                                      :reifiable-construct construct
    2080                                      :reifier-topic merged-reifier-topic)))
    2081                  (add-to-version-history assoc :start-revision revision))))
    2082         (when (or (typep construct 'TopicC)
    2083                   (typep construct 'AssociationC)
    2084                   (typep construct 'TopicMapC))
    2085           (add-to-version-history construct :start-revision revision))
    2086         construct))))
     2092        (let ((merged-construct construct))
     2093          (cond ((find construct all-constructs)
     2094                 (let ((reifier-assoc
     2095                        (loop for reifier-assoc in
     2096                             (slot-p merged-reifier-topic 'reified-construct)
     2097                           when (eql (reifiable-construct reifier-assoc)
     2098                                     construct)
     2099                           return reifier-assoc)))
     2100                   (add-to-version-history reifier-assoc
     2101                                           :start-revision revision)))
     2102                (all-constructs
     2103                 (merge-constructs (first all-constructs) construct))
     2104                (t
     2105                 (let ((assoc (make-instance 'ReifierAssociationC
     2106                                             :reifiable-construct construct
     2107                                             :reifier-topic merged-reifier-topic)))
     2108                   (add-to-version-history assoc :start-revision revision))))
     2109          (when (or (typep merged-construct 'TopicC)
     2110                    (typep merged-construct 'AssociationC)
     2111                    (typep merged-construct 'TopicMapC))
     2112            (add-to-version-history merged-construct :start-revision revision))
     2113          merged-construct)))))
    20872114
    20882115
     
    21102137
    21112138
     2139(defgeneric initialize-typable (construct instance-of &key start-revision)
     2140  (:documentation "Adds the passed instance-of to the given construct.")
     2141  (:method ((construct TypableC) instance-of
     2142            &key (start-revision *TM-REVISION*))
     2143    (declare (integer start-revision) (type (or null TopicC) instance-of))
     2144    (when instance-of
     2145      (add-type construct instance-of :revision start-revision))
     2146    construct))
     2147
     2148
    21122149(defgeneric equivalent-typable-construct (construct instance-of
    21132150                                                     &key start-revision)
     
    21282165        (AssociationC-p class-symbol)
    21292166        (CharacteristicC-p class-symbol))))
     2167
     2168
     2169(defgeneric initialize-scopable (construct themes &key start-revision)
     2170  (:documentation "Adds all passed themes to the given construct.")
     2171  (:method ((construct ScopableC) (themes list)
     2172            &key (start-revision *TM-REVISION*))
     2173    (declare (integer start-revision))
     2174    (dolist (theme themes)
     2175      (add-theme construct theme :revision start-revision))
     2176    construct))
    21302177
    21312178
     
    23252372   specific keyword arguments for their purpose."
    23262373  (declare (symbol class-symbol))
    2327   (let ((start-revision (getf args :start-revision))
    2328         (uri (getf args :uri))
    2329         (xtm-id (getf args :xtm-id))
    2330         (identified-construct (getf args :identified-construct))
    2331         (charvalue (getf args :charvalue))
    2332         (datatype (getf args :datatype))
    2333         (parent-construct (getf args :parent-construct))
    2334         (themes (getf args :themes))
    2335         (variants (getf args :variants))
    2336         (instance-of (getf args :instance-of))
    2337         (reifier-topic (getf args :reifier))
    2338         (item-identifiers (getf args :item-identifiers)))
    2339     (let ((construct
    2340            (cond
    2341              ((PointerC-p class-symbol)
    2342               (make-pointer class-symbol uri :start-revision start-revision
    2343                             :xtm-id xtm-id
    2344                             :identified-construct identified-construct))
    2345              ((CharacteristicC-p class-symbol)
    2346               (make-characteristic class-symbol charvalue
    2347                                    :start-revision start-revision
    2348                                    :datatype datatype :themes themes
    2349                                    :instance-of instance-of :variants variants
    2350                                    :parent-construct parent-construct)))))
    2351 
    2352       (when (typep construct 'ReifiableConstructC)
    2353         (when reifier-topic
    2354           (add-reifier construct reifier-topic :revision start-revision))
    2355         (dolist (ii item-identifiers)
    2356           (add-item-identifier construct ii :revision start-revision)))
    2357       construct)))
    2358 
    2359 
    2360 (defun make-characteristic (class-symbol charvalue
    2361                             &key (start-revision *TM-REVISION*)
    2362                             (datatype *xml-string*) (themes nil)
    2363                             (instance-of nil) (variants nil)
    2364                             (parent-construct nil))
     2374  (let ((construct
     2375         (cond
     2376           ((PointerC-p class-symbol)
     2377            (make-pointer class-symbol (getf args :uri) args))
     2378           ((CharacteristicC-p class-symbol)
     2379            (make-characteristic class-symbol (getf args :charvalue) args))
     2380           ((TopicC-p class-symbol)
     2381            (make-topic args)))))
     2382    construct))
     2383
     2384
     2385(defun merge-all-constructs(constructs-to-be-merged)
     2386  "Merges all constructs contained in the given list."
     2387  (declare (list constructs-to-be-merged))
     2388  (let ((constructs-to-be-merged (subseq constructs-to-be-merged 1))
     2389        (merged-construct (elt constructs-to-be-merged 0)))
     2390    (loop for construct-to-be-merged in constructs-to-be-merged
     2391       do (setf merged-construct
     2392                (merge-constructs merged-construct construct-to-be-merged)))))
     2393
     2394
     2395(defun make-tm (&rest args)
     2396  "Returns a topic map object. If the topic map has already existed the
     2397   existing one is returned otherwise a new one is created.
     2398   This function exists only for being used by make-construct!"
     2399  (let ((item-identifiers (getf (first args) :item-identifiers))
     2400        (reifier (getf (first args) :reifier))
     2401        (topics (getf (first args) :topics))
     2402        (assocs (getf (first args) :associations))
     2403        (start-revision (getf (first args) :start-revision)))
     2404    (let ((tm
     2405           (let ((existing-tms
     2406                  (remove-if
     2407                   #'null
     2408                   (map 'list #'(lambda(existing-tm)
     2409                                  (when (equivalent-construct
     2410                                         existing-tm
     2411                                         :item-identifiers item-identifiers
     2412                                         :reifier reifier)
     2413                                    existing-tm))
     2414                        (elephant:get-instances-by-class 'TopicMapC)))))
     2415             (cond ((and existing-tms (> (length existing-tms) 1))
     2416                    (merge-all-constructs existing-tms))
     2417                   (existing-tms
     2418                    (first existing-tms))
     2419                   (t
     2420                    (make-instance 'TopicMapC))))))
     2421      (dolist (top-or-assoc (union topics assocs))
     2422        (add-to-tm tm top-or-assoc))
     2423      (add-to-version-history tm :start-revision start-revision)
     2424      tm)))
     2425           
     2426
     2427(defun make-topic (&rest args)
     2428  "Returns a topic object. If the topic has already existed the existing one is
     2429   returned otherwise a new one is created.
     2430   This function exists only for being used by make-construct!"
     2431  (let ((start-revision (getf (first args) :start-revision))
     2432        (psis (getf (first args) :psis))
     2433        (locators (getf (first args) :locators))
     2434        (item-identifiers (getf (first args) :item-identifiers))
     2435        (topic-identifiers (getf (first args) :topic-identifiers))
     2436        (names (getf (first args) :names))
     2437        (occurrences (getf (first args) :occurrences)))
     2438    (let ((topic
     2439           (let ((existing-topics
     2440                  (remove-if
     2441                   #'null
     2442                   (map 'list #'(lambda(existing-topic)
     2443                                  (when (equivalent-construct
     2444                                         existing-topic
     2445                                         :start-revision start-revision
     2446                                         :psis psis :locators locators
     2447                                         :item-identifiers item-identifiers
     2448                                         :topic-identifiers topic-identifiers)
     2449                                    existing-topic))
     2450                        (elephant:get-instances-by-class 'TopicC)))))
     2451             (cond ((and existing-topics (> (length existing-topics) 1))
     2452                    (merge-all-constructs existing-topics))
     2453                   (existing-topics
     2454                    (first existing-topics))
     2455                   (t
     2456                    (make-instance 'TopicC))))))
     2457      (initialize-reifiable topic item-identifiers nil
     2458                            :start-revision start-revision)
     2459      (let ((merged-topic topic))
     2460        (dolist (psi psis)
     2461          (setf merged-topic (add-psi merged-topic psi
     2462                                      :revision start-revision)))
     2463        (dolist (locator locators)
     2464          (setf merged-topic (add-locator merged-topic locator
     2465                                          :revision start-revision)))
     2466        (dolist (name names)
     2467          (setf merged-topic (add-name topic name :revision start-revision)))
     2468        (dolist (occ occurrences)
     2469          (add-occurrence merged-topic occ :revision start-revision))
     2470        (add-to-version-history merged-topic :start-revision start-revision)
     2471        merged-topic))))
     2472
     2473
     2474(defun make-characteristic (class-symbol &rest args)
    23652475  "Returns a characteristic object with the passed parameters.
    23662476   If an equivalent construct has already existed this one is returned.
    23672477   To check if there is existing an equivalent construct the parameter
    2368    parent-construct must be set."
    2369   (declare (symbol class-symbol) (string charvalue) (integer start-revision)
    2370            (list themes variants)
    2371            (type (or null string) datatype)
    2372            (type (or null TopicC) instance-of)
    2373            (type (or null TopicC NameC) parent-construct))
    2374   (let ((characteristic
    2375          (let ((existing-characteristic
    2376                 (when parent-construct
     2478   parent-construct must be set.
     2479   This function only exists for being used by make-construct!"
     2480  (let ((charvalue (getf (first args) :charvalue))
     2481        (start-revision (getf (first args) :start-revision))
     2482        (datatype (getf (first args) :datatype))
     2483        (instance-of (getf (first args) :instance-of))
     2484        (themes (getf (first args) :themes))
     2485        (variants (getf (first args) :variants))
     2486        (reifier (getf (first args) :reifier))
     2487        (parent-construct (getf (first args) :parent-construct))
     2488        (item-identifiers (getf (first args) :item-identifiers)))
     2489    (let ((characteristic
     2490           (let ((existing-characteristic
     2491                  (when parent-construct
     2492                    (remove-if
     2493                     #'null
     2494                     (map 'list #'(lambda(existing-characteristic)
     2495                                    (when (equivalent-construct
     2496                                           existing-characteristic
     2497                                           :start-revision start-revision
     2498                                           :datatype datatype :variants variants
     2499                                           :charvalue charvalue :themes themes
     2500                                           :instance-of instance-of)
     2501                                      existing-characteristic))
     2502                          (get-all-characteristics parent-construct
     2503                                                   class-symbol))))))
     2504             (if existing-characteristic
     2505                 existing-characteristic
     2506                 (make-instance class-symbol :charvalue charvalue
     2507                                :datatype datatype)))))
     2508      (let ((merged-characteristic characteristic))
     2509        (setf merged-characteristic
     2510              (initialize-reifiable merged-characteristic item-identifiers
     2511                                    reifier :start-revision start-revision))
     2512        (initialize-scopable merged-characteristic themes
     2513                             :start-revision start-revision)
     2514        (initialize-typable merged-characteristic instance-of
     2515                            :start-revision start-revision)
     2516        (initialize-name merged-characteristic variants
     2517                         :start-revision start-revision)
     2518        (when parent-construct
     2519          (add-parent merged-characteristic parent-construct
     2520                      :revision start-revision))
     2521        merged-characteristic))))
     2522
     2523
     2524(defun make-pointer (class-symbol &rest args)
     2525  "Returns a pointer object with the specified parameters.
     2526   If an equivalen construct has already existed this one is returned.
     2527   This function only exists for beoing used by make-construct!"
     2528  (let ((uri (getf (first args) :uri))
     2529        (xtm-id (getf (first args) :xtm-id))
     2530        (start-revision (getf (first args) :start-revision))
     2531        (identified-construct (getf (first args) :identified-construct)))
     2532    (let ((identifier
     2533           (let ((existing-pointer
    23772534                  (remove-if
    23782535                   #'null
    2379                    (map 'list #'(lambda(existing-characteristic)
    2380                                   (when (equivalent-construct
    2381                                          existing-characteristic
    2382                                          :start-revision start-revision
    2383                                          :datatype datatype :themes themes
    2384                                          :instance-of instance-of)
    2385                                     existing-characteristic))
    2386                         (get-all-characteristics parent-construct
    2387                                                  class-symbol))))))
    2388            (if existing-characteristic
    2389                existing-characteristic
    2390                (make-instance class-symbol :charvalue charvalue
    2391                               :datatype datatype)))))
    2392     (dolist (theme themes)
    2393       (add-theme characteristic theme :revision start-revision))
    2394     (when instance-of
    2395       (add-type characteristic instance-of :revision start-revision))
    2396     (dolist (variant variants)
    2397       (add-variant characteristic variant :revision start-revision))
    2398     (when parent-construct
    2399       (add-parent characteristic parent-construct :revision start-revision))))
    2400 
    2401 
    2402 (defun make-pointer (class-symbol uri
    2403                      &key (start-revision *TM-REVISION*) (xtm-id nil)
    2404                      (identified-construct nil))
    2405   "Returns a pointer object with the specified parameters.
    2406    If an equivalen construct has already existed this one is returned."
    2407   (declare (symbol class-symbol) (string uri) (integer start-revision)
    2408            (type (or null string) xtm-id)
    2409            (type (or null ReifiableconstructC)))
    2410   (let ((identifier
    2411          (let ((existing-pointer
    2412                 (remove-if
    2413                  #'null
    2414                  (map 'list
    2415                       #'(lambda(existing-pointer)
    2416                           (when (equivalent-construct existing-pointer :uri uri
    2417                                                       :xtm-id xtm-id)
    2418                             existing-pointer))
    2419                       (elephant:get-instances-by-value class-symbol 'd::uri uri)))))
    2420            (if existing-pointer existing-pointer
    2421                (make-instance class-symbol :uri uri :xtm-id xtm-id)))))
    2422     (when identified-construct
    2423       (cond ((TopicIdentificationC-p class-symbol)
    2424              (add-topic-identifier identified-construct identifier
    2425                                    :revision start-revision))
    2426             ((PersistentIdC-p class-symbol)
    2427              (add-psi identified-construct identifier :revision start-revision))
    2428             ((ItemIdentifierC-p class-symbol)
    2429              (add-item-identifier identified-construct identifier
    2430                                   :revision start-revision))
    2431             ((SubjectLocatorC-p class-symbol)
    2432              (add-locator identified-construct identifier
    2433                           :revision start-revision))))
    2434     identifier))
     2536                   (map 'list
     2537                        #'(lambda(existing-pointer)
     2538                            (when (equivalent-construct existing-pointer uri
     2539                                                        xtm-id)
     2540                              existing-pointer))
     2541                        (elephant:get-instances-by-value class-symbol 'd::uri uri)))))
     2542             (if existing-pointer existing-pointer
     2543                 (make-instance class-symbol :uri uri :xtm-id xtm-id)))))
     2544      (when identified-construct
     2545        (cond ((TopicIdentificationC-p class-symbol)
     2546               (add-topic-identifier identified-construct identifier
     2547                                     :revision start-revision))
     2548              ((PersistentIdC-p class-symbol)
     2549               (add-psi identified-construct identifier :revision start-revision))
     2550              ((ItemIdentifierC-p class-symbol)
     2551               (add-item-identifier identified-construct identifier
     2552                                    :revision start-revision))
     2553              ((SubjectLocatorC-p class-symbol)
     2554               (add-locator identified-construct identifier
     2555                            :revision start-revision))))
     2556      identifier)))
    24352557                     
    24362558           
  • TabularUnified branches/new-datamodel/src/rest_interface/rest-interface.lisp

    r176 r234  
    7272        (flex:make-external-format :utf-8 :eol-style :lf))
    7373  (setf atom:*base-url* (format nil "http://~a:~a" host-name port))
    74   (elephant:open-store 
    75    (xml-importer:get-store-spec repository-path))
     74  (unless elephant:*store-controller*
     75    (elephant:open-store 
     76     (xml-importer:get-store-spec repository-path)))
    7677  (load conffile)
    7778  (publish-feed atom:*tm-feed*)
  • TabularUnified branches/new-datamodel/src/rest_interface/set-up-json-interface.lisp

    r208 r234  
    227227          (setf (hunchentoot:content-type*) "application/json") ;RFC 4627
    228228          (let ((fragment
    229                  (with-writer-lock
    230                    (create-latest-fragment-of-topic identifier))))
     229                 (with-reader-lock
     230                   (get-latest-fragment-of-topic identifier))))
    231231            (if fragment
    232232                (handler-case (with-reader-lock
     
    252252          (setf (hunchentoot:content-type*) "application/json") ;RFC 4627
    253253          (let ((fragment
    254                  (with-writer-lock
    255                    (create-latest-fragment-of-topic identifier))))
     254                 (with-reader-lock
     255                   (get-latest-fragment-of-topic identifier))))
    256256            (if fragment
    257257                (handler-case (with-reader-lock
  • TabularUnified branches/new-datamodel/src/unit_tests/datamodel_test.lisp

    r231 r234  
    13761376          (scope-2 (make-instance 'd:TopicC))
    13771377          (scope-3 (make-instance 'd:TopicC))
    1378           (reifier-1 (make-instance 'd:TopicC))
    1379           (reifier-2 (make-instance 'd:TopicC))
    1380           (ii-1 (make-instance 'd:ItemIdentifierC :uri "ii-1"))
    1381           (ii-2 (make-instance 'd:ItemIdentifierC :uri "ii-2"))
    13821378          (revision-0-5 50)
    13831379          (version-1 100))
     
    14041400      (is-false (d::equivalent-construct
    14051401                 occ-1 :charvalue "occ-2" :datatype constants:*xml-string*
    1406                  :instance-of type-1 :themes (list scope-2 scope-1)))
    1407       (add-item-identifier occ-1 ii-1)
    1408       (is-true (d::equivalent-construct occ-1 :item-identifiers (list ii-1)))
    1409       (is-false (d::equivalent-construct occ-1 :item-identifiers (list ii-2)))
    1410       (add-reifier occ-1 reifier-1)
    1411       (is-true (d::equivalent-construct occ-1 :reifier reifier-1))
    1412       (is-false (d::equivalent-construct occ-1 :reifier reifier-2)))))
     1402                 :instance-of type-1 :themes (list scope-2 scope-1))))))
    14131403
    14141404
     
    14221412          (scope-2 (make-instance 'd:TopicC))
    14231413          (scope-3 (make-instance 'd:TopicC))
    1424           (reifier-1 (make-instance 'd:TopicC))
    1425           (reifier-2 (make-instance 'd:TopicC))
    1426           (ii-1 (make-instance 'd:ItemIdentifierC :uri "ii-1"))
    1427           (ii-2 (make-instance 'd:ItemIdentifierC :uri "ii-2"))
    14281414          (revision-0-5 50)
    14291415          (version-1 100))
     
    14471433      (is-false (d::equivalent-construct
    14481434                 nam-1 :charvalue "nam-2" :instance-of type-1
    1449                  :themes (list scope-2 scope-1)))
    1450       (add-item-identifier nam-1 ii-1)
    1451       (is-true (d::equivalent-construct nam-1 :item-identifiers (list ii-1)))
    1452       (is-false (d::equivalent-construct nam-1 :item-identifiers (list ii-2)))
    1453       (add-reifier nam-1 reifier-1)
    1454       (is-true (d::equivalent-construct nam-1 :reifier reifier-1))
    1455       (is-false (d::equivalent-construct nam-1 :reifier reifier-2)))))
     1435                 :themes (list scope-2 scope-1))))))
    14561436
    14571437
     
    14631443          (scope-2 (make-instance 'd:TopicC))
    14641444          (scope-3 (make-instance 'd:TopicC))
    1465           (reifier-1 (make-instance 'd:TopicC))
    1466           (reifier-2 (make-instance 'd:TopicC))
    1467           (ii-1 (make-instance 'd:ItemIdentifierC :uri "ii-1"))
    1468           (ii-2 (make-instance 'd:ItemIdentifierC :uri "ii-2"))
    14691445          (revision-0-5 50)
    14701446          (version-1 100))
     
    14871463      (is-false (d::equivalent-construct
    14881464                 var-1 :charvalue "var-2" :datatype constants:*xml-string*
    1489                  :themes (list scope-2 scope-1)))
    1490       (add-item-identifier var-1 ii-1)
    1491       (is-true (d::equivalent-construct var-1 :item-identifiers (list ii-1)))
    1492       (is-false (d::equivalent-construct var-1 :item-identifiers (list ii-2)))
    1493       (add-reifier var-1 reifier-1)
    1494       (is-true (d::equivalent-construct var-1 :reifier reifier-1))
    1495       (is-false (d::equivalent-construct var-1 :reifier reifier-2)))))
     1465                 :themes (list scope-2 scope-1))))))
    14961466
    14971467
     
    15041474          (player-1 (make-instance 'd:TopicC))
    15051475          (player-2 (make-instance 'd:TopicC))
    1506           (ii-1 (make-instance 'd:ItemIdentifierC :uri "ii-1"))
    1507           (ii-2 (make-instance 'd:ItemIdentifierC :uri "ii-2"))
    1508           (ii-3 (make-instance 'd:ItemIdentifierC :uri "ii-3"))
    1509           (reifier-1 (make-instance 'd:TopicC))
    1510           (reifier-2 (make-instance 'd:TopicC))
    15111476          (revision-1 100)
    15121477          (revision-2 200))
     
    15141479      (add-type role-1 type-1)
    15151480      (add-player role-1 player-1)
    1516       (add-item-identifier role-1 ii-1)
    1517       (add-item-identifier role-1 ii-2)
    1518       (add-reifier role-1 reifier-1)
    15191481      (is-true (d::equivalent-construct role-1 :player player-1
    15201482                                        :instance-of type-1))
    1521       (is-true (d::equivalent-construct role-1
    1522                                         :item-identifiers (list ii-1 ii-3)))
    1523       (is-true (d::equivalent-construct role-1 :reifier reifier-1))
    15241483      (is-false (d::equivalent-construct role-1 :player player-2
    15251484                                         :instance-of type-1))
    15261485      (is-false (d::equivalent-construct role-1 :player player-1
    15271486                                         :instance-of type-2))
    1528       (is-false (d::equivalent-construct role-1
    1529                                          :item-identifiers (list ii-3)))
    1530       (is-false (d::equivalent-construct role-1 :reifier reifier-2))
    15311487      (setf *TM-REVISION* revision-2)
    1532       (delete-item-identifier role-1 ii-1 :revision revision-2)
    15331488      (delete-player role-1 player-1 :revision revision-2)
    15341489      (add-player role-1 player-2)
    15351490      (delete-type role-1 type-1 :revision revision-2)
    15361491      (add-type role-1 type-2)
    1537       (delete-reifier role-1 reifier-1 :revision revision-2)
    1538       (add-reifier role-1 reifier-2)
    15391492      (is-true (d::equivalent-construct role-1 :player player-2
    15401493                                        :instance-of type-2))
    1541       (is-true (d::equivalent-construct role-1
    1542                                         :item-identifiers (list ii-2)))
    1543       (is-true (d::equivalent-construct role-1 :reifier reifier-2))
    15441494      (is-false (d::equivalent-construct role-1 :player player-1
    15451495                                         :instance-of type-2))
    15461496      (is-false (d::equivalent-construct role-1 :player player-2
    1547                                          :instance-of type-1))
    1548       (is-false (d::equivalent-construct role-1
    1549                                          :item-identifiers (list ii-1)))
    1550       (is-false (d::equivalent-construct role-1 :reifier reifier-1))
    1551       (is-true (d::equivalent-construct role-1 :start-revision revision-1
    1552                                         :item-identifiers (list ii-1)))
    1553       (is-true (d::equivalent-construct role-1 :reifier reifier-1
    1554                                         :start-revision revision-1)))))
     1497                                         :instance-of type-1)))))
    15551498
    15561499
     
    15671510          (scope-2 (make-instance 'd:TopicC))
    15681511          (scope-3 (make-instance 'd:TopicC))
    1569           (ii-1 (make-instance 'd:ItemIdentifierC :uri "ii-1"))
    1570           (ii-2 (make-instance 'd:ItemIdentifierC :uri "ii-2"))
    1571           (reifier-1 (make-instance 'd:TopicC))
    1572           (reifier-2 (make-instance 'd:TopicC))
    15731512          (revision-1 100))
    15741513      (setf *TM-REVISION* revision-1)
     
    15781517      (d:add-theme assoc-1 scope-1)
    15791518      (d:add-theme assoc-1 scope-2)
    1580       (d:add-item-identifier assoc-1 ii-1)
    1581       (d:add-reifier assoc-1 reifier-1)
    15821519      (is-true (d::equivalent-construct
    15831520                assoc-1 :roles (list role-1 role-2) :instance-of type-1
    15841521                :themes (list scope-1 scope-2)))
    1585       (is-true (d::equivalent-construct assoc-1
    1586                                         :item-identifiers (list ii-1 ii-2)))
    1587       (is-true (d::equivalent-construct assoc-1 :reifier reifier-1))
    15881522      (is-false (d::equivalent-construct
    15891523                 assoc-1 :roles (list role-1 role-2 role-3) :instance-of type-1
     
    15941528      (is-false (d::equivalent-construct
    15951529                 assoc-1 :roles (list role-1 role-2) :instance-of type-1
    1596                  :themes (list scope-1 scope-3 scope-2)))
    1597       (is-false (d::equivalent-construct assoc-1 :item-identifiers (list ii-2)))
    1598       (is-false (d::equivalent-construct assoc-1 :reifeir reifier-2)))))
     1530                 :themes (list scope-1 scope-3 scope-2))))))
    15991531
    16001532
     
    16091541          (psi-1 (make-instance 'd:PersistentIdC :uri "psi-1"))
    16101542          (psi-2 (make-instance 'd:PersistentIdC :uri "psi-2"))
     1543          (tid-1 (make-instance 'd:TopicIdentificationC :uri "tid-1"
     1544                                :xtm-id "xtm-id-1"))
     1545          (tid-2 (make-instance 'd:TopicIdentificationC :uri "tid-2"
     1546                                :xtm-id "xtm-id-2"))
    16111547          (revision-1 100))
    16121548      (setf *TM-REVISION* revision-1)
     
    16141550      (d:add-locator top-1 sl-1)
    16151551      (d:add-psi top-1 psi-1)
     1552      (d:add-topic-identifier top-1 tid-1)
    16161553      (is-true (d::equivalent-construct top-1
    16171554                                        :item-identifiers (list ii-1 ii-2)))
     
    16211558      (is-true (d::equivalent-construct top-1 :locators (list sl-1 sl-2)))
    16221559      (is-true (d::equivalent-construct top-1 :psis (list psi-1 psi-2)))
     1560      (is-true (d::equivalent-construct top-1 :topic-identifiers (list tid-1)))
     1561      (is-false (d::equivalent-construct top-1 :topic-identifiers (list tid-2)))
    16231562      (is-false (d::equivalent-construct top-1 :item-identifiers (list ii-2)
    16241563                                         :psis (list psi-2)
  • TabularUnified branches/new-datamodel/src/xml/rdf/importer.lisp

    r172 r234  
    2121  (init-rdf-module)
    2222  (rdf-importer rdf-xml-path repository-path :tm-id tm-id
    23                 :document-id document-id)
    24   (when elephant:*store-controller*
    25     (elephant:close-store)))
     23                :document-id document-id))
     24;  (when elephant:*store-controller*
     25;    (elephant:close-store)))
    2626
    2727
     
    4747            (length (elephant:get-instances-by-class 'TopicC))
    4848            (length (elephant:get-instances-by-class 'AssociationC)))
    49     (elephant:close-store)
     49;    (elephant:close-store)
    5050    (setf *_n-map* nil)))
    5151
  • TabularUnified branches/new-datamodel/src/xml/xtm/setup.lisp

    r95 r234  
    5151     (get-store-spec repository-path)))
    5252  (init-isidorus)
    53   (import-xtm xtm-path repository-path :tm-id tm-id :xtm-id xtm-id :xtm-format xtm-format)
    54   (when elephant:*store-controller*
    55     (elephant:close-store)))
     53  (import-xtm xtm-path repository-path :tm-id tm-id :xtm-id xtm-id :xtm-format xtm-format))
     54;  (when elephant:*store-controller*
     55;    (elephant:close-store)))
Note: See TracChangeset for help on using the changeset viewer.