April 2010 - isidorus-cvs@common-lisp.net

[isidorus-cvs] r282 - trunk/src/ajax/javascripts
by Lukas Giessmann 16 Apr '10

16 Apr '10

Author: lgiessmann Date: Fri Apr 16 05:16:36 2010 New Revision: 282 Log: ui: after deleting an occurrence or name, the item-identifiers which existed before the deleteing-operation are removed Modified: trunk/src/ajax/javascripts/datamodel.js Modified: trunk/src/ajax/javascripts/datamodel.js ============================================================================== --- trunk/src/ajax/javascripts/datamodel.js (original) +++ trunk/src/ajax/javascripts/datamodel.js Fri Apr 16 05:16:36 2010 @@ -4416,6 +4416,10 @@ else { if(type === "Occurrence"){ objectToDelete.__value__.setValue(""); } else { objectToDelete.__value__.__frames__[0].__content__.setValue(""); } + var ii = objectToDelete.__itemIdentity__; + objectToDelete.__itemIdentity__ = new ItemIdentityC(null, objectToDelete); + ii.append(objectToDelete.__itemIdentity__.getFrame()); + ii.remove(); } } });

1 0

[isidorus-cvs] r281 - trunk/src/ajax/javascripts
by Lukas Giessmann 16 Apr '10

16 Apr '10

Author: lgiessmann Date: Fri Apr 16 02:20:22 2010 New Revision: 281 Log: ui: the delete-buttons are only displayed if the object exists --> empty templates have no delete-button Modified: trunk/src/ajax/javascripts/datamodel.js Modified: trunk/src/ajax/javascripts/datamodel.js ============================================================================== --- trunk/src/ajax/javascripts/datamodel.js (original) +++ trunk/src/ajax/javascripts/datamodel.js Fri Apr 16 02:20:22 2010 @@ -1448,10 +1448,14 @@ }); } - var myself = this; - this.__table__.insert({"bottom" : makeRemoveLink(function(event){ - makeDeleteObject("Name", myself); - }, "delete Name")}); + + // --- mark-as-deleted + if(contents){ + var myself = this; + this.__table__.insert({"bottom" : makeRemoveLink(function(event){ + makeDeleteObject("Name", myself); + }, "delete Name")}); + } } catch(err){ alert("From NameC(): " + err); @@ -1496,7 +1500,9 @@ this.getFrame().select("tr." + CLASSES.scopeContainer())[0].hide(); this.getFrame().select("tr." + CLASSES.valueFrame())[0].hide(); this.getFrame().select("tr." + CLASSES.variantContainer())[0].hide(); - this.getFrame().select("tr." + CLASSES.removeNameRow())[0].hide(); + if(this.getFrame().select("tr." + CLASSES.removeNameRow()).length > 0){ + this.getFrame().select("tr." + CLASSES.removeNameRow())[0].hide(); + } this.__isMinimized__ = true; } else { @@ -1506,7 +1512,11 @@ this.getFrame().select("tr." + CLASSES.scopeContainer())[0].show(); this.getFrame().select("tr." + CLASSES.valueFrame())[0].show(); this.getFrame().select("tr." + CLASSES.variantContainer())[0].show(); - this.getFrame().select("tr." + CLASSES.removeNameRow())[0].show(); + if(this.getFrame().select("tr." + CLASSES.removeNameRow()).length > 0){ + if(this.__disabled__ === false){ + this.getFrame().select("tr." + CLASSES.removeNameRow())[0].show(); + } + } this.__isMinimized__ = false; } }, @@ -1520,6 +1530,9 @@ this.getFrame().writeAttribute({"class" : CLASSES.disabled()}); this.getFrame().writeAttribute({"title" : this.__cssTitle__}); this.getFrame().select("tr." + CLASSES.removeNameRow())[0].disable(); + if(this.getFrame().select("tr." + CLASSES.removeNameRow()).length > 0){ + this.getFrame().select("tr." + CLASSES.removeNameRow())[0].hide(); + } this.hideAddButton(); this.__disabled__ = true; }, @@ -1532,6 +1545,9 @@ this.getFrame().writeAttribute({"class" : CLASSES.nameFrame()}); this.getFrame().removeAttribute("title"); this.getFrame().select("tr." + CLASSES.removeNameRow())[0].enable(); + if(this.getFrame().select("tr." + CLASSES.removeNameRow()).length > 0){ + this.getFrame().select("tr." + CLASSES.removeNameRow())[0].show(); + } checkRemoveAddButtons(this.__owner__, 1, this.__max__, this); this.__disabled__ = false; }}); @@ -1751,91 +1767,6 @@ }}); -function makeRemoveLink (removeHandler, textContent){ - var link = new Element("span", {"class" : CLASSES.removeLink()}).update(textContent); - var trClass = null; - switch(textContent){ - case "delete Occurrence" : trClass = CLASSES.removeOccurrenceRow(); break; - case "delete Topic" : trClass = CLASSES.removeTopicRow(); break; - case "delete Name" : trClass = CLASSES.removeNameRow(); break; - } - - var tr = new Element("tr", {"class" : trClass}).insert(new Element("td", {"colspan" : 3}).insert(link)); - if(removeHandler){ link.observe("click", removeHandler); } - return tr; -} - - -function makeDeleteObject(type, objectToDelete){ - if(type !== "Occurrence" && type !== "Name" && type !== "Variant" - && type !== "Topic" && type !== "Association"){ - throw "From makeDeleteObject(): type must be: \"Occurrence\" || \"Name\" " + - "|| \"Variant\" || \"Topic\" || \"Association\" but is " + type; - } - if (!objectToDelete){ - throw "From makeDeleteObject(): objectToDelete must be set"; - } - - var parentTopic = "null"; - if(type === "Occurrence" || type === "Name"){ - var psiFrame = objectToDelete.getFrame().parentNode.parentNode.parentNode.parentNode.select("tr." + CLASSES.subjectIdentifierFrame())[0]; - var psiFields = psiFrame.select("input"); - for(i = 0; psiFields && i !== psiFields.length; ++i){ - var psiValue = psiFields[i].value; - if(psiValue.strip().length !== 0){ - parentTopic = psiValue.strip().toJSON(); - break; - } - } - } - - var topics = "null"; - if (type === "Topic"){ - var psiFrame = objectToDelete.getFrame().select("tr." + CLASSES.subjectIdentifierFrame())[0]; - var psiFields = psiFrame.select("input"); - for(i = 0; psiFields && i !== psiFields.length; ++i){ - var psiValue = psiFields[i].value; - if(psiValue.strip().length !== 0){ - topics = new Array(psiValue.strip()).toJSON(); - break; - } - } - } - - var deletedObjects = null; - if(type === "Topic"){ deletedObjects = topics; } - else { deletedObjects = "[" + objectToDelete.toJSON() + "]"; } - - var jsonData = "{\"type\":\"" + type + "\"," + - "\"topics\":" + topics + "," + - "\"associations\":" + "null" + "," + - "\"parentTopic\":" + parentTopic + "," + - "\"parentName\":" + "null" + "," + - "\"names\":" + (type === "Name" ? deletedObjects : "null") + "," + - "\"variants\":" + "null" + "," + - "\"occurrences\":" + (type === "Occurrence" ? deletedObjects : "null") + "," + - "\"parentAssociation\":" + "null" + "," + - "\"roles\":" + "null" + "}"; - - commitDeletedObject(jsonData, function(xhr){ - alert("Objected deleted"); - if(type === "Topic"){ - $(CLASSES.subPage()).update(); - makeHome(); - } - else if (type === "Occurrence" || type === "Name"){ - if(objectToDelete.__owner__.__frames__.length > objectToDelete.__max__ - && objectToDelete.__owner__.__frames__.length > 1){ - objectToDelete.remove(); - } - else { - if(type === "Occurrence"){ objectToDelete.__value__.setValue(""); } - else { objectToDelete.__value__.__frames__[0].__content__.setValue(""); } - } - } - }); - -} // --- represenation of an occurrence element var OccurrenceC = Class.create(ContainerC, {"initialize" : function($super, contents, occurrenceTypes, constraint, uniqueConstraints, owner, min, max, cssTitle, dblClickHandler){ @@ -1921,10 +1852,15 @@ dblClickHandler(owner, event); }); } - var myself = this; - this.__table__.insert({"bottom" : makeRemoveLink(function(event){ - makeDeleteObject("Occurrence", myself); - }, "delete Occurrence")}); + + + // --- mark-as-deleted + if(contents){ + var myself = this; + this.__table__.insert({"bottom" : makeRemoveLink(function(event){ + makeDeleteObject("Occurrence", myself); + }, "delete Occurrence")}); + } } catch(err){ alert("From OccurrenceC(): " + err); @@ -1993,7 +1929,9 @@ this.getFrame().select("tr." + CLASSES.scopeContainer())[0].hide(); this.getFrame().select("tr." + CLASSES.valueFrame())[0].hide(); this.getFrame().select("tr." + CLASSES.datatypeFrame())[0].hide(); - this.getFrame().select("tr." + CLASSES.removeOccurrenceRow())[0].hide(); + if(this.getFrame().select("tr." + CLASSES.removeOccurrenceRow()).length > 0){ + this.getFrame().select("tr." + CLASSES.removeOccurrenceRow())[0].hide(); + } this.__isMinimized__ = true; } else { @@ -2003,10 +1941,12 @@ this.getFrame().select("tr." + CLASSES.scopeContainer())[0].show(); this.getFrame().select("tr." + CLASSES.valueFrame())[0].show(); this.getFrame().select("tr." + CLASSES.datatypeFrame())[0].show(); - if(this.__disabled__ === false){ - this.getFrame().select("tr." + CLASSES.removeOccurrenceRow())[0].show(); + if(this.getFrame().select("tr." + CLASSES.removeOccurrenceRow()).length > 0){ + if(this.__disabled__ === false){ + this.getFrame().select("tr." + CLASSES.removeOccurrenceRow())[0].show(); + } } - this.__isMinimized__ = false; + this.__isMinimized__ = false; } }, "disable" : function(){ @@ -2019,7 +1959,9 @@ this.getFrame().writeAttribute({"class" : CLASSES.disabled()}); this.getFrame().writeAttribute({"title" : this.__cssTitle__}); this.hideAddButton(); - this.getFrame().select("tr." + CLASSES.removeOccurrenceRow())[0].hide(); + if(this.getFrame().select("tr." + CLASSES.removeOccurrenceRow()).length > 0){ + this.getFrame().select("tr." + CLASSES.removeOccurrenceRow())[0].hide(); + } this.__disabled__ = true; }, "enable" : function(){ @@ -2032,7 +1974,9 @@ this.getFrame().removeAttribute("style"); this.getFrame().removeAttribute("title"); checkRemoveAddButtons(this.__owner__, 1, this.__max__, this); - this.getFrame().select("tr." + CLASSES.removeOccurrenceRow())[0].show(); + if(this.getFrame().select("tr." + CLASSES.removeOccurrenceRow()).length > 0){ + this.getFrame().select("tr." + CLASSES.removeOccurrenceRow())[0].show(); + } this.__disabled__ = false; }}); @@ -2328,10 +2272,12 @@ this.__occurrence__ = new OccurrenceContainerC(occurrencesContent, _constraints); this.__table__.insert({"bottom" : newRow(CLASSES.occurrenceContainer(), "Occurrences", this.__occurrence__.getFrame())}); - var myself = this; - this.__table__.insert({"bottom" : makeRemoveLink(function(event){ - makeDeleteObject("Topic", myself); - }, "delete Topic")}); + // --- mark-as-deleted + if(content){ + var myself = this; + this.__table__.insert({"bottom" : makeRemoveLink(function(event){ + makeDeleteObject("Topic", myself); + }, "delete Topic")});} }catch(err){ alert("From TopciC(): " + err); } @@ -2371,8 +2317,10 @@ this.getFrame().select("tr." + CLASSES.subjectLocatorFrame())[0], this.getFrame().select("tr." + CLASSES.subjectIdentifierFrame())[0], this.getFrame().select("tr." + CLASSES.nameContainer())[0], - this.getFrame().select("tr." + CLASSES.occurrenceContainer())[0], - this.getFrame().select("tr." + CLASSES.removeTopicRow())[0]); + this.getFrame().select("tr." + CLASSES.occurrenceContainer())[0]); + if(this.getFrame().select("tr." + CLASSES.removeTopicRow()).length > 0){ + rows.push(this.getFrame().select("tr." + CLASSES.removeTopicRow())[0]); + } for(var i = 0; i != rows.length; ++i){ if(this.__minimized__ === false) rows[i].hide(); else rows[i].show(); @@ -4382,4 +4330,93 @@ var tr = newRow(CLASSES.typeFrame(), "Type", new SelectrowC(types, myself.__type__, 1, 1).getFrame()); myself.__table__.insert({"bottom" : tr}); return types; +} + + +// --- Returns a span that works like a button and calls the removeHandler +// --- by a click event +function makeRemoveLink (removeHandler, textContent){ + var link = new Element("span", {"class" : CLASSES.removeLink()}).update(textContent); + var trClass = null; + switch(textContent){ + case "delete Occurrence" : trClass = CLASSES.removeOccurrenceRow(); break; + case "delete Topic" : trClass = CLASSES.removeTopicRow(); break; + case "delete Name" : trClass = CLASSES.removeNameRow(); break; + } + + var tr = new Element("tr", {"class" : trClass}).insert(new Element("td", {"colspan" : 3}).insert(link)); + if(removeHandler){ link.observe("click", removeHandler); } + return tr; +} + + +// --- calls the given object's mark-as-deleted service +function makeDeleteObject(type, objectToDelete){ + if(type !== "Occurrence" && type !== "Name" && type !== "Variant" + && type !== "Topic" && type !== "Association"){ + throw "From makeDeleteObject(): type must be: \"Occurrence\" || \"Name\" " + + "|| \"Variant\" || \"Topic\" || \"Association\" but is " + type; + } + if (!objectToDelete){ + throw "From makeDeleteObject(): objectToDelete must be set"; + } + + var parentTopic = "null"; + if(type === "Occurrence" || type === "Name"){ + var psiFrame = objectToDelete.getFrame().parentNode.parentNode.parentNode.parentNode.select("tr." + CLASSES.subjectIdentifierFrame())[0]; + var psiFields = psiFrame.select("input"); + for(i = 0; psiFields && i !== psiFields.length; ++i){ + var psiValue = psiFields[i].value; + if(psiValue.strip().length !== 0){ + parentTopic = psiValue.strip().toJSON(); + break; + } + } + } + + var topics = "null"; + if (type === "Topic"){ + var psiFrame = objectToDelete.getFrame().select("tr." + CLASSES.subjectIdentifierFrame())[0]; + var psiFields = psiFrame.select("input"); + for(i = 0; psiFields && i !== psiFields.length; ++i){ + var psiValue = psiFields[i].value; + if(psiValue.strip().length !== 0){ + topics = new Array(psiValue.strip()).toJSON(); + break; + } + } + } + + var deletedObjects = null; + if(type === "Topic"){ deletedObjects = topics; } + else { deletedObjects = "[" + objectToDelete.toJSON() + "]"; } + + var jsonData = "{\"type\":\"" + type + "\"," + + "\"topics\":" + topics + "," + + "\"associations\":" + "null" + "," + + "\"parentTopic\":" + parentTopic + "," + + "\"parentName\":" + "null" + "," + + "\"names\":" + (type === "Name" ? deletedObjects : "null") + "," + + "\"variants\":" + "null" + "," + + "\"occurrences\":" + (type === "Occurrence" ? deletedObjects : "null") + "," + + "\"parentAssociation\":" + "null" + "," + + "\"roles\":" + "null" + "}"; + + commitDeletedObject(jsonData, function(xhr){ + alert("Objected deleted"); + if(type === "Topic"){ + $(CLASSES.subPage()).update(); + makeHome(); + } + else if (type === "Occurrence" || type === "Name"){ + if(objectToDelete.__owner__.__frames__.length > objectToDelete.__max__ + && objectToDelete.__owner__.__frames__.length > 1){ + objectToDelete.remove(); + } + else { + if(type === "Occurrence"){ objectToDelete.__value__.setValue(""); } + else { objectToDelete.__value__.__frames__[0].__content__.setValue(""); } + } + } + }); } \ No newline at end of file

1 0

[isidorus-cvs] r280 - in trunk/src: . json
by Lukas Giessmann 15 Apr '10

15 Apr '10

Author: lgiessmann Date: Thu Apr 15 17:08:47 2010 New Revision: 280 Log: json: fixed a function-reference error Modified: trunk/src/isidorus.asd trunk/src/json/json_exporter.lisp Modified: trunk/src/isidorus.asd ============================================================================== --- trunk/src/isidorus.asd (original) +++ trunk/src/isidorus.asd Thu Apr 15 17:08:47 2010 @@ -156,7 +156,8 @@ "json" "threading")) (:module "json" - :components ((:file "json_exporter") + :components ((:file "json_exporter" + :depends-on ("json_tmcl_constants")) (:file "json_importer") (:file "json_tmcl_validation" :depends-on ("json_tmcl_constants" "json_exporter" )) Modified: trunk/src/json/json_exporter.lisp ============================================================================== --- trunk/src/json/json_exporter.lisp (original) +++ trunk/src/json/json_exporter.lisp Thu Apr 15 17:08:47 2010 @@ -298,7 +298,7 @@ (remove-if #'null (map 'list #'(lambda(psi-list) (when psi-list (map 'list #'uri psi-list))) - (json-tmcl::clean-topics + (clean-topics (elephant:get-instances-by-class 'TopicC))))))

1 0

[isidorus-cvs] r279 - in trunk: docs src/ajax/css src/ajax/javascripts src/json src/rest_interface
by Lukas Giessmann 15 Apr '10

15 Apr '10

Author: lgiessmann Date: Thu Apr 15 13:52:44 2010 New Revision: 279 Log: docs: fixed some bad ebnf definitions of the json interface; json: currently only active topics are exported, mark-as-deleted topics are not exported; ajax: added the possibility that the ui is able to mark topics, names and occurrences as deleted ---> at the moment there is a problem when recreating occurrences and names that have already existed Modified: trunk/docs/json.ebnf trunk/docs/xtm_json.txt trunk/src/ajax/css/frame.css trunk/src/ajax/javascripts/constants.js trunk/src/ajax/javascripts/datamodel.js trunk/src/ajax/javascripts/requests.js trunk/src/json/json_exporter.lisp trunk/src/json/json_importer.lisp trunk/src/json/json_tmcl.lisp trunk/src/json/json_tmcl_validation.lisp trunk/src/rest_interface/set-up-json-interface.lisp Modified: trunk/docs/json.ebnf ============================================================================== --- trunk/docs/json.ebnf (original) +++ trunk/docs/json.ebnf Thu Apr 15 13:52:44 2010 @@ -194,12 +194,12 @@ DeleteType = "\"type\":" ("Topic" | "Occurrence" | "Name" | "Association" | "Role" | "Variant") DeleteTopics = "\"topics\":" List DeleteAssociations = "\"associations\":" Associations -DeleteParentTopic = "\"parent-topic\":" String -DeleteParentName = "\"parent-name\":" Name +DeleteParentTopic = "\"parentTopic\":" String +DeleteParentName = "\"parentName\":" Name DeleteNames = "\"names\":" Names DeleteVariants = "\"variants\":" Variants DeleteOccurrences = "\"occurrences\":" Occurrences -DeleteParentAssociation = "\"parent-association\":" Association +DeleteParentAssociation = "\"parentAssociation\":" Association DeleteRoles = "\"roles\":" Roles DeleteObject = "{" DeleteType "," DeleteTopics "," DeleteAssociations "," Modified: trunk/docs/xtm_json.txt ============================================================================== --- trunk/docs/xtm_json.txt (original) +++ trunk/docs/xtm_json.txt Thu Apr 15 13:52:44 2010 @@ -467,11 +467,11 @@ "type":<"Topic" | "Occurrence" | "Name" | "Association" | "Role" | "Variant" >, "topics": [<psi-top-1>, <psi-top-2>, <...>], "associations": [<association-1>, <association-2>, <...>], - "parent-topic": "topic-psi", - "parent-name": <name>, + "parentTopic": "topic-psi", + "parentName": <name>, "names": [<name-1>, <name-2>, <...>], "variants": [<variant-1>, <variant-2>, <...>], "occurrences": [<occurrence-1>, <occurrence-2>, <...>], - "parent-association": <association>, + "parentAssociation": <association>, "roles": [<role-1>, <role-2>, <...>] } Modified: trunk/src/ajax/css/frame.css ============================================================================== --- trunk/src/ajax/css/frame.css (original) +++ trunk/src/ajax/css/frame.css Thu Apr 15 13:52:44 2010 @@ -27,6 +27,18 @@ background-color: #eaeaee; } +tr.removeNameRow { + background-color: #eaeaee; +} + +tr.removeOccurrenceRow { + background-color: #eaeaee; +} + +tr.removeTopicRow { + background-color: #eaeaee; +} + li.errorMessage { margin-top: 1em; font-size: 1.2em; @@ -139,6 +151,17 @@ margin-top: 1px; } +span.removeLink { + cursor: pointer; + font-size: 0.75em; + float: right; + margin-right: 1em; +} + +span.removeLink:hover { + color:#ff7f00; +} + /* === topic frame ========================================================== */ table.topicFrame { Modified: trunk/src/ajax/javascripts/constants.js ============================================================================== --- trunk/src/ajax/javascripts/constants.js (original) +++ trunk/src/ajax/javascripts/constants.js Thu Apr 15 13:52:44 2010 @@ -22,6 +22,7 @@ var INSTANCE_PSIS_URL = HOST_PREF + "json/tmcl/instances/"; var OWN_URL = HOST_PREF + "isidorus"; var SUMMARY_URL = HOST_PREF + "json/summary" + var MARK_AS_DELETED_URL = HOST_PREF + "mark-as-deleted"; var TM_OVERVIEW = "/json/tmcl/overview/"; var TIMEOUT = 10000; // const TIMEOUT = 10000 --> "const" doesn't work under IE @@ -89,5 +90,9 @@ "treeView" : function(){ return "treeView"; }, "instances" : function(){ return "instances"; }, "subtypes" : function(){ return "subtypes"; }, - "topicPsis" : function(){ return "topicPsis"; } + "topicPsis" : function(){ return "topicPsis"; }, + "removeLink" : function(){ return "removeLink"; }, + "removeNameRow" : function(){ return "removeOccurrenceRow"; }, + "removeOccurrenceRow" : function(){ return "removeNameRow"; }, + "removeTopicRow" : function(){ return "removeTopicRow"; } }; \ No newline at end of file Modified: trunk/src/ajax/javascripts/datamodel.js ============================================================================== --- trunk/src/ajax/javascripts/datamodel.js (original) +++ trunk/src/ajax/javascripts/datamodel.js Thu Apr 15 13:52:44 2010 @@ -1447,6 +1447,11 @@ dblClickHandler(owner, event); }); } + + var myself = this; + this.__table__.insert({"bottom" : makeRemoveLink(function(event){ + makeDeleteObject("Name", myself); + }, "delete Name")}); } catch(err){ alert("From NameC(): " + err); @@ -1491,6 +1496,7 @@ this.getFrame().select("tr." + CLASSES.scopeContainer())[0].hide(); this.getFrame().select("tr." + CLASSES.valueFrame())[0].hide(); this.getFrame().select("tr." + CLASSES.variantContainer())[0].hide(); + this.getFrame().select("tr." + CLASSES.removeNameRow())[0].hide(); this.__isMinimized__ = true; } else { @@ -1500,6 +1506,7 @@ this.getFrame().select("tr." + CLASSES.scopeContainer())[0].show(); this.getFrame().select("tr." + CLASSES.valueFrame())[0].show(); this.getFrame().select("tr." + CLASSES.variantContainer())[0].show(); + this.getFrame().select("tr." + CLASSES.removeNameRow())[0].show(); this.__isMinimized__ = false; } }, @@ -1512,6 +1519,7 @@ this.__variants__.disable(); this.getFrame().writeAttribute({"class" : CLASSES.disabled()}); this.getFrame().writeAttribute({"title" : this.__cssTitle__}); + this.getFrame().select("tr." + CLASSES.removeNameRow())[0].disable(); this.hideAddButton(); this.__disabled__ = true; }, @@ -1523,6 +1531,7 @@ this.__variants__.enable(); this.getFrame().writeAttribute({"class" : CLASSES.nameFrame()}); this.getFrame().removeAttribute("title"); + this.getFrame().select("tr." + CLASSES.removeNameRow())[0].enable(); checkRemoveAddButtons(this.__owner__, 1, this.__max__, this); this.__disabled__ = false; }}); @@ -1742,6 +1751,92 @@ }}); +function makeRemoveLink (removeHandler, textContent){ + var link = new Element("span", {"class" : CLASSES.removeLink()}).update(textContent); + var trClass = null; + switch(textContent){ + case "delete Occurrence" : trClass = CLASSES.removeOccurrenceRow(); break; + case "delete Topic" : trClass = CLASSES.removeTopicRow(); break; + case "delete Name" : trClass = CLASSES.removeNameRow(); break; + } + + var tr = new Element("tr", {"class" : trClass}).insert(new Element("td", {"colspan" : 3}).insert(link)); + if(removeHandler){ link.observe("click", removeHandler); } + return tr; +} + + +function makeDeleteObject(type, objectToDelete){ + if(type !== "Occurrence" && type !== "Name" && type !== "Variant" + && type !== "Topic" && type !== "Association"){ + throw "From makeDeleteObject(): type must be: \"Occurrence\" || \"Name\" " + + "|| \"Variant\" || \"Topic\" || \"Association\" but is " + type; + } + if (!objectToDelete){ + throw "From makeDeleteObject(): objectToDelete must be set"; + } + + var parentTopic = "null"; + if(type === "Occurrence" || type === "Name"){ + var psiFrame = objectToDelete.getFrame().parentNode.parentNode.parentNode.parentNode.select("tr." + CLASSES.subjectIdentifierFrame())[0]; + var psiFields = psiFrame.select("input"); + for(i = 0; psiFields && i !== psiFields.length; ++i){ + var psiValue = psiFields[i].value; + if(psiValue.strip().length !== 0){ + parentTopic = psiValue.strip().toJSON(); + break; + } + } + } + + var topics = "null"; + if (type === "Topic"){ + var psiFrame = objectToDelete.getFrame().select("tr." + CLASSES.subjectIdentifierFrame())[0]; + var psiFields = psiFrame.select("input"); + for(i = 0; psiFields && i !== psiFields.length; ++i){ + var psiValue = psiFields[i].value; + if(psiValue.strip().length !== 0){ + topics = new Array(psiValue.strip()).toJSON(); + break; + } + } + } + + var deletedObjects = null; + if(type === "Topic"){ deletedObjects = topics; } + else { deletedObjects = "[" + objectToDelete.toJSON() + "]"; } + + var jsonData = "{\"type\":\"" + type + "\"," + + "\"topics\":" + topics + "," + + "\"associations\":" + "null" + "," + + "\"parentTopic\":" + parentTopic + "," + + "\"parentName\":" + "null" + "," + + "\"names\":" + (type === "Name" ? deletedObjects : "null") + "," + + "\"variants\":" + "null" + "," + + "\"occurrences\":" + (type === "Occurrence" ? deletedObjects : "null") + "," + + "\"parentAssociation\":" + "null" + "," + + "\"roles\":" + "null" + "}"; + + commitDeletedObject(jsonData, function(xhr){ + alert("Objected deleted"); + if(type === "Topic"){ + $(CLASSES.subPage()).update(); + makeHome(); + } + else if (type === "Occurrence" || type === "Name"){ + if(objectToDelete.__owner__.__frames__.length > objectToDelete.__max__ + && objectToDelete.__owner__.__frames__.length > 1){ + objectToDelete.remove(); + } + else { + if(type === "Occurrence"){ objectToDelete.__value__.setValue(""); } + else { objectToDelete.__value__.__frames__[0].__content__.setValue(""); } + } + } + }); + +} + // --- represenation of an occurrence element var OccurrenceC = Class.create(ContainerC, {"initialize" : function($super, contents, occurrenceTypes, constraint, uniqueConstraints, owner, min, max, cssTitle, dblClickHandler){ $super(); @@ -1826,6 +1921,10 @@ dblClickHandler(owner, event); }); } + var myself = this; + this.__table__.insert({"bottom" : makeRemoveLink(function(event){ + makeDeleteObject("Occurrence", myself); + }, "delete Occurrence")}); } catch(err){ alert("From OccurrenceC(): " + err); @@ -1894,6 +1993,7 @@ this.getFrame().select("tr." + CLASSES.scopeContainer())[0].hide(); this.getFrame().select("tr." + CLASSES.valueFrame())[0].hide(); this.getFrame().select("tr." + CLASSES.datatypeFrame())[0].hide(); + this.getFrame().select("tr." + CLASSES.removeOccurrenceRow())[0].hide(); this.__isMinimized__ = true; } else { @@ -1903,6 +2003,9 @@ this.getFrame().select("tr." + CLASSES.scopeContainer())[0].show(); this.getFrame().select("tr." + CLASSES.valueFrame())[0].show(); this.getFrame().select("tr." + CLASSES.datatypeFrame())[0].show(); + if(this.__disabled__ === false){ + this.getFrame().select("tr." + CLASSES.removeOccurrenceRow())[0].show(); + } this.__isMinimized__ = false; } }, @@ -1916,6 +2019,7 @@ this.getFrame().writeAttribute({"class" : CLASSES.disabled()}); this.getFrame().writeAttribute({"title" : this.__cssTitle__}); this.hideAddButton(); + this.getFrame().select("tr." + CLASSES.removeOccurrenceRow())[0].hide(); this.__disabled__ = true; }, "enable" : function(){ @@ -1928,6 +2032,7 @@ this.getFrame().removeAttribute("style"); this.getFrame().removeAttribute("title"); checkRemoveAddButtons(this.__owner__, 1, this.__max__, this); + this.getFrame().select("tr." + CLASSES.removeOccurrenceRow())[0].show(); this.__disabled__ = false; }}); @@ -2222,6 +2327,11 @@ _constraints = (constraints ? constraints.topicOccurrenceConstraints : null); this.__occurrence__ = new OccurrenceContainerC(occurrencesContent, _constraints); this.__table__.insert({"bottom" : newRow(CLASSES.occurrenceContainer(), "Occurrences", this.__occurrence__.getFrame())}); + + var myself = this; + this.__table__.insert({"bottom" : makeRemoveLink(function(event){ + makeDeleteObject("Topic", myself); + }, "delete Topic")}); }catch(err){ alert("From TopciC(): " + err); } @@ -2261,7 +2371,8 @@ this.getFrame().select("tr." + CLASSES.subjectLocatorFrame())[0], this.getFrame().select("tr." + CLASSES.subjectIdentifierFrame())[0], this.getFrame().select("tr." + CLASSES.nameContainer())[0], - this.getFrame().select("tr." + CLASSES.occurrenceContainer())[0]); + this.getFrame().select("tr." + CLASSES.occurrenceContainer())[0], + this.getFrame().select("tr." + CLASSES.removeTopicRow())[0]); for(var i = 0; i != rows.length; ++i){ if(this.__minimized__ === false) rows[i].hide(); else rows[i].show(); Modified: trunk/src/ajax/javascripts/requests.js ============================================================================== --- trunk/src/ajax/javascripts/requests.js (original) +++ trunk/src/ajax/javascripts/requests.js Thu Apr 15 13:52:44 2010 @@ -219,6 +219,27 @@ } +// --- Sends a POST-Message to the server. The sent message enables the server +// --- to find the spcified object and mark it as deleted +function commitDeletedObject(json, onSuccessHandler, onFailureHandler) +{ + if(!json || !onSuccessHandler) throw "From commitDeletedObject(): json and onSuccessHandler must be set!"; + try{ + var onFailure = onFailureHandler ? onFailureHandler : defaultFailureHandler; + var timeFun = setAjaxTimeout(TIMEOUT, COMMIT_URL); + + new Ajax.Request(MARK_AS_DELETED_URL, { + "method" : "post", + "postBody" : json, + "onSuccess" : createXHRHandler(onSuccessHandler, timeFun), + "onFailure" : createXHRHandler(onFailure, timeFun)}); + } + catch(err){ + alert("From commitDeletedObject(): " + err); + } +} + + // --- Requests a JSON-Fragment for the passed psi and calls the onSuccessHandler function // --- after a succeeded request. function requestFragment(psi, onSuccessHandler, onFailureHandler) Modified: trunk/src/json/json_exporter.lisp ============================================================================== --- trunk/src/json/json_exporter.lisp (original) +++ trunk/src/json/json_exporter.lisp Thu Apr 15 13:52:44 2010 @@ -8,7 +8,7 @@ (defpackage :json-exporter - (:use :cl :json :datamodel) + (:use :cl :json :datamodel :json-tmcl-constants) (:export :to-json-string :get-all-topic-psis :to-json-string-summary @@ -298,7 +298,8 @@ (remove-if #'null (map 'list #'(lambda(psi-list) (when psi-list (map 'list #'uri psi-list))) - (map 'list #'psis (elephant:get-instances-by-class 'TopicC)))))) + (json-tmcl::clean-topics + (elephant:get-instances-by-class 'TopicC)))))) (defun to-json-string-summary (topic) @@ -350,4 +351,14 @@ do (setf inner-string (concatenate 'string inner-string (to-json-string-summary topic) ",")))) (subseq inner-string 0 (- (length inner-string) 1))))) (concatenate 'string "[" json-string "]")) - "null")) \ No newline at end of file + "null")) + + +(defun clean-topics(isas-or-akos) + (remove-if + #'null + (map 'list + #'(lambda(top) + (when (d:find-item-by-revision top 0) + top)) + isas-or-akos))) \ No newline at end of file Modified: trunk/src/json/json_importer.lisp ============================================================================== --- trunk/src/json/json_importer.lisp (original) +++ trunk/src/json/json_importer.lisp Thu Apr 15 13:52:44 2010 @@ -362,7 +362,7 @@ (setf tm-ids (cdr j-elem))) (t (error "json-importer:get-fragment-values-from-json-string: - bad item-specifier found in json-list")))) + bad item-specifier found in json-list (~a)" (car j-elem))))) (unless topic (error "json-importer:get-fragment-values-from-json-string: the element topic must be set")) (unless (= (length tm-ids) 1) Modified: trunk/src/json/json_tmcl.lisp ============================================================================== --- trunk/src/json/json_tmcl.lisp (original) +++ trunk/src/json/json_tmcl.lisp Thu Apr 15 13:52:44 2010 @@ -179,7 +179,7 @@ (defun delete-names-from-json (names parent-psi revision) (declare (list names) (string parent-psi) (integer revision)) (let ((parent-topic (d:get-item-by-psi parent-psi)) - (err "From delete-name-from-json(): ")) + (err "From delete-names-from-json(): ")) (unless parent-topic (error "~a~a not found" err parent-psi)) @@ -235,7 +235,7 @@ (defun delete-occurrences-from-json(occurrences parent-psi revision) (declare (list occurrences) (string parent-psi) (integer revision)) (let ((parent-topic (d:get-item-by-psi parent-psi)) - (err "From delete-occurrence-from-json(): ")) + (err "From delete-occurrences-from-json(): ")) (unless parent-topic (error "~a~a not found" err parent-psi)) (dolist (j-occ occurrences) @@ -284,7 +284,7 @@ (declare (list associations) (integer revision)) (dolist (j-assoc associations) (let ((plist (json-importer::get-association-values-from-json-list j-assoc)) - (err "From delete-association-from-json(): ")) + (err "From delete-associations-from-json(): ")) (let ((assoc (find-association-from-json plist))) (unless assoc (error "~a ~a not found" err plist)) @@ -297,7 +297,7 @@ (dolist (uri topics) (let ((psi (elephant:get-instance-by-value 'd:PersistentIdC 'd:uri uri))) (unless psi - (error "From delete-topic-from-json(): PSI ~a not found" uri)) + (error "From delete-topics-from-json(): PSI ~a not found" uri)) (pushnew psi psis))) (let ((tops (remove-duplicates @@ -1573,33 +1573,9 @@ t)) (get-direct-subtypes-of-topic topic-instance))))))) (let ((cleaned-isas ;;all constraint topics are removed - (remove-if #'null (map 'list #'(lambda(top-entry) - (when (find-if #'(lambda(psi) - (unless (or (string= (uri psi) *constraint-psi*) - (string= (uri psi) *occurrencetype-psi*) - (string= (uri psi) *nametype-psi*) - (string= (uri psi) *associationtype-psi*) - (string= (uri psi) *roletype-psi*) - (string= (uri psi) *scopetype-psi*) - (string= (uri psi) *schema-psi*)) - top-entry)) - (psis (getf top-entry :topic))) - top-entry)) - isas-of-this))) + (clean-topic-entries isas-of-this)) (cleaned-akos ;;all constraint topics are removed - (remove-if #'null (map 'list #'(lambda(top-entry) - (when (find-if #'(lambda(psi) - (unless (or (string= (uri psi) *constraint-psi*) - (string= (uri psi) *occurrencetype-psi*) - (string= (uri psi) *nametype-psi*) - (string= (uri psi) *associationtype-psi*) - (string= (uri psi) *roletype-psi*) - (string= (uri psi) *scopetype-psi*) - (string= (uri psi) *schema-psi*)) - top-entry)) - (psis (getf top-entry :topic))) - top-entry)) - akos-of-this)))) + (clean-topic-entries akos-of-this))) (list :topic topic-instance :is-type is-type :is-instance is-instance @@ -1610,12 +1586,37 @@ (make-nodes (getf x :topic) (getf x :is-type) (getf x :is-instance))) cleaned-akos)))))) +(defun clean-topic-entries(isas-or-akos) + (remove-if + #'null + (map 'list + #'(lambda(top-entry) + (when (and (d:find-item-by-revision (getf top-entry :topic) 0) + (find-if + #'(lambda(psi) + (unless (or (string= (uri psi) *constraint-psi*) + (string= (uri psi) *occurrencetype-psi*) + (string= (uri psi) *nametype-psi*) + (string= (uri psi) *associationtype-psi*) + (string= (uri psi) *roletype-psi*) + (string= (uri psi) *scopetype-psi*) + (string= (uri psi) *schema-psi*)) + top-entry)) + (psis (getf top-entry :topic)))) + top-entry)) + isas-or-akos))) + (defun get-all-tree-roots () "Returns all topics that are no instanceOf and no subtype of any other topic." (let ((all-topics - (elephant:get-instances-by-class 'd:TopicC))) + (remove-if #'null + (map 'list + #'(lambda(top) + (when (d:find-item-by-revision top 0) + top)) + (elephant:get-instances-by-class 'd:TopicC))))) (remove-if #'null (map 'list #'(lambda(x) (let ((isas-of-x Modified: trunk/src/json/json_tmcl_validation.lisp ============================================================================== --- trunk/src/json/json_tmcl_validation.lisp (original) +++ trunk/src/json/json_tmcl_validation.lisp Thu Apr 15 13:52:44 2010 @@ -375,7 +375,8 @@ (defun return-all-tmcl-types () "Returns all topics that are valid tmcl-types" (let ((all-topics - (elephant:get-instances-by-class 'd:TopicC)) + (json-exporter::clean-topics + (elephant:get-instances-by-class 'd:TopicC))) (topictype (get-item-by-psi json-tmcl-constants::*topictype-psi*)) (topictype-constraint (is-type-constrained))) (let ((all-types @@ -399,7 +400,8 @@ The validity is only oriented on the typing of topics, e.g. type-instance or supertype-subtype." (let ((all-topics - (elephant:get-instances-by-class 'd:TopicC))) + (json-exporter::clean-topics + (elephant:get-instances-by-class 'd:TopicC)))) (let ((valid-instances (remove-if #'null (map 'list #'(lambda(x) Modified: trunk/src/rest_interface/set-up-json-interface.lisp ============================================================================== --- trunk/src/rest_interface/set-up-json-interface.lisp (original) +++ trunk/src/rest_interface/set-up-json-interface.lisp Thu Apr 15 13:52:44 2010 @@ -115,7 +115,7 @@ (create-regex-dispatcher json-get-summary-url #'return-topic-summaries) hunchentoot:*dispatch-table*) (push - (create-regex-dispatcher mark-as-deleted-url #'mark-as-deleted) + (create-regex-dispatcher mark-as-deleted-url #'mark-as-deleted-handler) hunchentoot:*dispatch-table*)) ;; ============================================================================= @@ -302,7 +302,12 @@ (condition () nil)))) (handler-case (with-reader-lock (let ((topics - (elephant:get-instances-by-class 'd:TopicC))) + (remove-if + #'null + (map 'list #'(lambda(top) + (when (d:find-item-by-revision top 0) + top)) + (elephant:get-instances-by-class 'd:TopicC))))) (let ((end (cond ((not end-idx) @@ -372,6 +377,7 @@ (format nil "Condition: \"~a\"" err)))))) (setf (hunchentoot:return-code*) hunchentoot:+http-bad-request+)))) + ;; ============================================================================= ;; --- some helper functions --------------------------------------------------- ;; =============================================================================

1 0

[isidorus-cvs] r278 - trunk/docs
by Lukas Giessmann 14 Apr '10

14 Apr '10

Author: lgiessmann Date: Wed Apr 14 10:52:52 2010 New Revision: 278 Log: docs: added documentation to the RESTful-interface --> mark-as-deleted-handler Modified: trunk/docs/json.ebnf trunk/docs/xtm_json.txt Modified: trunk/docs/json.ebnf ============================================================================== --- trunk/docs/json.ebnf (original) +++ trunk/docs/json.ebnf Wed Apr 14 10:52:52 2010 @@ -4,7 +4,7 @@ //+ *Part 2: XTM - data model //+ *Part 3: Object summaries //+ *Part 4: TMCL - data model -//+ *Part 5: Server-side RESTful interface +//+ *Part 5: Object notation for marking objects as deleted //+----------------------------------------------------------------------------- //+----------------------------------------------------------------------------- @@ -173,16 +173,36 @@ // Contains the entire TMCL information FragmentConstraint ="{" TopicConstraints "," AssociationsConstraints "}" + + //+----------------------------------------------------------------------------- -//+ Part 5: Server-side RESTful interface -//+----------------------------------------------------------------------------- -"/json/get/(.+)$" returns a Fragment after a HTTP-GET -"/json/commit/?$" processes a Fragment as HTTP-POST or HTTP-PUT -"/json/psis/?$" returns a PsiSummary after a HTTP-GET -"/json/summary/?$" returns a TopicSummaries after A HTTP-GET -"/json/tmcl/types/?$" returns a PsiSummary after A HTTP-GET with all types -"/json/tmcl/instances/?$" returns a PsiSummary after a HTTP-GET with all instances -"/json/topicstubs/(.+)$" returns a topicStub after a HTTP-GET -"/json/tmcl/type/?$" returns a FragmentConstraint after a HTTP-POST/HTTP-PUT -"/json/tmcl/instance/?$" returns a FragmentConstraint after a HTTP-POST/HTTP-PUT -"/json/tmcl/overview/?$" returns a TreeView after a HTTP-GET \ No newline at end of file +//+ Part 5: Object notation for marking objects as deleted +//+ type: the type of the deleted object, e.g. Topic for TopicC +//+ topics: a list of PSIs, where every single PSI represents a topic that +//+ has to be deleted +//+ associations: a list of associations that have to be deleted +//+ parent-topic: a single PSI of the name's, occurrence's or variant's owner +//+ topic +//+ parent-name: the parent name of the variants that have to be deleted +//+ (in this case the parent-topic is the topic of the name) +//+ names: a list of the deletable names +//+ variants: a list of deletable names +//+ occurrences: a list of the deletable occurrences +//+ parent-association: the parent association of the deletable roles +//+ roles: a list of the deltable roles +//+----------------------------------------------------------------------------- +DeleteType = "\"type\":" ("Topic" | "Occurrence" | "Name" | "Association" | "Role" | "Variant") +DeleteTopics = "\"topics\":" List +DeleteAssociations = "\"associations\":" Associations +DeleteParentTopic = "\"parent-topic\":" String +DeleteParentName = "\"parent-name\":" Name +DeleteNames = "\"names\":" Names +DeleteVariants = "\"variants\":" Variants +DeleteOccurrences = "\"occurrences\":" Occurrences +DeleteParentAssociation = "\"parent-association\":" Association +DeleteRoles = "\"roles\":" Roles + +DeleteObject = "{" DeleteType "," DeleteTopics "," DeleteAssociations "," + DeleteParentTopic "," DeleteParentName "," DeleteNames "," + DeleteVariants "," DeleteOccurrences "," DeleteParentAssociation + "," DeleteRoles "}" \ No newline at end of file Modified: trunk/docs/xtm_json.txt ============================================================================== --- trunk/docs/xtm_json.txt (original) +++ trunk/docs/xtm_json.txt Wed Apr 14 10:52:52 2010 @@ -3,6 +3,7 @@ //+ *Part 1: XTM - data model //+ *Part 2: Object summaries //+ *Part 3: TMCL - data model +//+ *Part 4: Object notation for marking objects as deleted //+----------------------------------------------------------------------------- @@ -443,3 +444,34 @@ "topicConstraints" : <topicConstraint>, "associationsConstraints" : [ <associationConstraints>, <...> ] } + + + +//+----------------------------------------------------------------------------- +//+ *Part 4: Object notation for marking objects as deleted +//+ type: the type of the deleted object, e.g. Topic for TopicC +//+ topics: a list of PSIs, where every single PSI represents a topic that +//+ has to be deleted +//+ associations: a list of associations that have to be deleted +//+ parent-topic: a single PSI of the name's, occurrence's or variant's owner +//+ topic +//+ parent-name: the parent name of the variants that have to be deleted +//+ (in this case the parent-topic is the topic of the name) +//+ names: a list of the deletable names +//+ variants: a list of deletable names +//+ occurrences: a list of the deletable occurrences +//+ parent-association: the parent association of the deletable roles +//+ roles: a list of the deltable roles +//+----------------------------------------------------------------------------- +{ + "type":<"Topic" | "Occurrence" | "Name" | "Association" | "Role" | "Variant" >, + "topics": [<psi-top-1>, <psi-top-2>, <...>], + "associations": [<association-1>, <association-2>, <...>], + "parent-topic": "topic-psi", + "parent-name": <name>, + "names": [<name-1>, <name-2>, <...>], + "variants": [<variant-1>, <variant-2>, <...>], + "occurrences": [<occurrence-1>, <occurrence-2>, <...>], + "parent-association": <association>, + "roles": [<role-1>, <role-2>, <...>] +}

1 0

[isidorus-cvs] r277 - trunk/src/json
by Lukas Giessmann 14 Apr '10

14 Apr '10

Author: lgiessmann Date: Wed Apr 14 10:51:13 2010 New Revision: 277 Log: rest-interface: finalized and tested the mark-as-deleted-handler of the RESTful interface; json: added some helpers for the rest-interface-mark-as-deleted-handler; added the corresponding docu into json.ebnf and xtm_json.txt Modified: trunk/src/json/json_tmcl.lisp Modified: trunk/src/json/json_tmcl.lisp ============================================================================== --- trunk/src/json/json_tmcl.lisp (original) +++ trunk/src/json/json_tmcl.lisp Wed Apr 14 10:51:13 2010 @@ -13,78 +13,9 @@ ;; ============================================================================= ;; --- mark-as-deleted handler ------------------------------------------------- ;; ============================================================================= -; a test string ... -(defvar cl-user::*js-1* - "{\"type\":\"Association\", - \"topics\":[\"http://textgrid.org/isidorus/tmcl/service\", - \"http://textgrid.org/isidorus/tmcl/parameter\"], - \"associations\":[{\"itemIdentities\":null, - \"type\":[\"http://psi.topicmaps.org/tmcl/applies-to\"], - \"scopes\":null, - \"roles\":[{\"itemIdentities\":null, - \"type\":[\"http://psi.topicmaps.org/tmcl/constraint-role\"], - \"topicRef\":[\"http://textgrid.org/isidorus/tmcl/exc\"]}, - {\"itemIdentities\":null, - \"type\":[\"http://psi.topicmaps.org/tmcl/topic-type-role\"], - \"topicRef\":[\"http://textgrid.org/isidorus/tmcl/service\"]}]}], - \"parent-topic\":[\"http://textgrid.org/isidorus/my-service/my-service\"], - \"parent-name\":{\"itemIdentities\":null, - \"type\":[\"http://textgrid.org/isidorus/tmcl/service-name\"], - \"scopes\":null, - \"value\":\"my-service\", - \"variants\":null}, - \"names\":[{\"itemIdentities\":null, - \"type\":[\"http://textgrid.org/isidorus/tmcl/service-name\"], - \"scopes\":null, - \"value\":\"my-service\", - \"variants\":null}], - \"variants\":[{\"itemIdentities\":null, - \"scopes\":[[\"http://textgrid.org/isidorus/tmcl/display\"]], - \"resourceData\":{\"datatype\":\"http://www.w3.org/2001/XMLSchema#string\", - \"value\":\"http://textgrid.org/isidorus/tmcl/service\"}, - \"resourceRef\":null}, - {\"itemIdentities\":null, - \"scopes\":[[\"http://textgrid.org/isidorus/tmcl/is-ref\"]], - \"resourceData\":null, - \"resourceRef\":\"http://any-ref.org\"}], - \"occurrences\":[{\"itemIdentities\":null, - \"type\":[\"http://textgrid.org/isidorus/tmcl/service-key\"], - \"scopes\":null, - \"resourceData\":{\"datatype\":\"http://www.w3.org/2001/XMLSchema#string\", - \"value\":\"service-key\"}}], - \"parent-association\":{\"itemIdentities\":null, - \"type\":[\"http://psi.topicmaps.org/tmcl/applies-to\"], - \"scopes\":null, - \"roles\":[{\"itemIdentities\":null, - \"type\":[\"http://psi.topicmaps.org/tmcl/constraint-role\"], - \"topicRef\":[\"http://textgrid.org/isidorus/tmcl/exc\"]}, - {\"itemIdentities\":null, - \"type\":[\"http://psi.topicmaps.org/tmcl/topictype-role\"], - \"topicRef\":[\"http://textgrid.org/isidorus/tmcl/service\"]}]}, - \"roles\":[{\"itemIdentities\":null, - \"type\":[\"http://psi.topicmaps.org/tmcl/constraint-role\"], - \"topicRef\":[\"http://textgrid.org/isidorus/tmcl/exc\"]}]}") - - (defun mark-as-deleted-from-json (json-data) + "Marks an object that is specified by the given JSON data as deleted." (declare (string json-data)) - -;{\"type\":<\"Topic\" | \"Occurrence\" | \"Name\" -; \"Association\" | \"Role\" | \"Variant\" >, -; \"topics\": <one psi per topic of the topic that have to be deleted>, -; \"associations\": <a list of associations that should be deleted in the -; specified json format>, -; \"parent-topic\": <one psi of the parent topic the deleted -; objects are contained in or null if the -; deleted object is the topic itself>, -; \"parent-name\": <the owner parent of the deleted variants>, -; \"names\": <a list of names that have to be deleted>, -; \"variants\": <a list of variants that have to be deleted>, -; \"occurrences\": <a list of occurrences that have to be deleted>, -; \"parent-association\": <one association in the specified json -; format, that is the parent of the passed -; role> -; \"roles\": <a list of roles in the specified json format>} (let ((values (json:decode-json-from-string json-data))) (let ((type nil) (topics nil) @@ -116,18 +47,204 @@ ((string= type "Association") (delete-associations-from-json associations rev)) ((string= type "Occurrence") - nil) + (delete-occurrences-from-json occurrences parent-topic rev)) ((string= type "Name") - nil) + (delete-names-from-json names parent-topic rev)) ((string= type "Variant") - nil) + (delete-variants-from-json variants parent-topic parent-name rev)) ((string= type "Role") - nil) + (delete-roles-from-json roles parent-association rev)) (t (error "From mark-as-deleted-from-json(): the type ~a is not defined" type)))))) +(defun find-role-from-json (parent-association json-plist) + (declare (AssociationC parent-association) (list json-plist)) + (let ((found-role + (find-if + #'(lambda(role) + (let ((type (when (getf json-plist :type) + (d:get-item-by-psi (first (getf json-plist :type))))) + (player (when (getf json-plist :topicRef) + (d:get-item-by-psi + (first (getf json-plist :topicRef)))))) + (and (eql type (d:instance-of role)) + (eql player (d:player role))))) + (d:roles parent-association)))) + found-role)) + + +(defun delete-roles-from-json (roles parent-association revision) + (declare (list roles parent-association) (integer revision)) + (let ((err "From delete-roles-from-association(): ") + (parent-assoc + (find-association-from-json + (json-importer::get-association-values-from-json-list + parent-association)))) + (unless parent-assoc + (error "~a~a not found" err parent-association)) + (dolist (j-role roles) + (let ((plist (json-importer::get-role-values-from-json-list j-role))) + (let ((role (find-role-from-json parent-assoc plist))) + (unless role + (error "~a~a not found" err plist)) + (format t "~a~%" role) + (mark-as-deleted role :revision revision)))))) + + +(defun find-variant-from-json (parent-name json-plist) + (declare (NameC parent-name) (list json-plist)) + (let ((err "From find-variant-from-json(): ")) + (let ((found-var + (find-if + #'(lambda(var) + (let ((datatype (cond ((getf json-plist :datatype) + (getf json-plist :datatype)) + ((getf json-plist :resourceRef) + constants:*xml-uri*) + ((getf json-plist :resourceData) + (let ((val + (getf + (getf json-plist :resourceData) + :datatype))) + (if val val constants:*xml-string*))) + (t + constants:*xml-string*))) + (charvalue (cond ((getf json-plist :resourceRef) + (getf json-plist :resourceRef)) + ((getf json-plist :resourceData) + (getf (getf json-plist :resourceData) + :value)) + (t + ""))) + (scopes nil)) + (loop for scope-entry in (getf json-plist :scopes) + do (let ((top (d:get-item-by-psi (first scope-entry)))) + (unless top + (error "~a ~a not found" err (first scope-entry))) + (pushnew top scopes))) + (and (not (set-exclusive-or scopes (d:themes var))) + (string= datatype (d:datatype var)) + (string= charvalue (d:charvalue var))))) + (d:variants parent-name :revision 0)))) + found-var))) + + +(defun delete-variants-from-json (variants parent-psi parent-name revision) + (declare (string parent-psi) (list variants parent-name)) + (let ((err "From delete-variants-from-json(): ") + (parent-topic (d:get-item-by-psi parent-psi))) + (unless parent-topic + (error "~a~a not found" err parent-psi)) + (let ((v-name + (find-name-from-json + parent-topic + (json-importer::get-name-values-from-json-list parent-name)))) + (unless v-name + (error "~a~a not found" err parent-name)) + (dolist (j-variant variants) + (let ((plist + (json-importer::get-variant-values-from-json-list j-variant))) + (let ((variant (find-variant-from-json v-name plist))) + (unless variant + (error "~a~a not found" err plist)) + (mark-as-deleted variant :revision revision))))))) + + +(defun find-name-from-json(parent-topic json-plist) + (declare (TopicC parent-topic) (list json-plist)) + (let ((err "From find-name-from-json(): ")) + (let ((found-name + (find-if + #'(lambda(name) + (let ((type (when (getf json-plist :type) + (d:get-item-by-psi (first (getf json-plist :type))))) + (charvalue (if (getf json-plist :value) + (getf json-plist :value) + "")) + (scopes nil)) + (loop for scope-entry in (getf json-plist :scopes) + do (let ((top (d:get-item-by-psi (first scope-entry)))) + (unless top + (error "~a ~a not found" err (first scope-entry))) + (pushnew top scopes))) + (and (eql type (d:instance-of name)) + (not (set-exclusive-or scopes (d:themes name))) + (string= charvalue (d:charvalue name))))) + (names parent-topic :revision 0)))) + found-name))) + + +(defun delete-names-from-json (names parent-psi revision) + (declare (list names) (string parent-psi) (integer revision)) + (let ((parent-topic (d:get-item-by-psi parent-psi)) + (err "From delete-name-from-json(): ")) + (unless parent-topic + (error "~a~a not found" + err parent-psi)) + (dolist (j-name names) + (let ((plist (json-importer::get-name-values-from-json-list j-name))) + (let ((name (find-name-from-json parent-topic plist))) + (unless name + (error "~a~a not found" err plist)) + (mark-as-deleted name :revision revision)))))) + + +(defun find-occurrence-from-json(parent-topic json-plist) + (declare (TopicC parent-topic) (list json-plist)) + (let ((err "From find-occurrence-from-json(): ")) + (let ((found-occ + (find-if + #'(lambda(occ) + (let ((type (when (getf json-plist :type) + (d:get-item-by-psi (first (getf json-plist :type))))) + (datatype (cond ((getf json-plist :datatype) + (getf json-plist :datatype)) + ((getf json-plist :resourceRef) + constants:*xml-uri*) + ((getf json-plist :resourceData) + (let ((val + (getf + (getf json-plist :resourceData) + :datatype))) + (if val val constants:*xml-string*))) + (t + constants:*xml-string*))) + (charvalue (cond ((getf json-plist :resourceRef) + (getf json-plist :resourceRef)) + ((getf json-plist :resourceData) + (getf (getf json-plist :resourceData) + :value)) + (t + ""))) + (scopes nil)) + (loop for scope-entry in (getf json-plist :scopes) + do (let ((top (d:get-item-by-psi (first scope-entry)))) + (unless top + (error "~a ~a not found" err (first scope-entry))) + (pushnew top scopes))) + (and (eql type (d:instance-of occ)) + (not (set-exclusive-or scopes (d:themes occ))) + (string= datatype (d:datatype occ)) + (string= charvalue (d:charvalue occ))))) + (occurrences parent-topic :revision 0)))) + found-occ))) + + +(defun delete-occurrences-from-json(occurrences parent-psi revision) + (declare (list occurrences) (string parent-psi) (integer revision)) + (let ((parent-topic (d:get-item-by-psi parent-psi)) + (err "From delete-occurrence-from-json(): ")) + (unless parent-topic + (error "~a~a not found" err parent-psi)) + (dolist (j-occ occurrences) + (let ((plist (json-importer::get-occurrence-values-from-json-list j-occ))) + (let ((occ (find-occurrence-from-json parent-topic plist))) + (unless occ + (error "~a~a not found" err plist)) + (mark-as-deleted occ :revision revision)))))) + (defun find-association-from-json (json-plist) (declare (list json-plist)) @@ -140,8 +257,7 @@ (loop for scope-entry in (getf json-plist :scopes) do (let ((top (d:get-item-by-psi (first scope-entry)))) (unless top - (error "~a ~a not found" - err (first scope-entry))) + (error "~a ~a not found" err (first scope-entry))) (pushnew top scopes))) (let ((scope-assocs (loop for assoc in type-assocs

1 0

[isidorus-cvs] r276 - in trunk/src: . json
by Lukas Giessmann 13 Apr '10

13 Apr '10

Author: lgiessmann Date: Tue Apr 13 08:06:00 2010 New Revision: 276 Log: json: added the functionality to deleted topics and associations to the json/RESTful-interface Modified: trunk/src/isidorus.asd trunk/src/json/json_tmcl.lisp Modified: trunk/src/isidorus.asd ============================================================================== --- trunk/src/isidorus.asd (original) +++ trunk/src/isidorus.asd Tue Apr 13 08:06:00 2010 @@ -162,7 +162,7 @@ :depends-on ("json_tmcl_constants" "json_exporter" )) (:file "json_tmcl_constants") (:file "json_tmcl" - :depends-on ("json_tmcl_validation"))) + :depends-on ("json_tmcl_validation" "json_importer"))) :depends-on ("model" "xml")) (:module "ajax" Modified: trunk/src/json/json_tmcl.lisp ============================================================================== --- trunk/src/json/json_tmcl.lisp (original) +++ trunk/src/json/json_tmcl.lisp Tue Apr 13 08:06:00 2010 @@ -15,8 +15,9 @@ ;; ============================================================================= ; a test string ... (defvar cl-user::*js-1* - "{\"type\":\"Topic\", - \"topics\":[\"http://textgrid.org/isidorus/tmcl/service\"], + "{\"type\":\"Association\", + \"topics\":[\"http://textgrid.org/isidorus/tmcl/service\", + \"http://textgrid.org/isidorus/tmcl/parameter\"], \"associations\":[{\"itemIdentities\":null, \"type\":[\"http://psi.topicmaps.org/tmcl/applies-to\"], \"scopes\":null, @@ -24,7 +25,7 @@ \"type\":[\"http://psi.topicmaps.org/tmcl/constraint-role\"], \"topicRef\":[\"http://textgrid.org/isidorus/tmcl/exc\"]}, {\"itemIdentities\":null, - \"type\":[\"http://psi.topicmaps.org/tmcl/topictype-role\"], + \"type\":[\"http://psi.topicmaps.org/tmcl/topic-type-role\"], \"topicRef\":[\"http://textgrid.org/isidorus/tmcl/service\"]}]}], \"parent-topic\":[\"http://textgrid.org/isidorus/my-service/my-service\"], \"parent-name\":{\"itemIdentities\":null, @@ -85,9 +86,109 @@ ; role> ; \"roles\": <a list of roles in the specified json format>} (let ((values (json:decode-json-from-string json-data))) - values - )) + (let ((type nil) + (topics nil) + (associations nil) + (parent-topic nil) + (parent-name nil) + (names nil) + (variants nil) + (occurrences nil) + (parent-association nil) + (roles nil) + (rev (get-revision))) + (loop for entry in values + when (consp entry) + do (let ((st (car entry)) + (nd (cdr entry))) + (cond ((eql st :type) (setf type nd)) + ((eql st :topics) (setf topics nd)) + ((eql st :associations) (setf associations nd)) + ((eql st :parent-topic) (setf parent-topic nd)) + ((eql st :parent-name) (setf parent-name nd)) + ((eql st :names) (setf names nd)) + ((eql st :variants) (setf variants nd)) + ((eql st :occurrences) (setf occurrences nd)) + ((eql st :parent-association) (setf parent-association nd)) + ((eql st :roles) (setf roles nd))))) + (cond ((string= type "Topic") + (delete-topics-from-json topics rev)) + ((string= type "Association") + (delete-associations-from-json associations rev)) + ((string= type "Occurrence") + nil) + ((string= type "Name") + nil) + ((string= type "Variant") + nil) + ((string= type "Role") + nil) + (t + (error "From mark-as-deleted-from-json(): the type ~a is not defined" + type)))))) + + +(defun find-association-from-json (json-plist) + (declare (list json-plist)) + (let ((type-assocs + (elephant:get-instances-by-value + 'd:AssociationC 'd:instance-of + (d:get-item-by-psi (first (getf json-plist :type))))) + (scopes nil) + (err "From find-association-from-json(): ")) + (loop for scope-entry in (getf json-plist :scopes) + do (let ((top (d:get-item-by-psi (first scope-entry)))) + (unless top + (error "~a ~a not found" + err (first scope-entry))) + (pushnew top scopes))) + (let ((scope-assocs + (loop for assoc in type-assocs + when (not (set-exclusive-or scopes (themes assoc))) + collect assoc))) + (loop for assoc in scope-assocs + when (let ((found-roles + (loop for j-role in (getf json-plist :roles) + when (let ((j-player (when (getf j-role :topicRef) + (d:get-item-by-psi (first (getf j-role :topicRef))))) + (j-type (when (getf j-role :type) + (d:get-item-by-psi (first (getf j-role :type)))))) + (find-if #'(lambda(role) + (and (eql (instance-of role) j-type) + (eql (player role) j-player))) + (roles assoc))) + collect j-role))) + (= (length (roles assoc)) (length (getf json-plist :roles)) + (length found-roles))) + return assoc)))) + + +(defun delete-associations-from-json (associations revision) + (declare (list associations) (integer revision)) + (dolist (j-assoc associations) + (let ((plist (json-importer::get-association-values-from-json-list j-assoc)) + (err "From delete-association-from-json(): ")) + (let ((assoc (find-association-from-json plist))) + (unless assoc + (error "~a ~a not found" err plist)) + (mark-as-deleted assoc :revision revision))))) + + +(defun delete-topics-from-json (topics revision) + (declare (list topics) (integer revision)) + (let ((psis nil)) + (dolist (uri topics) + (let ((psi (elephant:get-instance-by-value 'd:PersistentIdC 'd:uri uri))) + (unless psi + (error "From delete-topic-from-json(): PSI ~a not found" uri)) + (pushnew psi psis))) + (let ((tops + (remove-duplicates + (map 'list #'d:identified-construct psis)))) + (dolist (top tops) + (let ((psi (uri (first (psis top))))) + (mark-as-deleted top :source-locator psi :revision revision)))))) ;; =============================================================================

1 0

[isidorus-cvs] r275 - in trunk/src: ajax/javascripts json rest_interface
by Lukas Giessmann 12 Apr '10

12 Apr '10

Author: lgiessmann Date: Mon Apr 12 16:56:36 2010 New Revision: 275 Log: json: started to implement a mark-as-deleted-handler that deleted from a given json-package topics, names, variants, occurrences and roles Modified: trunk/src/ajax/javascripts/constants.js trunk/src/json/json_tmcl.lisp trunk/src/rest_interface/rest-interface.lisp trunk/src/rest_interface/set-up-json-interface.lisp Modified: trunk/src/ajax/javascripts/constants.js ============================================================================== --- trunk/src/ajax/javascripts/constants.js (original) +++ trunk/src/ajax/javascripts/constants.js Mon Apr 12 16:56:36 2010 @@ -11,7 +11,7 @@ // --- Some constants fot the http connections via the XMLHttpRequest-Object -var HOST_PREF = "http://localhost:8000/"; // of the form "http://(.+)/" +var HOST_PREF = /*"http://localhost:8000/";*/ "192.168.178.23:8000/"; // of the form "http://(.+)/" var GET_PREFIX = HOST_PREF + "json/get/"; var GET_STUB_PREFIX = HOST_PREF + "json/topicstubs/"; var TMCL_TYPE_URL = HOST_PREF + "json/tmcl/type/"; Modified: trunk/src/json/json_tmcl.lisp ============================================================================== --- trunk/src/json/json_tmcl.lisp (original) +++ trunk/src/json/json_tmcl.lisp Mon Apr 12 16:56:36 2010 @@ -11,6 +11,86 @@ ;; ============================================================================= +;; --- mark-as-deleted handler ------------------------------------------------- +;; ============================================================================= +; a test string ... +(defvar cl-user::*js-1* + "{\"type\":\"Topic\", + \"topics\":[\"http://textgrid.org/isidorus/tmcl/service\"], + \"associations\":[{\"itemIdentities\":null, + \"type\":[\"http://psi.topicmaps.org/tmcl/applies-to\"], + \"scopes\":null, + \"roles\":[{\"itemIdentities\":null, + \"type\":[\"http://psi.topicmaps.org/tmcl/constraint-role\"], + \"topicRef\":[\"http://textgrid.org/isidorus/tmcl/exc\"]}, + {\"itemIdentities\":null, + \"type\":[\"http://psi.topicmaps.org/tmcl/topictype-role\"], + \"topicRef\":[\"http://textgrid.org/isidorus/tmcl/service\"]}]}], + \"parent-topic\":[\"http://textgrid.org/isidorus/my-service/my-service\"], + \"parent-name\":{\"itemIdentities\":null, + \"type\":[\"http://textgrid.org/isidorus/tmcl/service-name\"], + \"scopes\":null, + \"value\":\"my-service\", + \"variants\":null}, + \"names\":[{\"itemIdentities\":null, + \"type\":[\"http://textgrid.org/isidorus/tmcl/service-name\"], + \"scopes\":null, + \"value\":\"my-service\", + \"variants\":null}], + \"variants\":[{\"itemIdentities\":null, + \"scopes\":[[\"http://textgrid.org/isidorus/tmcl/display\"]], + \"resourceData\":{\"datatype\":\"http://www.w3.org/2001/XMLSchema#string\", + \"value\":\"http://textgrid.org/isidorus/tmcl/service\"}, + \"resourceRef\":null}, + {\"itemIdentities\":null, + \"scopes\":[[\"http://textgrid.org/isidorus/tmcl/is-ref\"]], + \"resourceData\":null, + \"resourceRef\":\"http://any-ref.org\"}], + \"occurrences\":[{\"itemIdentities\":null, + \"type\":[\"http://textgrid.org/isidorus/tmcl/service-key\"], + \"scopes\":null, + \"resourceData\":{\"datatype\":\"http://www.w3.org/2001/XMLSchema#string\", + \"value\":\"service-key\"}}], + \"parent-association\":{\"itemIdentities\":null, + \"type\":[\"http://psi.topicmaps.org/tmcl/applies-to\"], + \"scopes\":null, + \"roles\":[{\"itemIdentities\":null, + \"type\":[\"http://psi.topicmaps.org/tmcl/constraint-role\"], + \"topicRef\":[\"http://textgrid.org/isidorus/tmcl/exc\"]}, + {\"itemIdentities\":null, + \"type\":[\"http://psi.topicmaps.org/tmcl/topictype-role\"], + \"topicRef\":[\"http://textgrid.org/isidorus/tmcl/service\"]}]}, + \"roles\":[{\"itemIdentities\":null, + \"type\":[\"http://psi.topicmaps.org/tmcl/constraint-role\"], + \"topicRef\":[\"http://textgrid.org/isidorus/tmcl/exc\"]}]}") + + +(defun mark-as-deleted-from-json (json-data) + (declare (string json-data)) + +;{\"type\":<\"Topic\" | \"Occurrence\" | \"Name\" +; \"Association\" | \"Role\" | \"Variant\" >, +; \"topics\": <one psi per topic of the topic that have to be deleted>, +; \"associations\": <a list of associations that should be deleted in the +; specified json format>, +; \"parent-topic\": <one psi of the parent topic the deleted +; objects are contained in or null if the +; deleted object is the topic itself>, +; \"parent-name\": <the owner parent of the deleted variants>, +; \"names\": <a list of names that have to be deleted>, +; \"variants\": <a list of variants that have to be deleted>, +; \"occurrences\": <a list of occurrences that have to be deleted>, +; \"parent-association\": <one association in the specified json +; format, that is the parent of the passed +; role> +; \"roles\": <a list of roles in the specified json format>} + (let ((values (json:decode-json-from-string json-data))) + values + )) + + + +;; ============================================================================= ;; --- all fragment constraints ------------------------------------------------ ;; ============================================================================= (defun get-constraints-of-fragment(topic-psis &key (treat-as 'type)) Modified: trunk/src/rest_interface/rest-interface.lisp ============================================================================== --- trunk/src/rest_interface/rest-interface.lisp (original) +++ trunk/src/rest_interface/rest-interface.lisp Mon Apr 12 16:56:36 2010 @@ -40,7 +40,8 @@ :*ajax-user-interface-url* :*ajax-user-interface-file-path* :*ajax-javascript-directory-path* - :*ajax-javascript-url-prefix*)) + :*ajax-javascript-url-prefix* + :*mark-as-deleted-url*)) (in-package :rest-interface) Modified: trunk/src/rest_interface/set-up-json-interface.lisp ============================================================================== --- trunk/src/rest_interface/set-up-json-interface.lisp (original) +++ trunk/src/rest_interface/set-up-json-interface.lisp Mon Apr 12 16:56:36 2010 @@ -26,6 +26,7 @@ (defparameter *ajax-user-interface-file-path* "ajax/isidorus.html") ;the file path to the HTML file implements the user interface (defparameter *ajax-javascript-directory-path* "ajax/javascripts") ;the directory which contains all necessary javascript files (defparameter *ajax-javascript-url-prefix* "/javascripts") ; the url prefix of all javascript files +(defparameter *mark-as-deleted-url* "/mark-as-deleted") ; the url suffix that calls the mark-as-deleted handler (defun set-up-json-interface (&key (json-get-prefix *json-get-prefix*) (get-rdf-prefix *get-rdf-prefix*) @@ -43,7 +44,8 @@ (ajax-user-interface-css-prefix *ajax-user-interface-css-prefix*) (ajax-user-interface-css-directory-path *ajax-user-interface-css-directory-path*) (ajax-javascripts-directory-path *ajax-javascript-directory-path*) - (ajax-javascripts-url-prefix *ajax-javascript-url-prefix*)) + (ajax-javascripts-url-prefix *ajax-javascript-url-prefix*) + (mark-as-deleted-url *mark-as-deleted-url*)) "registers the json im/exporter to the passed base-url in hunchentoot's dispatch-table and also registers a file-hanlder to the html-user-interface" @@ -111,6 +113,9 @@ hunchentoot:*dispatch-table*) (push (create-regex-dispatcher json-get-summary-url #'return-topic-summaries) + hunchentoot:*dispatch-table*) + (push + (create-regex-dispatcher mark-as-deleted-url #'mark-as-deleted) hunchentoot:*dispatch-table*)) ;; ============================================================================= @@ -342,6 +347,31 @@ (format nil "Condition: \"~a\"" err)))))) +(defun mark-as-deleted-handler (&optional param) + "Marks the corresponding elem as deleted. + {\"type\":<\"'TopicC\" | \"'OccurrenceC\" | \"'NameC\" + \"'AssociationC\" | \"'RoleC\" | \"VariantC\" >, + \"object\":<specified json-object: name or occurrence, + if the deleted object is a topic this field + has to be set to null>, + \"parent-topic\":<psis or null>, + \"parent-name\": <specified json-object: name>}." + (declare (ignorable param)) ;param is currently not used + (let ((http-method (hunchentoot:request-method*))) + (if (or (eq http-method :PUT) + (eq http-method :POST)) + (let ((external-format (flexi-streams:make-external-format :UTF-8 :eol-style :LF))) + (let ((json-data (hunchentoot:raw-post-data :external-format external-format :force-text t))) + (handler-case + (with-writer-lock + (json-tmcl::mark-as-deleted-from-json json-data)) + (condition (err) + (progn + (setf (hunchentoot:return-code*) hunchentoot:+http-internal-server-error+) + (setf (hunchentoot:content-type*) "text") + (format nil "Condition: \"~a\"" err)))))) + (setf (hunchentoot:return-code*) hunchentoot:+http-bad-request+)))) + ;; ============================================================================= ;; --- some helper functions --------------------------------------------------- ;; =============================================================================

1 0

[isidorus-cvs] r274 - in branches/new-datamodel/src: model unit_tests
by Lukas Giessmann 12 Apr '10

12 Apr '10

Author: lgiessmann Date: Mon Apr 12 11:06:19 2010 New Revision: 274 Log: new-datamodel: added merging of characteristics when added with "add-<type>" Modified: branches/new-datamodel/src/model/datamodel.lisp branches/new-datamodel/src/unit_tests/datamodel_test.lisp Modified: branches/new-datamodel/src/model/datamodel.lisp ============================================================================== --- branches/new-datamodel/src/model/datamodel.lisp (original) +++ branches/new-datamodel/src/model/datamodel.lisp Mon Apr 12 11:06:19 2010 @@ -157,12 +157,9 @@ -;;TODO: modify 2x add-parent --> use add-characteristic and add-role -;;TODO: call merge-if-equivalent in 2x add-parent ;;TODO: mark-as-deleted should call mark-as-deleted for every owned ??? ;; versioned-construct of the called construct, same for add-xy ??? ;; and associations of player -;;TODO: check for duplicate identifiers after topic-creation/merge ;;TODO: check merge-constructs in add-topic-identifier, ;; add-item-identifier/add-reifier (can merge the parent constructs ;; and the parent's parent construct + the reifier constructs), @@ -842,6 +839,12 @@ ;;; generic definitions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defgeneric find-self-or-equal (construct parent-construct &key revision) + (:documentation "Returns the construct 'construct' if is owned by the + parent-construct or an equal construct or nil if there + is no equal one.")) + + (defgeneric merge-if-equivalent (new-characteristic parent-construct &key revision) (:documentation "Merges the new characteristic/role with one equivalent of the @@ -1692,10 +1695,11 @@ (let ((all-names (map 'list #'characteristic (slot-p construct 'names)))) (if (find name all-names) - (let ((name-assoc (loop for name-assoc in (slot-p construct 'names) - when (eql (parent-construct name-assoc) - construct) - return name-assoc))) + (let ((name-assoc + (loop for name-assoc in (slot-p construct 'names) + when (eql (parent-construct name-assoc) + construct) + return name-assoc))) (add-to-version-history name-assoc :start-revision revision)) (make-construct 'NameAssociationC :parent-construct construct @@ -1752,9 +1756,10 @@ (let ((all-occurrences (map 'list #'characteristic (slot-p construct 'occurrences)))) (if (find occurrence all-occurrences) - (let ((occ-assoc (loop for occ-assoc in (slot-p construct 'occurrences) - when (eql (parent-construct occ-assoc) construct) - return occ-assoc))) + (let ((occ-assoc + (loop for occ-assoc in (slot-p construct 'occurrences) + when (eql (parent-construct occ-assoc) construct) + return occ-assoc))) (add-to-version-history occ-assoc :start-revision revision)) (make-construct 'OccurrenceAssociationC :parent-construct construct @@ -2017,6 +2022,27 @@ ;;; CharacteristicC +(defmethod find-self-or-equal ((construct CharacteristicC) + (parent-construct TopicC) + &key (revision *TM-REVISION*)) + (declare (integer revision) (type (or OccurrenceC NameC) construct)) + (let ((chars (if (typep construct 'OccurrenceC) + (occurrences parent-construct :revision revision) + (names parent-construct :revision revision)))) + (let ((self (find construct chars))) + (if self + self + (let ((equal-char + (remove-if #'null + (map 'list + #'(lambda(char) + (strictly-equivalent-constructs + char construct :revision revision)) + chars)))) + (when equal-char + (first equal-char))))))) + + (defmethod delete-if-not-referenced ((construct CharacteristicC)) (let ((references (slot-p construct 'parent))) (when (or (not references) @@ -2130,6 +2156,7 @@ (defmethod add-parent ((construct CharacteristicC) (parent-construct ReifiableConstructC) &key (revision *TM-REVISION*)) + (declare (integer revision)) (let ((already-set-parent (parent construct :revision revision)) (same-parent-assoc ;should contain an object that was marked as deleted (loop for parent-assoc in (slot-p construct 'parent) @@ -2143,29 +2170,36 @@ :referenced-construct construct :existing-reference (parent construct :revision revision) :new-reference parent-construct))) - (cond (already-set-parent - (let ((parent-assoc - (loop for parent-assoc in (slot-p construct 'parent) - when (eql parent-construct - (parent-construct parent-assoc)) - return parent-assoc))) - (add-to-version-history parent-assoc :start-revision revision))) - (same-parent-assoc - (add-to-version-history same-parent-assoc :start-revision revision)) - (t - (let ((association-type (cond ((typep construct 'OccurrenceC) - 'OccurrenceAssociationC) - ((typep construct 'NameC) - 'NameAssociationC) - (t - 'VariantAssociationC)))) - (make-construct association-type - :characteristic construct - :parent-construct parent-construct - :start-revision revision))))) - (when (typep parent-construct 'VersionedConstructC) - (add-to-version-history parent-construct :start-revision revision)) - construct) + (let ((merged-char + (merge-if-equivalent construct parent-construct :revision revision))) + (if merged-char + merged-char + (progn + (cond (already-set-parent + (let ((parent-assoc + (loop for parent-assoc in (slot-p construct 'parent) + when (eql parent-construct + (parent-construct parent-assoc)) + return parent-assoc))) + (add-to-version-history parent-assoc + :start-revision revision))) + (same-parent-assoc + (add-to-version-history same-parent-assoc + :start-revision revision)) + (t + (let ((association-type (cond ((typep construct 'OccurrenceC) + 'OccurrenceAssociationC) + ((typep construct 'NameC) + 'NameAssociationC) + (t + 'VariantAssociationC)))) + (make-construct association-type + :characteristic construct + :parent-construct parent-construct + :start-revision revision)))) + (when (typep parent-construct 'VersionedConstructC) + (add-to-version-history parent-construct :start-revision revision)) + construct))))) (defmethod delete-parent ((construct CharacteristicC) @@ -2215,6 +2249,24 @@ ;;; VariantC +(defmethod find-self-or-equal ((construct VariantC) (parent-construct NameC) + &key (revision *TM-REVISION*)) + (declare (integer revision)) + (let ((vars (variants parent-construct :revision revision))) + (let ((self (find construct vars))) + (if self + self + (let ((equal-var + (remove-if #'null + (map 'list + #'(lambda(var) + (strictly-equivalent-constructs + var construct :revision revision)) + vars)))) + (when equal-var + (first equal-var))))))) + + (defmethod equivalent-constructs ((construct-1 VariantC) (construct-2 VariantC) &key (revision *TM-REVISION*)) (declare (ignorable revision)) @@ -2475,6 +2527,24 @@ ;;; RoleC +(defmethod find-self-or-equal ((construct RoleC) (parent-construct AssociationC) + &key (revision *TM-REVISION*)) + (declare (integer revision)) + (let ((p-roles (roles parent-construct :revision revision))) + (let ((self (find construct p-roles))) + (if self + self + (let ((equal-role + (remove-if #'null + (map 'list + #'(lambda(role) + (strictly-equivalent-constructs + role construct :revision revision)) + p-roles)))) + (when equal-role + (first equal-role))))))) + + (defmethod delete-if-not-referenced ((construct RoleC)) (let ((references (slot-p construct 'parent))) (when (or (not references) @@ -2586,6 +2656,7 @@ (defmethod add-parent ((construct RoleC) (parent-construct AssociationC) &key (revision *TM-REVISION*)) + (declare (integer revision)) (let ((already-set-parent (parent construct :revision revision)) (same-parent-assoc (loop for parent-assoc in (slot-p construct 'parent) when (eql parent-construct (parent-construct parent-assoc)) @@ -2598,22 +2669,29 @@ :referenced-construct construct :existing-reference (parent construct :revision revision) :new-reference parent-construct))) - (cond (already-set-parent - (let ((parent-assoc - (loop for parent-assoc in (slot-p construct 'parent) - when (eql parent-construct - (parent-construct parent-assoc)) - return parent-assoc))) - (add-to-version-history parent-assoc :start-revision revision))) - (same-parent-assoc - (add-to-version-history same-parent-assoc :start-revision revision)) - (t - (make-construct 'RoleAssociationC - :role construct - :parent-construct parent-construct - :start-revision revision)))) - (add-to-version-history parent-construct :start-revision revision) - construct) + (let ((merged-role + (merge-if-equivalent construct parent-construct :revision revision))) + (if merged-role + merged-role + (progn + (cond (already-set-parent + (let ((parent-assoc + (loop for parent-assoc in (slot-p construct 'parent) + when (eql parent-construct + (parent-construct parent-assoc)) + return parent-assoc))) + (add-to-version-history parent-assoc + :start-revision revision))) + (same-parent-assoc + (add-to-version-history same-parent-assoc + :start-revision revision)) + (t + (make-construct 'RoleAssociationC + :role construct + :parent-construct parent-construct + :start-revision revision))) + (add-to-version-history parent-construct :start-revision revision) + construct))))) (defmethod delete-parent ((construct RoleC) (parent-construct AssociationC) @@ -3287,12 +3365,16 @@ :instance-of instance-of) existing-role)) (map 'list #'role (slot-p parent 'roles))))))) - (cond ((> (length existing-roles) 1) - (merge-all-constructs existing-roles)) - (existing-roles - (first existing-roles)) - (t - (make-instance 'RoleC)))))) + (if (and existing-roles + (or (eql parent (parent (first existing-roles) + :revision start-revision)) + (not (parent (first existing-roles) + :revision start-revision)))) + (progn + (add-role parent (first existing-roles) + :revision start-revision) + (first existing-roles)) + (make-instance 'RoleC))))) (when player (add-player role player :revision start-revision)) (when parent @@ -3412,7 +3494,7 @@ :argument-symbol 'start-revision :function-symbol 'make-characgteristic))) (let ((characteristic - (let ((existing-characteristic + (let ((existing-characteristics (when parent (remove-if #'null @@ -3425,8 +3507,15 @@ :instance-of instance-of) existing-characteristic)) (get-all-characteristics parent class-symbol)))))) - (if existing-characteristic - (first existing-characteristic) + (if (and existing-characteristics + (or (eql parent (parent (first existing-characteristics) + :revision start-revision)) + (not (parent (first existing-characteristics) + :revision start-revision)))) + (progn + (add-characteristic parent (first existing-characteristics) + :revision start-revision) + (first existing-characteristics)) (make-instance class-symbol :charvalue charvalue :datatype datatype))))) (when (typep characteristic 'NameC) Modified: branches/new-datamodel/src/unit_tests/datamodel_test.lisp ============================================================================== --- branches/new-datamodel/src/unit_tests/datamodel_test.lisp (original) +++ branches/new-datamodel/src/unit_tests/datamodel_test.lisp Mon Apr 12 11:06:19 2010 @@ -80,7 +80,8 @@ :test-make-TopicC :test-find-oldest-construct :test-move-referenced-constructs-ReifiableConstructC - :test-move-referenced-constructs-NameC)) + :test-move-referenced-constructs-NameC + :test-move-referenced-constructs-TopicC)) ;;TODO: test merge-constructs @@ -2931,6 +2932,57 @@ (variants name-2 :revision rev-2))))))))) +(test test-move-referenced-constructs-TopicC () + "Tests the generic move-referenced-constructs corresponding to TopicC." + (with-fixture with-empty-db (*db-dir*) + (let ((rev-1 100) + (rev-2 200)) + (let ((ii-1 (make-construct 'ItemIdentifierC :uri "ii-1")) + (ii-2 (make-construct 'ItemIdentifierC :uri "ii-2")) + (sl-1 (make-construct 'SubjectLocatorC :uri "sl-1")) + (sl-2 (make-construct 'SubjectLocatorC :uri "sl-2")) + (psi-1 (make-construct 'PersistentIdC :uri "psi-1")) + (psi-2 (make-construct 'PersistentIdC :uri "psi-2")) + (tid-1 (make-construct 'TopicIdentificationC :uri "tid-1" + :xtm-id "xtm-1")) + (tid-2 (make-construct 'TopicIdentificationC :uri "tid-2" + :xtm-id "xtm-2")) + (type-1 (make-construct 'TopicC :start-revision rev-1)) + (type-2 (make-construct 'TopicC :start-revision rev-1)) + (theme-1 (make-construct 'TopicC :start-revision rev-1)) + (theme-2 (make-construct 'TopicC :start-revision rev-1))) + (let ((variant-1 (make-construct 'VariantC + :start-revision rev-1 + :charvalue "var-1" + :themes (list theme-1))) + (variant-2 (make-construct 'VariantC + :start-revision rev-1 + :charvalue "var-2" + :themes (list theme-2))) + (variant-3 (make-construct 'VariantC + :start-revision rev-1 + :charvalue "var-1" + :themes (list theme-1))) + (occ-1 (make-construct 'OccurrenceC + :start-revision rev-1 + :charvalue "occ-1" + :instance-of type-1 + :themes (list theme-1))) + (occ-2 (make-construct 'OccurrenceC + :start-revision rev-1 + :charvalue "occ-2" + :instance-of type-2)) + (occ-3 (make-construct 'OccurrenceC + :start-revision rev-1 + :charvalue "occ-1" + :instance-of type-1 + :themes (list theme-1)))) + (let ((name-1 (make-construct 'NameC + :start-revision rev-1 + :charvalue "name-1" + :instance-of type-1)) + ) + )))))) (defun run-datamodel-tests() @@ -2991,4 +3043,5 @@ (it.bese.fiveam:run! 'test-find-oldest-construct) (it.bese.fiveam:run! 'test-move-referenced-constructs-ReifiableConstructC) (it.bese.fiveam:run! 'test-move-referenced-constructs-NameC) + (it.bese.fiveam:run! 'test-move-referenced-constructs-TopicC) ) \ No newline at end of file

1 0

[isidorus-cvs] r273 - trunk/src/json
by Lukas Giessmann 11 Apr '10

11 Apr '10

Author: lgiessmann Date: Sun Apr 11 13:55:05 2010 New Revision: 273 Log: registry: modified "make-tree-view" --> currently all constraints and types are not displayed, except the user-defined topic-types Modified: trunk/src/json/json_tmcl.lisp trunk/src/json/json_tmcl_constants.lisp Modified: trunk/src/json/json_tmcl.lisp ============================================================================== --- trunk/src/json/json_tmcl.lisp (original) +++ trunk/src/json/json_tmcl.lisp Sun Apr 11 13:55:05 2010 @@ -1275,15 +1275,43 @@ (remove-if #'(lambda(x) (when (eql topic-instance x) t)) (get-direct-subtypes-of-topic topic-instance))))))) - (list :topic topic-instance - :is-type is-type - :is-instance is-instance - :instances (map 'list #'(lambda(x) - (make-nodes (getf x :topic) (getf x :is-type) (getf x :is-instance))) - isas-of-this) - :subtypes (map 'list #'(lambda(x) - (make-nodes (getf x :topic) (getf x :is-type) (getf x :is-instance))) - akos-of-this))))) + (let ((cleaned-isas ;;all constraint topics are removed + (remove-if #'null (map 'list #'(lambda(top-entry) + (when (find-if #'(lambda(psi) + (unless (or (string= (uri psi) *constraint-psi*) + (string= (uri psi) *occurrencetype-psi*) + (string= (uri psi) *nametype-psi*) + (string= (uri psi) *associationtype-psi*) + (string= (uri psi) *roletype-psi*) + (string= (uri psi) *scopetype-psi*) + (string= (uri psi) *schema-psi*)) + top-entry)) + (psis (getf top-entry :topic))) + top-entry)) + isas-of-this))) + (cleaned-akos ;;all constraint topics are removed + (remove-if #'null (map 'list #'(lambda(top-entry) + (when (find-if #'(lambda(psi) + (unless (or (string= (uri psi) *constraint-psi*) + (string= (uri psi) *occurrencetype-psi*) + (string= (uri psi) *nametype-psi*) + (string= (uri psi) *associationtype-psi*) + (string= (uri psi) *roletype-psi*) + (string= (uri psi) *scopetype-psi*) + (string= (uri psi) *schema-psi*)) + top-entry)) + (psis (getf top-entry :topic))) + top-entry)) + akos-of-this)))) + (list :topic topic-instance + :is-type is-type + :is-instance is-instance + :instances (map 'list #'(lambda(x) + (make-nodes (getf x :topic) (getf x :is-type) (getf x :is-instance))) + cleaned-isas) + :subtypes (map 'list #'(lambda(x) + (make-nodes (getf x :topic) (getf x :is-type) (getf x :is-instance))) + cleaned-akos)))))) (defun get-all-tree-roots () Modified: trunk/src/json/json_tmcl_constants.lisp ============================================================================== --- trunk/src/json/json_tmcl_constants.lisp (original) +++ trunk/src/json/json_tmcl_constants.lisp Sun Apr 11 13:55:05 2010 @@ -9,7 +9,9 @@ (defpackage :json-tmcl-constants (:use :cl) - (:export :*topictype-psi* + (:export :*schema-psi* + :*constraint-psi* + :*topictype-psi* :*topictype-constraint-psi* :*associationtype-psi* :*associationtype-constraint-psi* @@ -51,6 +53,9 @@ (in-package :json-tmcl-constants) + +(defparameter *schema-psi* "http://psi.topicmaps.org/tmcl/schema") +(defparameter *constraint-psi* "http://psi.topicmaps.org/tmcl/constraint") (defparameter *topictype-psi* "http://psi.topicmaps.org/tmcl/topic-type") (defparameter *topictype-constraint-psi* "http://psi.topicmaps.org/tmcl/topic-type-constraint") (defparameter *associationtype-psi* "http://psi.topicmaps.org/tmcl/association-type")

1 0