Author: lgiessmann Date: Wed Feb 24 11:04:46 2010 New Revision: 204
Log: new-datamodel: added the functions get-item-by-item-identifier, get-item-by-psi, get-item-by-locator; fixed a bug in the function get-item-by-id -> ticket #65
Modified: branches/new-datamodel/src/model/datamodel.lisp trunk/src/model/datamodel.lisp
Modified: branches/new-datamodel/src/model/datamodel.lisp ============================================================================== --- branches/new-datamodel/src/model/datamodel.lisp (original) +++ branches/new-datamodel/src/model/datamodel.lisp Wed Feb 24 11:04:46 2010 @@ -10,6 +10,8 @@ (defpackage :datamodel (:use :cl :elephant :constants) (:nicknames :d) + (:import-from :exceptions + duplicate-identifier-error) (:export ;;classes :TopicMapC :AssociationC @@ -79,6 +81,11 @@ :in-topicmaps :delete-construct :get-revision + :get-item-by-id + :get-item-by-psi + :get-item-by-item-identnfier + :get-item-by-locator + :string-integer-p
;;globals :*TM-REVISION* @@ -87,6 +94,12 @@ (in-package :datamodel)
+;;TODO: fix this line (make-instance 'TopicC :from-oid (subseq topic-id 1))))) +;; in get-item-by-id +;;TODO: implement get-item-by-id(TopicC) + unit-tests +;;TODO: implement get-item-by-psi(TopicC) + unit-tests +;;TODO: implement get-item-by-locator(TopicC) + unit-tests +;;TODO: implement get-item-by-item-identifier(ReifiableConstructC) + unit-tests ;;TODO: replace add-to-version-history in VersionedAssociationC with a pseudo ;; initarg in make-construct ;;TODO: implement a macro "with-merge-construct" that merges constructs @@ -609,6 +622,13 @@ (get-universal-time))
+(defun string-integer-p (integer-as-string) + "Returns t if the passed string can be parsed to an integer." + (handler-case (when (parse-integer integer-as-string) + t) + (condition () nil))) + + ;;; generic functions/accessors ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; VersionInfocC (defmethod delete-construct :before ((version-info VersionInfoC)) @@ -1061,6 +1081,96 @@ (filter-slot-value-by-revision topic 'in-topicmaps :start-revision revision))
+(defun get-item-by-id (topic-id &key (xtm-id *CURRENT-XTM*) (revision 0) (error-if-nil nil)) + "Gets a topic by its id, assuming an xtm-id. If xtm-id is empty, the current TM + is chosen. If xtm-id is nil, choose the global TM with its internal ID, if + applicable in the correct revision. If revison is provided, then the code checks + if the topic already existed in this revision and returns nil otherwise. + If no item meeting the constraints was found, then the return value is either + NIL or an error is thrown, depending on error-if-nil." + (declare (string topic-id) (integer revision) (string xtm-id)) + (let ((result + (if xtm-id + (let ((possible-top-ids + (delete-if-not + #'(lambda(top-id) + (and (string= (xtm-id top-id) xtm-id) + (string= (uri top-id) topic-id))) + ;fixes a bug in get-instances-by-value that does a + ;case-insensitive comparision + (elephant:get-instances-by-value + 'TopicIdentificationC + 'uri + topic-id)))) + (when (and possible-top-ids + (identified-construct (first possible-top-ids) :revision revision)) + (unless (= (length possible-top-ids) 1) + (error (make-condition 'duplicate-identifier-error + :message (format nil "(length possible-items ~a) for id ~a and xtm-id ~a > 1" + possible-top-ids topic-id xtm-id) + :uri topic-id))) + (identified-construct (first possible-top-ids) + :revision revision) + ;no revision need not to be chaecked, since the revision + ;is implicitely checked by the function identified-construct + )) + (when (and (> (length topic-id) 0) + (eql (elt 0 topic-id) #\t) + (string-integer-p (subseq topic-id 1))) + (elephant::controller-recreate-instance elephant::*store-controller* (subseq topic-id 1)))))) + (if (and error-if-nil (not result)) + (error "No such item (id: ~a, tm: ~a, rev: ~a)" topic-id xtm-id revision) + result))) + + +(defun get-item-by-identifier (uri &key (revision 0) + (identifier-type-symbol 'PersistentIdC) + (error-if-nil nil)) + "Returns the construct that is bound to the given identifier-uri." + (declare (string uri) (integer revision) (symbol identifier-type-symbol)) + (let ((result + (let ((possible-ids + (delete-if-not + #'(lambda(id) + (string= (uri id) uri)) + (get-instances-by-class identifier-type-symbol)))) + (when (and possible-ids + (identified-construct (first possible-ids) :revision revision)) + (unless (= (length possible-ids) 1) + (error (make-condition 'duplicate-identifier-error + :message (format nil "(length possible-items ~a) for id ~a" + possible-ids uri) + :uri uri))) + (identified-construct (first possible-ids) + :revision revision))))) + ;no revision need not to be checked, since the revision + ;is implicitely checked by the function identified-construct + (if result + result + (when error-if-nil + (error "No such item is bound to the given identifier uri."))))) + + +(defun get-item-by-item-identifier (uri &key (revision 0) (error-if-nil nil)) + "Returns a ReifiableConstructC that is bound to the identifier-uri." + (get-item-by-identifier uri :revision revision + :identifier-type-symbol 'ItemIdentifierC + :error-if-nil error-if-nil)) + + +(defun get-item-by-psi (uri &key (revision 0) (error-if-nil nil)) + "Returns a TopicC that is bound to the identifier-uri." + (get-item-by-identifier uri :revision revision + :identifier-type-symbol 'PersistentIdC + :error-if-nil error-if-nil)) + + +(defun get-item-by-locator (uri &key (revision 0) (error-if-nil nil)) + "Returns a TopicC that is bound to the identifier-uri." + (get-item-by-identifier uri :revision revision + :identifier-type-symbol 'SubjectLocatorC + :error-if-nil error-if-nil)) +
;;; NameC (defgeneric variants (construct &key revision)
Modified: trunk/src/model/datamodel.lisp ============================================================================== --- trunk/src/model/datamodel.lisp (original) +++ trunk/src/model/datamodel.lisp Wed Feb 24 11:04:46 2010 @@ -1360,7 +1360,7 @@ (if (= revision 0) found-topic (find-item-by-revision found-topic revision))))) - (make-instance 'TopicC :from-oid (subseq topicid 1))))) + (elephant::controller-recreate-instance elephant:*store-controller* (subseq topicid 1))))) (if (and error-if-nil (not result)) (error (format nil "no such item (id: ~a, tm: ~a, rev: ~a)" topicid xtm-id revision)) result)))