[isidorus-cvs] r204 - branches/new-datamodel/src/model trunk/src/model

[Lukas Giessmann]

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)))