- isidorus-cvs@common-lisp.net - mailman3.common-lisp.net

[isidorus-cvs] r94 - trunk/docs
by Lukas Giessmann 19 Jul '09

19 Jul '09

Author: lgiessmann Date: Sun Jul 19 14:42:47 2009 New Revision: 94 Log: finalized the JSON ebnf schema Modified: trunk/docs/json.ebnf Modified: trunk/docs/json.ebnf ============================================================================== --- trunk/docs/json.ebnf (original) +++ trunk/docs/json.ebnf Sun Jul 19 14:42:47 2009 @@ -11,7 +11,7 @@ //+ Part 1: Basic elements //+----------------------------------------------------------------------------- -Char = "a" | "b" | ... | "A" | "B" | "0" | "1" | ... +Char = "a" | "b" | ... | "A" | "B" | ... | "0" | "1" | ... | "-" | "_" | ... String = "\"" char* "\"" Null = "\"null\"" List = "[" string ("," string)* "]" @@ -25,6 +25,10 @@ //+----------------------------------------------------------------------------- //+ Part 2: XTM - data model +//+ A fragment contains a valid but incomplete topic map with one main topic +//+ all referenced associations and all referenced topic stubs. +//+ The schema is close to XTM 2.0 with the difference that referencing topics +//+ is done via their PSIs, so a reference is always a list of PSIs. //+----------------------------------------------------------------------------- Datatype = "\"datatype\":" String Value = "\"value\":" String @@ -68,6 +72,10 @@ //+----------------------------------------------------------------------------- //+ Part 3: Object summaries +//+ These Summaries are necessary to offer information of existing topics in the +//+ store. A PsiSummary contains a list of PSI lists, so the client is able to +//+ find out all existing topics. The TreeView contains a hierarchical +//+ map of the stored Topics. //+----------------------------------------------------------------------------- PsiSummary = DblList | Null @@ -85,7 +93,7 @@ Instances = "\"instances\":" (("[" TreeNode "]") | Null) TreeNode = "{" TopicList "," isType "," isInstance "," Instances "}" - +TreeView = ("[" TreeNode+ "]") | Null //+----------------------------------------------------------------------------- //+ Part 4: TMCL - data model @@ -94,27 +102,77 @@ CardMax = "\"cardMax\":" ENumber RegExp = "\"regexp\":" String -ExclusiveInstance = "{\"owner\":" List ",\"exclisives\":" (DblList | Null) "}" SimpleConstraint = "{" RegExp "," CardMin "," CardMax "}" Constraints = "\"constraints\":[" SimpleConstraint+ "]" - +// Contains the owner instances and all topic types that are defined +// es exclusives for the owner type +ExclusiveInstances = "\"exclusiveInstances\":{\"owner\":" List + ",\"exclisives\":" (DblList | Null) "}" + +// Contains a list of constraints that offer information about +// the regular expressions and cardinalities for subjectIdentifiers +// or subjectLocators +SubjectIdentifierConstraints = "\"subjectIdentifierConstraints\":" (Constraints | Null) +SubjectLocatorConstraints = "\"subjectLocatorConstraints\":" (Constraints | Null) + +// Offers scope information. The ScopeType contains a representation of all +// available scopes and their subtys. Further constructs describe the +// cardinalities ScopeType = "\"scopeTypes\":" TrpList ScopeConstraint = "{" ScopeType "," CardMin "," CardMax "}" ScopeConstraints = "\"scopeConstraints\":" (("[" scopeConstraint "]") | Null) +// Describes a name constraint for a nametype and its subtypes. NameTypeScope = "{\"nameType\":" List "," scopeConstraints "}" NameTypeScopes = "\"nametypescopes\":[" NameTypeScope+ "]" TopicNameConstraint = "{" NameTypeScopes "," Constraints "}" +TopicNameConstraints "\"topicNameConstraints\":" (("[" TopicNameConstraint+ "]") | Null) +// Describes an occurrence constraint for an occurencetype and its subtypes. UniqueConstraints = "\"uniqeConstraints\":[" SimpleConstraint+ "]" DatatypeConstraint = "\"datatypeConstraint\":" String OccurrenceTypeScope = "{\"occurrenceType\":" List "," scopeConstraints "," DatatypeConstraint "}" OccurrenceTypeScopes = "\"occurrenceTypes\":[" OccurrenceTypeScope+ "]" -TopicOccurrenceConstraint = "{" OccurrenceTyoeScopes "," Constraints "," +TopicOccurrenceConstraint = "{" OccurrenceTypeScopes "," Constraints "," UniqueConstraints "}" +TopicOccurrenceConstraints = "\"topicOccurrenceConstraints\":" + (("[" TopicOccurrenceConstraints+ "]") | Null) + +// Contains all constraints that depends on a topic +TopicConstraint = "{" ExclusiveInstances "," SubjectIdentifierConstraints "," + SubjectLocatorConstraints "," TopicNameConstraints "," + TopicOccurrenceConstraints "," AbstractConstraint "}" + +// Describes an associationrole-constraint +RoleType = "\"roleType\":" DblList +ARC = "{" RoleType "," cardMin "," cardMax "}" +ARCs = "\"AssociationRoleConstraints\":" (("[" ARC+ "]") | Null) + +// Describes a roleplayer-constraint and also contains all possible +// players. +PlayerType = "\"playerType\":" DblList +Players = "\"players\":" DblList +RPC = "{" playerType "," Players "," RoleType "," cardMin "," cardMax "}" +RPCs = "\"rolePlayerConstraints\":" (("[" RPC+ "]") | Null) + +// Describes an otherrole-constraint and also contains all possible +// players and otherplayers. +OtherRoleType = "\"otherRoleType\":" DblList +OtherPlayerType = "\"otherPlayewrType\":" DblList +OtherPlayers = "\"otherPlayers\":" DblList +ORC = "{" PlayerType "," Players "," RoleType "," OtherPlayerType "," + OtherPlayers "," OtherRoleType "," cardMin "," cardMax "}" +ORCs "\"otehrRoleConstraints\":" (("[" ORC+ "]") | Null) + +// Describes all constraints of all associations depending to the topic +AssocType = "\"associationType\":" List +AConstraints = "{" AssocType "," ARCs "," RPCs "," ORCs "," ScopeConstraints "}" +AssociationsConstraints "\"associationsConstraints\":" (("[" AConstraints+ "]") | Null) +// Contains the entire TMCL information +FragmentConstraint ="{" TopicConstraints "," AssociationsConstraints "}" //+----------------------------------------------------------------------------- //+ Part 5: Server-side RESTful interface //+----------------------------------------------------------------------------- @@ -122,9 +180,9 @@ "/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/?$" -"/json/tmcl/instances/?$" -"/json/topicstubs/(.+)$" -"/json/tmcl/type/?$" -"/json/tmcl/instance/?$" -"/json/tmcl/overview/?$" \ No newline at end of file +"/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

1 0

[isidorus-cvs] r93 - trunk/docs
by Lukas Giessmann 19 Jul '09

19 Jul '09

Author: lgiessmann Date: Sun Jul 19 13:07:23 2009 New Revision: 93 Log: added a ebnf schema for the used json model Added: trunk/docs/json.ebnf Removed: trunk/docs/JSON_model.pdf Added: trunk/docs/json.ebnf ============================================================================== --- (empty file) +++ trunk/docs/json.ebnf Sun Jul 19 13:07:23 2009 @@ -0,0 +1,130 @@ +//+----------------------------------------------------------------------------- +//+ Overview: +//+ *Part 1: Basic elements +//+ *Part 2: XTM - data model +//+ *Part 3: Object summaries +//+ *Part 4: TMCL - data model +//+ *Part 5: Server-side RESTful interface +//+----------------------------------------------------------------------------- + +//+----------------------------------------------------------------------------- +//+ Part 1: Basic elements +//+----------------------------------------------------------------------------- + +Char = "a" | "b" | ... | "A" | "B" | "0" | "1" | ... +String = "\"" char* "\"" +Null = "\"null\"" +List = "[" string ("," string)* "]" +DblList = ("[" List ("," List)* "]") +TrpList = ("[" DblList ("," DblList)* "]") +Bool = "\"true\"" | "\"false\"" +Cipher = "1" | "2" | ... +Number = "\"0\"" | "\"" (Cipher (Cipher | "0")*) "\"" +ENumber = Number | "\"MAX_INT\"" + + +//+----------------------------------------------------------------------------- +//+ Part 2: XTM - data model +//+----------------------------------------------------------------------------- +Datatype = "\"datatype\":" String +Value = "\"value\":" String +Data = "\"resourceData\":{" Datatype "," Value "}" +RData = "\"resourceRef\":" ((string ",\"resourceData\":null") | (Null "," Data)) + +ItemIdentity = "\"itemIdentities\":" (List | Null) +SubjectLocator = "\"subjectLocators\":" (List | Null) +SubjectIdentifier = "\"subjectItentifers\":" (List | Null) +Scope = "\"scopes\":" (DblList | Null) +InstanceOf = "\"instanceOfs\":" (DblList | Null) +Type = "\"type\":" List +ID = "\id\":" string +TopicRef = "\"topicRef\":" List + +Variant = "{" ItemIdentity "," Scope "," RData "}" +Variants = "\"variants\":" (("[" Variant+ "]") | Null) + +Name = "{" ItemIdentity "," Type "," Scope "," Value "," Variants "}" +Names = "\"names\":" ("[" Name+ "]") | Null + +Occurrence = "{" ItemIdentity "," Type "," Scope "," RData "}" +Occurrences = "\"occurrences\":" (("[" Occurrence+ "]") | Null) + +Topic = "\"topic\":{" ID "," ItemIdentity "," SubjectLocator "," + SubjectIdentifier "," InstanceOf "," Names "," Occurences "}" + +Role = "{" ItemIdentity "," Type "," TopicRef "}" +Roles = "\"roles\":" (("[" Role+ "]") | Null) + +Association = "{" ItemIdentity "," Type "," Scope "," Roles "}" +Associations "\"associations\":" (("[" Association "]") | Null) + +TopicStub = "{" ID "," ItemIdentity "," SubjectLocator "," SubjectIdentifier "}" +TopicStubs = "\"topicStubs\":" (("[" TopicStub+ "]") | Null) + +TmIDs = "\"tmIds\":" List + +Fragment = "{" Topic "," TopicStubs "," Associations "," TmIDs "}" + + +//+----------------------------------------------------------------------------- +//+ Part 3: Object summaries +//+----------------------------------------------------------------------------- +PsiSummary = DblList | Null + +NameSummary = "\"names\":" (List | Null) +OccurrenceSummary = "\"occurrences\":" (List | Null) + +TopicSummary = "{" ID "," ItemIdentity "," SubjectLocator "," + SubjectIdentifier "," InstanceOf "," NameSummary "," + OccurrenceSummary "}" +TopicSummaries = ("[" TopicSummary+ "]") | Null + +TopicList = "\"topic\":" List +IsType = "\isType\":" Bool +IsInstance = "\"isInstance\":" Bool +Instances = "\"instances\":" (("[" TreeNode "]") | Null) + +TreeNode = "{" TopicList "," isType "," isInstance "," Instances "}" + + +//+----------------------------------------------------------------------------- +//+ Part 4: TMCL - data model +//+----------------------------------------------------------------------------- +CardMin = "\"cardMin\":" Number +CardMax = "\"cardMax\":" ENumber +RegExp = "\"regexp\":" String + +ExclusiveInstance = "{\"owner\":" List ",\"exclisives\":" (DblList | Null) "}" +SimpleConstraint = "{" RegExp "," CardMin "," CardMax "}" +Constraints = "\"constraints\":[" SimpleConstraint+ "]" + + +ScopeType = "\"scopeTypes\":" TrpList +ScopeConstraint = "{" ScopeType "," CardMin "," CardMax "}" +ScopeConstraints = "\"scopeConstraints\":" (("[" scopeConstraint "]") | Null) + +NameTypeScope = "{\"nameType\":" List "," scopeConstraints "}" +NameTypeScopes = "\"nametypescopes\":[" NameTypeScope+ "]" +TopicNameConstraint = "{" NameTypeScopes "," Constraints "}" + +UniqueConstraints = "\"uniqeConstraints\":[" SimpleConstraint+ "]" +DatatypeConstraint = "\"datatypeConstraint\":" String +OccurrenceTypeScope = "{\"occurrenceType\":" List "," scopeConstraints "," + DatatypeConstraint "}" +OccurrenceTypeScopes = "\"occurrenceTypes\":[" OccurrenceTypeScope+ "]" +TopicOccurrenceConstraint = "{" OccurrenceTyoeScopes "," Constraints "," + UniqueConstraints "}" + +//+----------------------------------------------------------------------------- +//+ 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/?$" +"/json/tmcl/instances/?$" +"/json/topicstubs/(.+)$" +"/json/tmcl/type/?$" +"/json/tmcl/instance/?$" +"/json/tmcl/overview/?$" \ No newline at end of file

1 0

[isidorus-cvs] r92 - in trunk/src: . ajax/javascripts xml xml/rdf xml/xtm
by Lukas Giessmann 15 Jul '09

15 Jul '09

Author: lgiessmann Date: Wed Jul 15 09:05:08 2009 New Revision: 92 Log: rdf-module: restructured the xml-module -> the entire xml-module is separated into an xtm-module which contains all files that have already existed. currently there exists an rdf-module which will contain all necessary files for importing/exporting rdf-data Added: trunk/src/xml/rdf/ trunk/src/xml/rdf/exporter.lisp trunk/src/xml/rdf/importer.lisp trunk/src/xml/xtm/ trunk/src/xml/xtm/core_psis.xtm (props changed) - copied unchanged from r26, /trunk/src/xml/core_psis.xtm trunk/src/xml/xtm/exporter.lisp (props changed) - copied unchanged from r90, /trunk/src/xml/exporter.lisp trunk/src/xml/xtm/exporter_xtm1.0.lisp (props changed) - copied unchanged from r90, /trunk/src/xml/exporter_xtm1.0.lisp trunk/src/xml/xtm/exporter_xtm2.0.lisp (props changed) - copied unchanged from r90, /trunk/src/xml/exporter_xtm2.0.lisp trunk/src/xml/xtm/importer.lisp (props changed) - copied unchanged from r90, /trunk/src/xml/importer.lisp trunk/src/xml/xtm/importer_xtm1.0.lisp (props changed) - copied unchanged from r90, /trunk/src/xml/importer_xtm1.0.lisp trunk/src/xml/xtm/importer_xtm2.0.lisp (props changed) - copied unchanged from r90, /trunk/src/xml/importer_xtm2.0.lisp trunk/src/xml/xtm/setup.lisp (props changed) - copied unchanged from r90, /trunk/src/xml/setup.lisp trunk/src/xml/xtm/tools.lisp (props changed) - copied unchanged from r26, /trunk/src/xml/tools.lisp Removed: trunk/src/xml/core_psis.xtm trunk/src/xml/exporter.lisp trunk/src/xml/exporter_xtm1.0.lisp trunk/src/xml/exporter_xtm2.0.lisp trunk/src/xml/importer.lisp trunk/src/xml/importer_xtm1.0.lisp trunk/src/xml/importer_xtm2.0.lisp trunk/src/xml/setup.lisp trunk/src/xml/tools.lisp Modified: trunk/src/ajax/javascripts/datamodel.js trunk/src/isidorus.asd trunk/src/xml-constants.lisp Modified: trunk/src/ajax/javascripts/datamodel.js ============================================================================== --- trunk/src/ajax/javascripts/datamodel.js (original) +++ trunk/src/ajax/javascripts/datamodel.js Wed Jul 15 09:05:08 2009 @@ -1506,13 +1506,6 @@ this.__scope__.disable(); this.__value__.__frames__[0].disable(); this.__variants__.disable(); -/* - disableItemIdentity(this); - disableType(this); - disableScope(this); - disableValue(this); - disableVariants(this); - this.getFrame().setStyle(DISABLED_BACKGROUND_COLOR);*/ this.getFrame().writeAttribute({"class" : CLASSES.disabled()}); this.getFrame().writeAttribute({"title" : this.__cssTitle__}); this.hideAddButton(); @@ -1524,12 +1517,6 @@ this.__scope__.enable(); this.__value__.__frames__[0].enable(); this.__variants__.enable(); -/* - enableItemIdentity(this); - enableType(this); - enableScope(this); - enableValue(this); - enableVariants(this);*/ this.getFrame().writeAttribute({"class" : CLASSES.nameFrame()}); this.getFrame().removeAttribute("title"); checkRemoveAddButtons(this.__owner__, 1, this.__max__, this); Modified: trunk/src/isidorus.asd ============================================================================== --- trunk/src/isidorus.asd (original) +++ trunk/src/isidorus.asd Wed Jul 15 09:05:08 2009 @@ -19,9 +19,9 @@ :licence "LGPL" :components ( (:file "constants") - (:static-file "xml/core_psis.xtm") + (:static-file "xml/xtm/core_psis.xtm") (:file "xml-constants" - :depends-on ("xml/core_psis.xtm" + :depends-on ("xml/xtm/core_psis.xtm" "constants")) (:module "model" :components ((:file "exceptions") @@ -33,22 +33,26 @@ :depends-on ("exceptions"))) :depends-on ("constants")) (:module "xml" - :components ((:file "tools") - (:file "importer" - :depends-on ("tools")) - (:file "importer_xtm2.0" - :depends-on ("importer")) - (:file "importer_xtm1.0" - :depends-on ("importer")) - (:file "setup" - :depends-on ("importer_xtm2.0" - "importer_xtm1.0")) - (:file "exporter_xtm1.0") - (:file "exporter_xtm2.0" - :depends-on ("exporter_xtm1.0")) - (:file "exporter" - :depends-on ("exporter_xtm1.0" - "exporter_xtm2.0"))) + :components ((:module "xtm" + :components ((:file "tools") + (:file "importer" + :depends-on ("tools")) + (:file "importer_xtm2.0" + :depends-on ("importer")) + (:file "importer_xtm1.0" + :depends-on ("importer")) + (:file "setup" + :depends-on ("importer_xtm2.0" + "importer_xtm1.0")) + (:file "exporter_xtm1.0") + (:file "exporter_xtm2.0" + :depends-on ("exporter_xtm1.0")) + (:file "exporter" + :depends-on ("exporter_xtm1.0" + "exporter_xtm2.0")))) + (:module "rdf" + :components ((:file "importer") + (:file "exporter")))) :depends-on ("constants" "xml-constants" "model" Modified: trunk/src/xml-constants.lisp ============================================================================== --- trunk/src/xml-constants.lisp (original) +++ trunk/src/xml-constants.lisp Wed Jul 15 09:05:08 2009 @@ -22,5 +22,5 @@ (defparameter *core_psis.xtm* (asdf:component-pathname - (asdf:find-component *isidorus-system* "xml/core_psis.xtm"))) + (asdf:find-component *isidorus-system* "xml/xtm/core_psis.xtm"))) Added: trunk/src/xml/rdf/exporter.lisp ============================================================================== --- (empty file) +++ trunk/src/xml/rdf/exporter.lisp Wed Jul 15 09:05:08 2009 @@ -0,0 +1,7 @@ +;;+----------------------------------------------------------------------------- +;;+ Isidorus +;;+ (c) 2008-2009 Marc Kuester, Christoph Ludwig, Lukas Giessmann +;;+ +;;+ Isidorus is freely distributable under the LGPL license. +;;+ You can find a detailed description in trunk/docs/LGPL-LICENSE.txt. +;;+----------------------------------------------------------------------------- \ No newline at end of file Added: trunk/src/xml/rdf/importer.lisp ============================================================================== --- (empty file) +++ trunk/src/xml/rdf/importer.lisp Wed Jul 15 09:05:08 2009 @@ -0,0 +1,7 @@ +;;+----------------------------------------------------------------------------- +;;+ Isidorus +;;+ (c) 2008-2009 Marc Kuester, Christoph Ludwig, Lukas Giessmann +;;+ +;;+ Isidorus is freely distributable under the LGPL license. +;;+ You can find a detailed description in trunk/docs/LGPL-LICENSE.txt. +;;+----------------------------------------------------------------------------- \ No newline at end of file

1 0

[isidorus-cvs] r91 - in trunk/src: rest_interface unit_tests
by Lukas Giessmann 09 Jul '09

09 Jul '09

Author: lgiessmann Date: Thu Jul 9 10:21:37 2009 New Revision: 91 Log: RESTful interface: changed some procedures that creates some dispatchers for hunchentoot's dispatcherlist. There is used the function create-static-file-dispathcer-and-handler instead of using create-regex-dispather. Too much calls of create-regex-dispatcher leads to a memory-problem of the heap (on london) Modified: trunk/src/rest_interface/set-up-json-interface.lisp trunk/src/unit_tests/poems.xtm 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 Jul 9 10:21:37 2009 @@ -19,7 +19,7 @@ (defparameter *json-get-type-tmcl-url* "/json/tmcl/type/?$") ;the json url for getting some tmcl information of a topic treated as a type (defparameter *json-get-instance-tmcl-url* "/json/tmcl/instance/?$") ;the json url for getting some tmcl information of a topic treated as an instance (defparameter *json-get-overview* "/json/tmcl/overview/?$") ; returns a json-object representing a tree view -(defparameter *ajax-user-interface-url* "/isidorus/?$") ;the url to the user interface; +(defparameter *ajax-user-interface-url* "/isidorus") ;the url to the user interface; (defparameter *ajax-user-interface-css-prefix* "/css") ;the url to the css files of the user interface (defparameter *ajax-user-interface-css-directory-path* "ajax/css") ;the directory contains the css files (defparameter *ajax-user-interface-file-path* "ajax/isidorus.html") ;the file path to the HTML file implements the user interface @@ -52,27 +52,25 @@ (push hunchentoot:+http-internal-server-error+ hunchentoot:*approved-return-codes*) ;; === html and css files ==================================================== (push - (create-regex-dispatcher ajax-user-interface-url - #'(lambda() - (hunchentoot:handle-static-file ajax-user-interface-file-path "text/html"))) + (create-static-file-dispatcher-and-handler ajax-user-interface-url ajax-user-interface-file-path "text/html") hunchentoot:*dispatch-table*) (dolist (script-path-and-url (make-file-path-and-url ajax-user-interface-css-directory-path ajax-user-interface-css-prefix)) (let ((script-path (getf script-path-and-url :path)) (script-url (getf script-path-and-url :url))) - (push (create-regex-dispatcher script-url - #'(lambda() - (hunchentoot:handle-static-file script-path))); "text/javascript"))) - hunchentoot:*dispatch-table*))) + (push + (create-static-file-dispatcher-and-handler script-url script-path) + hunchentoot:*dispatch-table*))) + ;; === ajax frameworks and javascript files ================================== (dolist (script-path-and-url (make-file-path-and-url ajax-javascripts-directory-path ajax-javascripts-url-prefix)) (let ((script-path (getf script-path-and-url :path)) (script-url (getf script-path-and-url :url))) - (push (create-regex-dispatcher script-url - #'(lambda() - (hunchentoot:handle-static-file script-path))); "text/javascript"))) - hunchentoot:*dispatch-table*))) + (push + (create-static-file-dispatcher-and-handler script-url script-path) + hunchentoot:*dispatch-table*))) + ;; === rest interface ======================================================== (push Modified: trunk/src/unit_tests/poems.xtm ============================================================================== --- trunk/src/unit_tests/poems.xtm (original) +++ trunk/src/unit_tests/poems.xtm Thu Jul 9 10:21:37 2009 @@ -2765,7 +2765,6 @@ <tm:association> <tm:itemIdentity href="written-by-association-shiller-resignation"/> <tm:type><tm:topicRef href="#written-by"/></tm:type> - <tm:scope><tm:topicRef href="#de"/></tm:scope> <tm:role> <tm:itemIdentity href="writer-role-schiller"/> <tm:type><tm:topicRef href="#writer"/></tm:type> @@ -2807,7 +2806,6 @@ <tm:association> <tm:type><tm:topicRef href="#written-by"/></tm:type> - <tm:scope><tm:topicRef href="#de"/></tm:scope> <tm:role> <tm:type><tm:topicRef href="#writer"/></tm:type> <tm:topicRef href="#eichendorff"/>

1 0

[isidorus-cvs] r90 - in trunk: docs src src/ajax/javascripts src/atom src/rest_interface src/threading src/unit_tests src/xml
by Lukas Giessmann 08 Jul '09

08 Jul '09

Author: lgiessmann Date: Wed Jul 8 07:02:04 2009 New Revision: 90 Log: isidorus (core): reimplemented the threading module -> all private function of hunchentoot are replaced by public functions of the package bordeaux-threads which is internally used by hunchentoot; the macors with-reader-lock and witrh-writer-lock are mostly used at the "top-layer" of all calls, e.g. RESTful-interface - with one exception the xml-im/exporter. In this module are with locks used in the main import-calls, e.g. init-isidorus, importer-xtm1.0, import-only-topics, importer, export-xtm, export-xtm-to-string and export-xtm-fragment; ajax-client: fixed a problem when creating a associaitons in the section "create topics" Added: trunk/src/unit_tests/threading_test.lisp Modified: trunk/docs/xtm_json.txt trunk/src/ajax/javascripts/create.js trunk/src/ajax/javascripts/home.js trunk/src/atom/atom.lisp trunk/src/atom/fragments.lisp trunk/src/isidorus.asd trunk/src/rest_interface/publish_feeds.lisp trunk/src/rest_interface/read.lisp trunk/src/rest_interface/rest-interface.lisp trunk/src/rest_interface/set-up-json-interface.lisp trunk/src/threading/reader-writer.lisp trunk/src/xml/exporter.lisp trunk/src/xml/exporter_xtm1.0.lisp trunk/src/xml/exporter_xtm2.0.lisp trunk/src/xml/importer.lisp trunk/src/xml/importer_xtm1.0.lisp trunk/src/xml/importer_xtm2.0.lisp trunk/src/xml/setup.lisp Modified: trunk/docs/xtm_json.txt ============================================================================== --- trunk/docs/xtm_json.txt (original) +++ trunk/docs/xtm_json.txt Wed Jul 8 07:02:04 2009 @@ -390,7 +390,7 @@ //+----------------------------------------------------------------------------- -//+ associationConstraint +//+ associationConstraints //+ The associationConstraint describes how an association of a given type //+ has to be defined. //+ associationRoleTypeConstraint constains all available roletypes for this @@ -441,5 +441,5 @@ //+----------------------------------------------------------------------------- { "topicConstraints" : <topicConstraint>, - "associationsConstraints" : [ <associationConstraint>, <...> ] + "associationsConstraints" : [ <associationConstraints>, <...> ] } Modified: trunk/src/ajax/javascripts/create.js ============================================================================== --- trunk/src/ajax/javascripts/create.js (original) +++ trunk/src/ajax/javascripts/create.js Wed Jul 8 07:02:04 2009 @@ -145,10 +145,11 @@ var aStubs = associations.getReferencedTopics(); if(aStubs && aStubs.length !== 0){ aStubs = aStubs.without(CURRENT_TOPIC).uniq(); - for(var i = 0; i !== ePsis.length; ++i) aStubs = aStubs.without(ePsis[i]); + for(var i = 0; ePsis && i !== ePsis.length; ++i) aStubs = aStubs.without(ePsis[i]); } referencedTopics = referencedTopics.concat(aStubs); } + function onSuccessHandler(topicStubs){ var tsStr = "null"; if(topicStubs && topicStubs.length !== 0){ Modified: trunk/src/ajax/javascripts/home.js ============================================================================== --- trunk/src/ajax/javascripts/home.js (original) +++ trunk/src/ajax/javascripts/home.js Wed Jul 8 07:02:04 2009 @@ -13,7 +13,7 @@ function makeHome() { var content = new Element("div", {"class" : CLASSES.content()}); - var header = new Element("h1").update("Topic Map Overview"); + var header = new Element("h1").update("Topic Maps Overview"); content.insert({"bottom" : header}); $(CLASSES.subPage()).insert({"bottom" : content}); Modified: trunk/src/atom/atom.lisp ============================================================================== --- trunk/src/atom/atom.lisp (original) +++ trunk/src/atom/atom.lisp Wed Jul 8 07:02:04 2009 @@ -8,7 +8,7 @@ (defpackage :atom - (:use :cl :cxml :constants :xml-tools :datamodel :drakma) + (:use :cl :cxml :constants :xml-tools :datamodel :drakma :isidorus-threading) (:export :collection-feed :defsite :dependency Modified: trunk/src/atom/fragments.lisp ============================================================================== --- trunk/src/atom/fragments.lisp (original) +++ trunk/src/atom/fragments.lisp Wed Jul 8 07:02:04 2009 @@ -35,23 +35,24 @@ "Unlike for the other feed types, entries can be calculated" (remove nil - (loop for fragment in - (mapcan #'d:get-fragments (rest (d:get-all-revisions))) - collect - (let - ((tm (d:get-item-by-item-identifier (tm-id feed) :revision 0)) - (xtm-link (format nil "~a/~a" - (link feed) (d:unique-id fragment))) - (psi (d:uri (first (d:psis (d:topic fragment)))))) - (when (d:in-topicmap tm (d:topic fragment)) - (make-instance 'fragment-entry - :id xtm-link - :title psi - :psi psi - :path (format nil "~a/~a" (path feed) (d:unique-id fragment)) - :updated (datetime-in-iso-format (d:revision fragment)) - :link xtm-link - :summary (format nil "Fragment for topic ~a" psi))))))) + (with-writer-lock + (loop for fragment in + (mapcan #'d:get-fragments (rest (d:get-all-revisions))) + collect + (let + ((tm (d:get-item-by-item-identifier (tm-id feed) :revision 0)) + (xtm-link (format nil "~a/~a" + (link feed) (d:unique-id fragment))) + (psi (d:uri (first (d:psis (d:topic fragment)))))) + (when (d:in-topicmap tm (d:topic fragment)) + (make-instance 'fragment-entry + :id xtm-link + :title psi + :psi psi + :path (format nil "~a/~a" (path feed) (d:unique-id fragment)) + :updated (datetime-in-iso-format (d:revision fragment)) + :link xtm-link + :summary (format nil "Fragment for topic ~a" psi)))))))) ;; (defun build-fragments-feed (tm-id) Modified: trunk/src/isidorus.asd ============================================================================== --- trunk/src/isidorus.asd (original) +++ trunk/src/isidorus.asd Wed Jul 8 07:02:04 2009 @@ -51,7 +51,8 @@ "exporter_xtm2.0"))) :depends-on ("constants" "xml-constants" - "model")) + "model" + "threading")) (:module "atom" :components ((:file "atom") ;; (:file "configuration" @@ -66,7 +67,9 @@ :depends-on ("fragments" "snapshots")) (:file "confreader" :depends-on ("collection" "fragments" "snapshots"))) - :depends-on ("model" "xml")) + :depends-on ("model" + "xml" + "threading")) (:module "rest_interface" :components ((:file "rest-interface") (:file "publish_feeds" @@ -78,7 +81,8 @@ :depends-on ("model" "atom" "xml" - "json")) + "json" + "threading")) (:module "unit_tests" :components ((:static-file "dangling_topicref.xtm") (:static-file "inconsistent.xtm") @@ -119,12 +123,14 @@ (:file "atom_test" :depends-on ("fixtures")) (:file "json_test" - :depends-on ("fixtures"))) + :depends-on ("fixtures")) + (:file "threading_test")) :depends-on ("atom" "constants" "model" "xml" - "json")) + "json" + "threading")) (:module "json" :components ((:file "json_exporter") (:file "json_importer") @@ -133,7 +139,8 @@ (:file "json_tmcl_constants") (:file "json_tmcl" :depends-on ("json_tmcl_validation"))) - :depends-on ("model" "xml")) + :depends-on ("model" + "xml")) (:module "ajax" :components ((:static-file "isidorus.html") (:module "javascripts" @@ -158,9 +165,8 @@ :components ((:static-file "home.css") (:static-file "navi.css") (:static-file "main.css"))))) - ) - ;;(:module "threading" - ;; :components ((:file "reader-writer")))) + (:module "threading" + :components ((:file "reader-writer")))) :depends-on (:cxml :drakma :elephant Modified: trunk/src/rest_interface/publish_feeds.lisp ============================================================================== --- trunk/src/rest_interface/publish_feeds.lisp (original) +++ trunk/src/rest_interface/publish_feeds.lisp Wed Jul 8 07:02:04 2009 @@ -56,7 +56,8 @@ (setf (hunchentoot:content-type*) "application/x-tm+xml;version=1.0; charset=utf-8") (let ((fragment - (d:get-fragment (parse-integer unique-id)))) + (with-reader-lock + (d:get-fragment (parse-integer unique-id))))) (if fragment (exporter:export-xtm-fragment fragment :xtm-format '1.0) (format nil "<t:topicMap xmlns:t=\"http://www.topicmaps.org/xtm/1.0/\" xmlns:xlink=\"http://www.w3.org/1999/xlink\"/>"))))) Modified: trunk/src/rest_interface/read.lisp ============================================================================== --- trunk/src/rest_interface/read.lisp (original) +++ trunk/src/rest_interface/read.lisp Wed Jul 8 07:02:04 2009 @@ -62,14 +62,14 @@ (revision (d:get-revision))) (loop for entry in (slot-value feed 'atom:entries) do (let - ((top (d:get-item-by-psi (psi entry) :revision revision)) + ((top (d:get-item-by-psi (psi entry) :revision revision)) (xtm-id (atom:id entry)) (source-locator (source-locator-prefix feed))) ;check if xtm-id has already been imported or if the entry is older ;than the snapshot feed. If so, don't do it again (unless (or (xtm-id-p xtm-id) (string> (atom:updated entry) (atom:updated imported-snapshot-entry))) (when top - (mark-as-deleted top :source-locator source-locator :revision revision)) + (mark-as-deleted top :source-locator source-locator :revision revision)) ;(format t "Fragment feed: ~a~&" (link entry)) (importer-xtm1.0 (dom:document-element @@ -79,9 +79,9 @@ ;locator + a suitable internal id as an identifier to all ;characteristics and associations that don't already have ;one and then reuse it next time - (add-source-locator - (d:get-item-by-psi (psi entry) :revision revision) ;works even if the topic is only created during import - :source-locator source-locator :revision revision)))))) + (add-source-locator + (d:get-item-by-psi (psi entry) :revision revision) ;works even if the topic is only created during import + :source-locator source-locator :revision revision)))))) (defun string-max (string-list &optional (max nil)) (cond @@ -172,9 +172,10 @@ (get-attribute snapshot-feed-link-elem "href") :tm-id feed-url))) (assert imported-snapshot-entry) - (import-fragments-feed - (get-attribute fragment-feed-link-elem "href") - imported-snapshot-entry :tm-id feed-url)))) + (with-writer-lock + (import-fragments-feed + (get-attribute fragment-feed-link-elem "href") + imported-snapshot-entry :tm-id feed-url))))) \ No newline at end of file Modified: trunk/src/rest_interface/rest-interface.lisp ============================================================================== --- trunk/src/rest_interface/rest-interface.lisp (original) +++ trunk/src/rest_interface/rest-interface.lisp Wed Jul 8 07:02:04 2009 @@ -17,7 +17,8 @@ :xml-tools :xml-importer :json-exporter - :json-importer) + :json-importer + :isidorus-threading) (:export :import-fragments-feed :import-snapshots-feed :import-tm-feed @@ -56,75 +57,16 @@ (lambda () (apply page-function (coerce matched-registers 'list)))))))) -;; (defun feeds () -;; "interface funtion to the corresponding Atom method" -;; (setf (content-type) "application/atom+xml; charset=UTF-8") -;; (cxml:with-xml-output (cxml:make-string-sink :canonical t) -;; (atom:feed-to-elem atom::*tm-feed*))) - -;; (defun snapshot-feed () -;; "Interface function to the corresponding Atom method" -;; (setf (content-type) "application/atom+xml; charset=UTF-8") -;; (cxml:with-xml-output (cxml:make-string-sink :canonical t) -;; ;(atom:build-snapshot-feed))) -;; )) - -;; (defun snapshots (&optional revision) -;; "Export a snapshot by revision" -;; (assert revision) -;; (format t "in snapshots~&") -;; (setf (content-type) "application/xtm+xml; charset=utf-8") -;; (exporter:export-xtm-to-string :revision (parse-integer revision) -;; :xtm-format '1.0)) - - -;; (defun fragments (&optional unique-id) -;; "Export a fragment by its unique id" -;; (assert unique-id) -;; (setf (content-type) "application/xtm+xml; charset=utf-8") -;; (let -;; ((fragment -;; (d:get-fragment (parse-integer unique-id)))) -;; (if fragment -;; (exporter:export-xtm-fragment fragment :xtm-format '1.0) -;; (format nil "<t:topicMap xmlns:t=\"http://www.topicmaps.org/xtm/1.0/\" xmlns:xlink=\"http://www.w3.org/1999/xlink\"/>")))) - - -;; (push -;; (create-regex-dispatcher "/feeds/?$" #'feeds) -;; hunchentoot:*dispatch-table*) - -;; (push -;; (create-regex-dispatcher "/feeds/testtm/?$" #'tm-feed) -;; hunchentoot:*dispatch-table*) - -;; (push -;; (create-regex-dispatcher "/testtm/snapshots/$" #'snapshot-feed) -;; hunchentoot:*dispatch-table*) - -;; (push -;; (create-regex-dispatcher "/testtm/snapshots/([0-9]+)$" #'snapshots) -;; hunchentoot:*dispatch-table*) - -;; (push -;; (create-regex-dispatcher "/testtm/fragments/?$" #'fragments-feed) -;; hunchentoot:*dispatch-table*) - -;; (push -;; (create-regex-dispatcher "/testtm/fragments/([0-9]+)$" #'fragments) -;; hunchentoot:*dispatch-table*) - - (defvar *server-acceptor* nil) + (defun start-tm-engine (repository-path &key (conffile "atom/conf.lisp") (host-name "localhost") (port 8000)) "Start the Topic Map Engine on a given port, assuming a given hostname. Use the repository under repository-path" (when *server-acceptor* (error "Ther server is already running")) (setf hunchentoot:*show-lisp-errors-p* t) ;for now - ;(setf hunchentoot:*show-lisp-backtraces-p* t) ;hunchentoot 0.15.7 (setf hunchentoot:*hunchentoot-default-external-format* (flex:make-external-format :utf-8 :eol-style :lf)) (setf atom:*base-url* (format nil "http://~a:~a" host-name port)) 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 Wed Jul 8 07:02:04 2009 @@ -117,7 +117,9 @@ "Returns all topic-psi that are valid types -> so they have to be valid to the topictype-constraint (if it exists) and the can't be abstract." (declare (ignorable param)) - (handler-case (let ((topic-types (json-tmcl::return-all-tmcl-types))) + (handler-case (let ((topic-types + (with-reader-lock + (json-tmcl::return-all-tmcl-types)))) (setf (hunchentoot:content-type*) "application/json") ;RFC 4627 (json:encode-json-to-string (map 'list #'(lambda(y) @@ -133,7 +135,9 @@ The validity is only oriented on the typing of topics, e.g. type-instance or supertype-subtype." (declare (ignorable param)) - (handler-case (let ((topic-instances (json-tmcl::return-all-tmcl-instances))) + (handler-case (let ((topic-instances + (with-reader-lock + (json-tmcl::return-all-tmcl-instances)))) (setf (hunchentoot:content-type*) "application/json") ;RFC 4627 (json:encode-json-to-string (map 'list #'(lambda(y) @@ -152,7 +156,8 @@ (let ((topic (d:get-item-by-psi psi))) (if topic (let ((topic-json - (handler-case (json-exporter::to-json-topicStub-string topic) + (handler-case (with-reader-lock + (json-exporter::to-json-topicStub-string topic)) (condition (err) (progn (setf (hunchentoot:return-code*) hunchentoot:+http-internal-server-error+) (setf (hunchentoot:content-type*) "text") @@ -176,7 +181,8 @@ (handler-case (let ((psis (json:decode-json-from-string json-data))) (let ((tmcl - (json-tmcl:get-constraints-of-fragment psis :treat-as treat-as))) + (with-reader-lock + (json-tmcl:get-constraints-of-fragment psis :treat-as treat-as)))) (if tmcl (progn (setf (hunchentoot:content-type*) "application/json") ;RFC 4627 @@ -200,7 +206,8 @@ (if (eq http-method :GET) (progn (setf (hunchentoot:content-type*) "application/json") ;RFC 4627 - (handler-case (get-all-topic-psis) + (handler-case (with-reader-lock + (get-all-topic-psis)) (condition (err) (progn (setf (hunchentoot:return-code*) hunchentoot:+http-internal-server-error+) (setf (hunchentoot:content-type*) "text") @@ -216,9 +223,11 @@ (let ((identifier (string-replace psi "%23" "#"))) (setf (hunchentoot:content-type*) "application/json") ;RFC 4627 (let ((fragment - (create-latest-fragment-of-topic identifier))) + (with-writer-lock + (create-latest-fragment-of-topic identifier)))) (if fragment - (handler-case (to-json-string fragment) + (handler-case (with-reader-lock + (to-json-string fragment)) (condition (err) (progn (setf (hunchentoot:return-code*) hunchentoot:+http-internal-server-error+) @@ -239,7 +248,8 @@ (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 (json-importer:json-to-elem json-data) + (handler-case (with-writer-lock + (json-importer:json-to-elem json-data)) (condition (err) (progn (setf (hunchentoot:return-code*) hunchentoot:+http-internal-server-error+) @@ -257,31 +267,33 @@ (end-idx (handler-case (parse-integer (hunchentoot:get-parameter "end")) (condition () nil)))) - (handler-case (let ((topics (elephant:get-instances-by-class 'd:TopicC))) - (let ((end - (cond - ((not end-idx) - (length topics)) - ((> end-idx (length topics)) - (length topics)) - ((< end-idx 0) - 0) - (t - end-idx)))) - (let ((start + (handler-case (with-reader-lock + (let ((topics + (elephant:get-instances-by-class 'd:TopicC))) + (let ((end (cond - ((> start-idx (length topics)) - end) - ((< start-idx 0) + ((not end-idx) + (length topics)) + ((> end-idx (length topics)) + (length topics)) + ((< end-idx 0) 0) (t - start-idx)))) - (let ((topics-in-range - (if (<= start end) - (subseq topics start end) - (reverse (subseq topics end start))))) - (setf (hunchentoot:content-type*) "application/json") ;RFC 4627 - (json-exporter:make-topic-summary topics-in-range))))) + end-idx)))) + (let ((start + (cond + ((> start-idx (length topics)) + end) + ((< start-idx 0) + 0) + (t + start-idx)))) + (let ((topics-in-range + (if (<= start end) + (subseq topics start end) + (reverse (subseq topics end start))))) + (setf (hunchentoot:content-type*) "application/json") ;RFC 4627 + (json-exporter:make-topic-summary topics-in-range)))))) (condition (err) (progn (setf (hunchentoot:return-code*) hunchentoot:+http-internal-server-error+) (setf (hunchentoot:content-type*) "text") @@ -292,7 +304,8 @@ "Returns a json-object representing a topic map overview as a tree(s)" (declare (ignorable param)) (handler-case (let ((json-string - (json-tmcl::tree-view-to-json-string (json-tmcl::make-tree-view)))) + (with-reader-lock + (json-tmcl::tree-view-to-json-string (json-tmcl::make-tree-view))))) (setf (hunchentoot:content-type*) "application/json") ;RFC 4627 json-string) (Condition (err) (progn Modified: trunk/src/threading/reader-writer.lisp ============================================================================== --- trunk/src/threading/reader-writer.lisp (original) +++ trunk/src/threading/reader-writer.lisp Wed Jul 8 07:02:04 2009 @@ -7,66 +7,63 @@ ;;+----------------------------------------------------------------------------- -(defpackage :isidorus-reader-writer - (:use :cl :hunchentoot-mp) ;hunchentoot 0.15.7 +(defpackage :isidorus-threading + (:use :cl :bordeaux-threads) (:export :current-readers :with-reader-lock :with-writer-lock)) -(in-package :isidorus-reader-writer) - -(defvar *readerlist-mutex* (make-lock "isidorus current-readers lock")) ;hunchentoot 0.15.7 -(defvar *writer-mutex* (make-lock "isidorus writer lock")) ;hunchentoot 0.15.7 -;;(defvar *readerlist-mutex* (hunchentoot::make-lock "isidorus current-readers lock")) ;hunchentoot 1.0.0 -;;(defvar *writer-mutex* (hunchentoot::make-lock "isidorus writer lock")) ;hunchentoot 1.0.0 +(in-package :isidorus-threading) +(defvar *readerlist-lock* (make-lock "isidorus-threading: current readers lock")) +(defvar *writer-lock* (make-lock "isidorus-threading: writer lock")) (defvar *current-readers* nil) + (defun current-readers () - (let - ((result nil)) - ;;(with-lock (*readerlist-mutex*) ;hunchentoot 0.15.7 - (hunchentoot::with-lock-held (*readerlist-mutex*) ;hunchentoot 1.0.0 + "Returns a copy of the list which contains all current reader + threads, *current-readers*" + (let ((result nil)) + (with-lock-held (*readerlist-lock*) (setf result (copy-list *current-readers*))) result)) -(defun add-current-to-reader-list () - (with-lock (*writer-mutex*) ;hunchentoot 0.15.7 - (with-lock (*readerlist-mutex*) ;hunchentoot 0.15.7 - ;;(hunchentoot::with-lock-held (*writer-mutex*) ;hunchentoot 1.0.0 - ;;(hunchentoot::with-lock-held (*readerlist-mutex*) ;hunchentoot 1.0.0 - (push *current-process* *current-readers*)))) - -(defun remove-current-from-reader-list () - (with-lock (*readerlist-mutex*) ;hunchentoot 0.15.7 - ;;(hunchentoot::with-lock-held (*readerlist-mutex*) ;hunchentoot 1.0.0 + +(defun add-thread-to-reader-list () + "Adds the current thread to the reader list" + (with-lock-held (*writer-lock*) + (with-lock-held (*readerlist-lock*) + (push (current-thread) *current-readers*)))) + + +(defun remove-thread-from-reader-list () + "Removes the current threads from the reader list" + (with-lock-held (*readerlist-lock*) (setf *current-readers* - (delete *current-process* *current-readers*)))) + (delete (current-thread) *current-readers*)))) + (defmacro with-reader-lock (&body body) + "Executes the passed 'body' with the reader lock" `(progn - (add-current-to-reader-list) - (handler-case - (progn ,@body) - (condition (c) - (progn - (remove-current-from-reader-list) - (error c)))) - (remove-current-from-reader-list))) - + (add-thread-to-reader-list) + (let ((result nil)) + (handler-case + (setf result ,@body) + (condition (c) + (progn + (remove-thread-from-reader-list) + (error c)))) + (remove-thread-from-reader-list) + result))) + (defmacro with-writer-lock (&body body) - `(with-lock (*writer-mutex*) ;hunchentoot 0.15.7 - ;;`(hunchentoot::with-lock-held (*writer-mutex*) ;hunchetoot 1.0.0 + "Executes the passed body when the reader list is empty otherwise + the do macor loops in 500 ms time interval for a next chance." + `(with-lock-held (*writer-lock*) (do ((remaining-readers (current-readers) (current-readers))) - ((nullp remaining-raeders) nil) - ;; TODO: replace hunchentoot's internal function by - ;; something we are officially allowed to use. - ;; make sure the current thread sleeps for, say, 500ms. - (hunchentoot::process-allow-scheduling())) - ,@body)) - - - - \ No newline at end of file + ((null remaining-readers)) + (sleep 0.5)) + ,@body)) \ No newline at end of file Added: trunk/src/unit_tests/threading_test.lisp ============================================================================== --- (empty file) +++ trunk/src/unit_tests/threading_test.lisp Wed Jul 8 07:02:04 2009 @@ -0,0 +1,132 @@ +;;+----------------------------------------------------------------------------- +;;+ Isidorus +;;+ (c) 2008-2009 Marc Kuester, Christoph Ludwig, Lukas Giessmann +;;+ +;;+ Isidorus is freely distributable under the LGPL license. +;;+ You can find a detailed description in trunk/docs/LGPL-LICENSE.txt. +;;+----------------------------------------------------------------------------- + + +(defpackage :threading-test + (:use :cl + :it.bese.FiveAM + :isidorus-threading + :bordeaux-threads) + (:export :run-threading-tests + :test-helpers + :test-with-reader-lock + :test-with-writer-lock + :threading-test)) + + +(in-package :threading-test) + + +(def-suite threading-test + :description "tests various key functions of the threading module") + +(in-suite threading-test) + +(test test-helpers + "Tests the helper functions current-readers, add-thread-to-reader-list + and remove-thread-from-reader-list" + (is-true isidorus-threading::*readerlist-lock*) + (is-true isidorus-threading::*writer-lock*) + (is-false isidorus-threading::*current-readers*) + (is-false (progn + (isidorus-threading::remove-thread-from-reader-list) + (current-readers))) + (is (= 1 (length (progn + (isidorus-threading::add-thread-to-reader-list) + (current-readers))))) + (is (eql (first (current-readers)) (current-thread))) + (is (= 1 (length isidorus-threading::*current-readers*))) + (is-true (let ((copy-of-readers + (current-readers))) + (setf copy-of-readers nil) + isidorus-threading::*current-readers*)) + (setf isidorus-threading::*current-readers* nil) + (is-false (current-readers)) + (is (= 2 (length (progn + (isidorus-threading::add-thread-to-reader-list) + (isidorus-threading::add-thread-to-reader-list) + (isidorus-threading::current-readers))))) + (is (= 1 (progn + (isidorus-threading::remove-thread-from-reader-list) + (push t isidorus-threading::*current-readers*) + (length (current-readers))))) + (setf isidorus-threading::*current-readers* nil)) + + +(test test-with-reader-lock + "Tests the macro with-reader-lock" + (is-true isidorus-threading::*readerlist-lock*) + (is-true isidorus-threading::*writer-lock*) + (is-false isidorus-threading::*current-readers*) + (let ((thread-1 + (make-thread #'(lambda() + (with-reader-lock (sleep 3))))) + (thread-2 + (make-thread #'(lambda() + (with-reader-lock (sleep 3))))) + (thread-3 + (make-thread #'(lambda() + (with-reader-lock (sleep 3)))))) + (is (= 3 (length (current-readers)))) + (is-true (find thread-1 (current-readers))) + (is-true (find thread-2 (current-readers))) + (is-true (find thread-3 (current-readers))) + (sleep 4) + (is-false (current-readers))) + (setf isidorus-threading::*current-readers* nil) + (make-thread #'(lambda() + (with-lock-held (isidorus-threading::*readerlist-lock*) + (sleep 3)))) + (let ((start-time + (get-universal-time))) + (isidorus-threading::add-thread-to-reader-list) + (is (<= (+ 2 start-time) (get-universal-time)))) + (setf isidorus-threading::*current-readers* nil) + (let ((start-time + (get-universal-time))) + (make-thread #'(lambda() (with-reader-lock (sleep 3)))) + (make-thread #'(lambda() (with-reader-lock (sleep 3)))) + (is (> (+ start-time 3) (get-universal-time))) + (is (= 2 (length (current-readers)))) + (sleep 4)) + (is-false (current-readers))) + + +(test test-with-writer-lock + "Tests the macro with-writer-lock" + (is-true isidorus-threading::*readerlist-lock*) + (is-true isidorus-threading::*writer-lock*) + (is-false isidorus-threading::*current-readers*) + (let ((start-time + (get-universal-time))) + (with-writer-lock nil) + (is (>= (+ 1 start-time) (get-universal-time)))) + (make-thread #'(lambda() + (with-reader-lock #'(lambda() + (sleep 3))))) + (let ((start-time + (get-universal-time))) + (make-thread #'(lambda() (with-writer-lock (sleep 3)))) + (make-thread #'(lambda() (with-reader-lock (sleep 3)))) + (is-false (current-readers)) + (with-writer-lock nil) + (is (<= (+ 3 start-time) (get-universal-time)))) + (let ((start-time + (get-universal-time))) + (make-thread #'(lambda() (with-reader-lock (sleep 3)))) + (make-thread #'(lambda() (with-reader-lock (sleep 3)))) + (make-thread #'(lambda() (with-reader-lock (sleep 3)))) + (with-writer-lock nil) + (is (<= (+ start-time 3) (get-universal-time))))) + + +(defun run-threading-tests () + "Runs all defined tests in this package" + (it.bese.fiveam:run! 'test-helpers) + (it.bese.fiveam:run! 'test-with-reader-lock) + (it.bese.fiveam:run! 'test-with-writer-lock)) \ No newline at end of file Modified: trunk/src/xml/exporter.lisp ============================================================================== --- trunk/src/xml/exporter.lisp (original) +++ trunk/src/xml/exporter.lisp Wed Jul 8 07:02:04 2009 @@ -68,44 +68,47 @@ tm-id (revision (get-revision)) (xtm-format '2.0)) - (let - ((tm - (when tm-id - (get-item-by-item-identifier tm-id :revision revision)))) - (setf *export-tm* tm) - (with-revision revision - (with-open-file (stream xtm-path :direction :output) - (cxml:with-xml-output (cxml:make-character-stream-sink stream :canonical nil) - (if (eq xtm-format '2.0) - (with-xtm2.0 + (with-reader-lock + (let + ((tm + (when tm-id + (get-item-by-item-identifier tm-id :revision revision)))) + (setf *export-tm* tm) + (with-revision revision + (with-open-file (stream xtm-path :direction :output) + (cxml:with-xml-output (cxml:make-character-stream-sink stream :canonical nil) + (if (eq xtm-format '2.0) + (with-xtm2.0 (export-to-elem tm #'to-elem)) - (with-xtm1.0 - (export-to-elem tm #'to-elem-xtm1.0)))))))) + (with-xtm1.0 + (export-to-elem tm #'to-elem-xtm1.0))))))))) (defun export-xtm-to-string (&key tm-id (revision (get-revision)) (xtm-format '2.0)) - (let - ((tm - (when tm-id - (get-item-by-item-identifier tm-id :revision revision)))) - (with-revision revision - (cxml:with-xml-output (cxml:make-string-sink :canonical nil) - (if (eq xtm-format '2.0) - (with-xtm2.0 - (export-to-elem tm #'to-elem)) - (with-xtm1.0 - (export-to-elem tm #'to-elem-xtm1.0))))))) + (with-reader-lock + (let + ((tm + (when tm-id + (get-item-by-item-identifier tm-id :revision revision)))) + (with-revision revision + (cxml:with-xml-output (cxml:make-string-sink :canonical nil) + (if (eq xtm-format '2.0) + (with-xtm2.0 + (export-to-elem tm #'to-elem)) + (with-xtm1.0 + (export-to-elem tm #'to-elem-xtm1.0)))))))) (defun export-xtm-fragment (fragment &key (xtm-format '2.0)) (declare (FragmentC fragment)) - (with-revision (revision fragment) - (cxml:with-xml-output (cxml:make-string-sink :canonical nil) - (if (eq xtm-format '2.0) - (with-xtm2.0 + (with-reader-lock + (with-revision (revision fragment) + (cxml:with-xml-output (cxml:make-string-sink :canonical nil) + (if (eq xtm-format '2.0) + (with-xtm2.0 (to-elem fragment)) - (with-xtm1.0 - (to-elem-xtm1.0 fragment)))))) + (with-xtm1.0 + (to-elem-xtm1.0 fragment))))))) \ No newline at end of file Modified: trunk/src/xml/exporter_xtm1.0.lisp ============================================================================== --- trunk/src/xml/exporter_xtm1.0.lisp (original) +++ trunk/src/xml/exporter_xtm1.0.lisp Wed Jul 8 07:02:04 2009 @@ -8,7 +8,7 @@ (defpackage :exporter - (:use :cl :cxml :elephant :datamodel) + (:use :cl :cxml :elephant :datamodel :isidorus-threading) (:import-from :constants *XTM2.0-NS* *XTM1.0-NS* Modified: trunk/src/xml/exporter_xtm2.0.lisp ============================================================================== --- trunk/src/xml/exporter_xtm2.0.lisp (original) +++ trunk/src/xml/exporter_xtm2.0.lisp Wed Jul 8 07:02:04 2009 @@ -25,18 +25,6 @@ (cxml:attribute "href" (uri psi)))) -;; (defmethod to-elem ((scope ScopeC)) -;; (cxml:with-element "t:scope" -;; (append -;; (map 'list #'ref-to-elem (themes scope))))) - - -;; (defun scopes-to-elem (scopes) -;; (when scopes -;; (cxml:with-element "t:scope" -;; (map 'list #'ref-to-elem scopes)))) - - (defmethod to-elem ((name NameC)) "name = element name { reifiable, type?, scope?, value, variant* }" Modified: trunk/src/xml/importer.lisp ============================================================================== --- trunk/src/xml/importer.lisp (original) +++ trunk/src/xml/importer.lisp Wed Jul 8 07:02:04 2009 @@ -16,7 +16,7 @@ ;; (defpackage :xml-importer - (:use :cl :cxml :elephant :datamodel) + (:use :cl :cxml :elephant :datamodel :isidorus-threading) (:import-from :constants *type-instance-psi* *type-psi* @@ -124,18 +124,19 @@ "Initiatlize the database with the stubs of the core topics + PSIs defined in the XTM 1.0 spec. This includes a topic that represents the core TM" - (with-tm (revision "core.xtm" "http://www.topicmaps.org/xtm/1.0/core.xtm") - (let - ((core-dom - (cxml:parse-file *core_psis.xtm* (cxml-dom:make-dom-builder)))) - (loop for top-elem across - (xpath-child-elems-by-qname (dom:document-element core-dom) - *xtm2.0-ns* "topic") - do - (let - ((top - (from-topic-elem-to-stub top-elem revision :xtm-id "core.xtm"))) - (add-to-topicmap tm top)))))) + (with-writer-lock + (with-tm (revision "core.xtm" "http://www.topicmaps.org/xtm/1.0/core.xtm") + (let + ((core-dom + (cxml:parse-file *core_psis.xtm* (cxml-dom:make-dom-builder)))) + (loop for top-elem across + (xpath-child-elems-by-qname (dom:document-element core-dom) + *xtm2.0-ns* "topic") + do + (let + ((top + (from-topic-elem-to-stub top-elem revision :xtm-id "core.xtm"))) + (add-to-topicmap tm top))))))) ;TODO: replace the two importers with this macro (defmacro importer-mac Modified: trunk/src/xml/importer_xtm1.0.lisp ============================================================================== --- trunk/src/xml/importer_xtm1.0.lisp (original) +++ trunk/src/xml/importer_xtm1.0.lisp Wed Jul 8 07:02:04 2009 @@ -443,22 +443,23 @@ (declare (dom:element xtm-dom)) (declare (integer revision)) (assert elephant:*store-controller*) - (with-tm (revision xtm-id tm-id) - (let - ((topic-vector (xpath-child-elems-by-qname xtm-dom *xtm1.0-ns* "topic")) - (assoc-vector (xpath-child-elems-by-qname xtm-dom *xtm1.0-ns* "association"))) - (loop for topic across topic-vector - do (from-topic-elem-to-stub-xtm1.0 topic revision - :xtm-id xtm-id)) - (loop for top-elem across topic-vector - do - (format t "t") - (merge-topic-elem-xtm1.0 top-elem revision - :tm tm - :xtm-id xtm-id)) - (loop for assoc-elem across assoc-vector - do - (format t "a") - (from-association-elem-xtm1.0 assoc-elem revision - :tm tm - :xtm-id xtm-id))))) + (with-writer-lock + (with-tm (revision xtm-id tm-id) + (let + ((topic-vector (xpath-child-elems-by-qname xtm-dom *xtm1.0-ns* "topic")) + (assoc-vector (xpath-child-elems-by-qname xtm-dom *xtm1.0-ns* "association"))) + (loop for topic across topic-vector + do (from-topic-elem-to-stub-xtm1.0 topic revision + :xtm-id xtm-id)) + (loop for top-elem across topic-vector + do + (format t "t") + (merge-topic-elem-xtm1.0 top-elem revision + :tm tm + :xtm-id xtm-id)) + (loop for assoc-elem across assoc-vector + do + (format t "a") + (from-association-elem-xtm1.0 assoc-elem revision + :tm tm + :xtm-id xtm-id)))))) Modified: trunk/src/xml/importer_xtm2.0.lisp ============================================================================== --- trunk/src/xml/importer_xtm2.0.lisp (original) +++ trunk/src/xml/importer_xtm2.0.lisp Wed Jul 8 07:02:04 2009 @@ -409,20 +409,21 @@ (declare (dom:element xtm-dom)) (declare (integer revision)) ;all topics that are imported in one go share the same revision (assert elephant:*store-controller*) - (with-tm (revision xtm-id tm-id) - (let - ((topic-vector (get-topic-elems xtm-dom)) - (assoc-vector (get-association-elems xtm-dom))) - (loop for top-elem across topic-vector do - (from-topic-elem-to-stub top-elem revision - :xtm-id xtm-id)) - (loop for top-elem across topic-vector do - (format t "t") - (merge-topic-elem top-elem revision - :tm tm - :xtm-id xtm-id)) - (loop for assoc-elem across assoc-vector do - (format t "a") - (from-association-elem assoc-elem revision - :tm tm - :xtm-id xtm-id))))) + (with-writer-lock + (with-tm (revision xtm-id tm-id) + (let + ((topic-vector (get-topic-elems xtm-dom)) + (assoc-vector (get-association-elems xtm-dom))) + (loop for top-elem across topic-vector do + (from-topic-elem-to-stub top-elem revision + :xtm-id xtm-id)) + (loop for top-elem across topic-vector do + (format t "t") + (merge-topic-elem top-elem revision + :tm tm + :xtm-id xtm-id)) + (loop for assoc-elem across assoc-vector do + (format t "a") + (from-association-elem assoc-elem revision + :tm tm + :xtm-id xtm-id)))))) Modified: trunk/src/xml/setup.lisp ============================================================================== --- trunk/src/xml/setup.lisp (original) +++ trunk/src/xml/setup.lisp Wed Jul 8 07:02:04 2009 @@ -19,25 +19,26 @@ (xtm-format '2.0) (xtm-id (get-uuid))) "Imports an XTM file into an existing repository using the correct -importer for the XTM version. Does *not* close the store afterwards" + importer for the XTM version. Does *not* close the store afterwards" (declare ((or pathname string) xtm-path)) (declare ((or pathname string) repository-path)) (let ((xtm-dom (dom:document-element (cxml:parse-file - (truename xtm-path) (cxml-dom:make-dom-builder))))) + (truename xtm-path) (cxml-dom:make-dom-builder))))) (unless elephant:*store-controller* (elephant:open-store (get-store-spec repository-path))) - ;create the topic stubs so that we can refer to them later on + ;create the topic stubs so that we can refer to them later on (setf d:*current-xtm* xtm-id) (if (eq xtm-format '2.0) - (importer xtm-dom :tm-id tm-id :xtm-id xtm-id) - (importer-xtm1.0 xtm-dom :tm-id tm-id :xtm-id xtm-id)) - (format t "#Objects in the store: Topics: ~a, Associations: ~a~%" - (length (elephant:get-instances-by-class 'TopicC)) - (length (elephant:get-instances-by-class 'AssociationC))))) - ;(format t "#Topics in the store: ~a~%" (length (elephant:get-instances-by-class 'TopicC))))) + (importer xtm-dom :tm-id tm-id :xtm-id xtm-id) + (importer-xtm1.0 xtm-dom :tm-id tm-id :xtm-id xtm-id)) + (with-reader-lock + (format t "#Objects in the store: Topics: ~a, Associations: ~a~%" + (length (elephant:get-instances-by-class 'TopicC)) + (length (elephant:get-instances-by-class 'AssociationC)))))) + (defun setup-repository (xtm-path repository-path &key tm-id @@ -46,11 +47,10 @@ "Initializes a repository and imports a XTM file into it" (declare ((or pathname string) xtm-path)) (declare ((or pathname string) repository-path)) - (unless elephant:*store-controller* (elephant:open-store (get-store-spec repository-path))) (init-isidorus) (import-xtm xtm-path repository-path :tm-id tm-id :xtm-id xtm-id :xtm-format xtm-format) (when elephant:*store-controller* - (elephant:close-store))) \ No newline at end of file + (elephant:close-store))) \ No newline at end of file

1 0

[isidorus-cvs] r89 - in trunk/src: ajax/javascripts unit_tests
by Lukas Giessmann 04 Jul '09

04 Jul '09

Author: lgiessmann Date: Sat Jul 4 11:49:18 2009 New Revision: 89 Log: ajax-client: the test-file poems.xtm was changed to a final state - there are no unused sub-types or any other senseless constructs for testing anymore Modified: trunk/src/ajax/javascripts/constants.js trunk/src/unit_tests/poems.xtm Modified: trunk/src/ajax/javascripts/constants.js ============================================================================== --- trunk/src/ajax/javascripts/constants.js (original) +++ trunk/src/ajax/javascripts/constants.js Sat Jul 4 11:49:18 2009 @@ -11,7 +11,7 @@ // --- Some constants fot the http connections via the XMLHttpRequest-Object -var HOST_PREF = "http://192.168.178.21:8000/"; //"http://localhost:8000/"; // of the form "http://(.+)/" +var HOST_PREF = "http://localhost: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/unit_tests/poems.xtm ============================================================================== --- trunk/src/unit_tests/poems.xtm (original) +++ trunk/src/unit_tests/poems.xtm Sat Jul 4 11:49:18 2009 @@ -1,76 +1,5 @@ <?xml version="1.0" encoding="UTF-8"?> <tm:topicMap version="2.0" xmlns:tm="http://www.topicmaps.org/xtm/"> -  - <tm:topic id="sub-written"> - <tm:subjectIdentifier href="sub-written-psi"/> - </tm:topic> - - <tm:association> - <tm:type><tm:topicRef href="#supertype-subtype"/></tm:type> - <tm:role> - <tm:type><tm:topicRef href="#subtype"/></tm:type> - <tm:topicRef href="#sub-written"/> - </tm:role> - <tm:role> - <tm:type><tm:topicRef href="#supertype"/></tm:type> - <tm:topicRef href="#written"/> - </tm:role> - </tm:association> -  - - -  - <tm:topic id="scoped-born-in-constraint-1"> - <tm:subjectIdentifier href="http://some.where/constraint-psis/scoped-born-in-constraint-1"/> - <tm:instanceOf><tm:topicRef href="#associationtypescope-constraint"/></tm:instanceOf> - <tm:occurrence> - <tm:type><tm:topicRef href="#card-min"/></tm:type> - <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#unsignedInt">1</tm:resourceData> - </tm:occurrence> - <tm:occurrence> - <tm:type><tm:topicRef href="#card-max"/></tm:type> - <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#unsignedInt">2</tm:resourceData> - </tm:occurrence> - </tm:topic> - - <tm:association> - <tm:type><tm:topicRef href="#applies-to"/></tm:type> - <tm:role> - <tm:type><tm:topicRef href="#constraint-role"/></tm:type> - <tm:topicRef href="#scoped-born-in-constraint-1"/> - </tm:role> - <tm:role> - <tm:type><tm:topicRef href="#associationtype-role"/></tm:type> - <tm:topicRef href="#written-by"/> - </tm:role> - </tm:association> - - <tm:association> - <tm:type><tm:topicRef href="#applies-to"/></tm:type> - <tm:role> - <tm:type><tm:topicRef href="#constraint-role"/></tm:type> - <tm:topicRef href="#scoped-born-in-constraint-1"/> - </tm:role> - <tm:role> - <tm:type><tm:topicRef href="#scopetype-role"/></tm:type> - <tm:topicRef href="#en"/> - </tm:role> - </tm:association> - - <tm:association> - <tm:type><tm:topicRef href="#applies-to"/></tm:type> - <tm:role> - <tm:type><tm:topicRef href="#constraint-role"/></tm:type> - <tm:topicRef href="#scoped-born-in-constraint-1"/> - </tm:role> - <tm:role> - <tm:type><tm:topicRef href="#scopetype-role"/></tm:type> - <tm:topicRef href="#de"/> - </tm:role> - </tm:association> -  - -    @@ -1640,45 +1569,6 @@ </tm:association> -  - <tm:topic id="sub-poem-content"> - <tm:subjectIdentifier href="http://some.where/base-psis/sub-poem-content"/> - </tm:topic> - - <tm:association> - <tm:type><tm:topicRef href="#supertype-subtype"/></tm:type> - <tm:role> - <tm:type><tm:topicRef href="#subtype"/></tm:type> - <tm:topicRef href="#sub-poem-content"/> - </tm:role> - <tm:role> - <tm:type><tm:topicRef href="#supertype"/></tm:type> - <tm:topicRef href="#poem-content"/> - </tm:role> - </tm:association> - - <tm:topic id="sub-poem-content-occurrence-datatype-constraint"> - <tm:subjectIdentifier href="http://some.where/constraint-psis/sub-poem-content-occurrence-datatype-cons…"/> - <tm:instanceOf><tm:topicRef href="#occurrencedatatype-constraint"/></tm:instanceOf> - <tm:occurrence> - <tm:type><tm:topicRef href="#datatype"/></tm:type> - <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#string">http://www.w3.org/2001/XMLSchema#float</tm:resourceData> - </tm:occurrence> - </tm:topic> - - <tm:association> - <tm:type><tm:topicRef href="#applies-to"/></tm:type> - <tm:role> - <tm:type><tm:topicRef href="#constraint-role"/></tm:type> - <tm:topicRef href="#sub-poem-content-occurrence-datatype-constraint"/> - </tm:role> - <tm:role> - <tm:type><tm:topicRef href="#occurrencetype-role"/></tm:type> - <tm:topicRef href="#sub-poem-content"/> - </tm:role> - </tm:association> - -  @@ -2547,7 +2437,7 @@ </tm:name> <tm:occurrence> <tm:type><tm:topicRef href="#poem-content"/></tm:type>  - <tm:scope><tm:topicRef href="#en"/></tm:scope> + <tm:scope><tm:topicRef href="#de"/></tm:scope> <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#string">Hat der alte Hexenmeister sich doch einmal wegbegeben! Und nun sollen seine Geister @@ -2717,7 +2607,6 @@ <tm:association> <tm:itemIdentity href="wirtten-by-zauberlehrling-goethe"/> <tm:type><tm:topicRef href="#written-by"/></tm:type> - <tm:scope><tm:topicRef href="#de"/></tm:scope> <tm:role> <tm:type><tm:topicRef href="#writer"/></tm:type> <tm:topicRef href="#goethe"/> @@ -2731,7 +2620,6 @@ <tm:association> <tm:itemIdentity href="wirtten-by-erlkoenig-goethe"/> <tm:type><tm:topicRef href="#written-by"/></tm:type> - <tm:scope><tm:topicRef href="#de"/></tm:scope> <tm:role> <tm:type><tm:topicRef href="#writer"/></tm:type> <tm:topicRef href="#goethe"/>

1 0

[isidorus-cvs] r88 - trunk/src/ajax/javascripts
by Lukas Giessmann 04 Jul '09

04 Jul '09

Author: lgiessmann Date: Sat Jul 4 11:33:48 2009 New Revision: 88 Log: ajax-client: fixed a bug under safari with the class "SelectrowC" where the default-selected-element wasn't selected. currently there will be additionally set the option selected="selected" to solve this problem Modified: trunk/src/ajax/javascripts/constants.js trunk/src/ajax/javascripts/datamodel.js Modified: trunk/src/ajax/javascripts/constants.js ============================================================================== --- trunk/src/ajax/javascripts/constants.js (original) +++ trunk/src/ajax/javascripts/constants.js Sat Jul 4 11:33:48 2009 @@ -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://192.168.178.21:8000/"; //"http://localhost: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/ajax/javascripts/datamodel.js ============================================================================== --- trunk/src/ajax/javascripts/datamodel.js (original) +++ trunk/src/ajax/javascripts/datamodel.js Sat Jul 4 11:33:48 2009 @@ -158,7 +158,9 @@ this.__content__ = new Element("select"); for(var i = 0; i != contents.length; ++i){ // --- the attribute value must be set for IE - this.__content__.insert({"bottom" : new Element("option", {"value" : contents[i]}).update(contents[i])}); + var opt = new Element("option", {"value" : contents[i]}).update(contents[i]); + this.__content__.insert({"bottom" : opt}); + if(i === 0) opt.writeAttribute({"selected" : "selected"}); } this.__remove__.insert({"after" : this.__content__});

1 0

[isidorus-cvs] r87 - trunk/src/ajax/javascripts
by Lukas Giessmann 04 Jul '09

04 Jul '09

Author: lgiessmann Date: Sat Jul 4 11:11:44 2009 New Revision: 87 Log: ajax-client: fixed a known problem by committing edited fragments - so there won't be requested a topicStub for current fragment's "main"-topic Modified: trunk/src/ajax/javascripts/create.js Modified: trunk/src/ajax/javascripts/create.js ============================================================================== --- trunk/src/ajax/javascripts/create.js (original) +++ trunk/src/ajax/javascripts/create.js Sat Jul 4 11:11:44 2009 @@ -137,7 +137,17 @@ else tPsis = tPsis.toJSON() var referencedTopics = topic.getReferencedTopics(); if(associations){ - referencedTopics = referencedTopics.concat(associations.getReferencedTopics()).without(CURRENT_TOPIC).uniq(); + var ePsis = null; + if(contents && contents.topic && contents.topic.subjectIdentifiers && contents.topic.subjectIdentifiers.length !== 0){ + ePsis = contents.topic.subjectIdentifiers; + } + + var aStubs = associations.getReferencedTopics(); + if(aStubs && aStubs.length !== 0){ + aStubs = aStubs.without(CURRENT_TOPIC).uniq(); + for(var i = 0; i !== ePsis.length; ++i) aStubs = aStubs.without(ePsis[i]); + } + referencedTopics = referencedTopics.concat(aStubs); } function onSuccessHandler(topicStubs){ var tsStr = "null";

1 0

[isidorus-cvs] r86 - trunk/src/ajax/javascripts
by Lukas Giessmann 04 Jul '09

04 Jul '09

Author: lgiessmann Date: Sat Jul 4 10:36:21 2009 New Revision: 86 Log: ajax-client: fixed a problem that occurred with firefox after committing an edit or created fragment by changing the occurrent-type, so the datatyp does'nt changed to the corresponding occurrent-type Modified: trunk/src/ajax/javascripts/constants.js trunk/src/ajax/javascripts/datamodel.js Modified: trunk/src/ajax/javascripts/constants.js ============================================================================== --- trunk/src/ajax/javascripts/constants.js (original) +++ trunk/src/ajax/javascripts/constants.js Sat Jul 4 10:36:21 2009 @@ -11,7 +11,7 @@ // --- Some constants fot the http connections via the XMLHttpRequest-Object -var HOST_PREF = /*"http://143.93.190.237:8000/";*/ "http://localhost:8000/"; // of the form "http://(.+)/" +var HOST_PREF = "http://localhost: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/ajax/javascripts/datamodel.js ============================================================================== --- trunk/src/ajax/javascripts/datamodel.js (original) +++ trunk/src/ajax/javascripts/datamodel.js Sat Jul 4 10:36:21 2009 @@ -1816,7 +1816,17 @@ var cssTitle = "No constraint found for this occurrence"; if(noConstraint === false) cssTitle = "min: " + _min + " max: " + _max + " regular expression: " + constraint.regexp; this.__cssTitle__ = cssTitle; - makeResource(this, contents, constraint, (occurrenceTypes ? occurrenceTypes[0].datatypeConstraint : null), cssTitle, {"rows" : 5, "cols" : 70}); + + var dataType = null; + if(types && types.length !== 0){ + for(var i = 0; occurrenceTypes && i !== occurrenceTypes.length; ++i){ + if(occurrenceTypes[i].occurrenceType.indexOf(types[0]) !== -1){ + dataType = occurrenceTypes[i].datatypeConstraint; + break; + } + } + } + makeResource(this, contents, constraint, dataType, cssTitle, {"rows" : 5, "cols" : 70}); this.getFrame().observe("dblclick", function(event){ dblClickHandler(owner, event); @@ -4056,7 +4066,8 @@ } if(foundIdx !== -1 && constraints[foundIdx].datatypeConstraint){ var dc = constraints[foundIdx].datatypeConstraint; - myself.__datatype__.__frames__[0].getFrame().select("input")[0].writeAttribute({"readonly" : "readonly", "value" : dc}); + myself.__datatype__.__frames__[0].getFrame().select("input")[0].writeAttribute({"readonly" : "readonly"}); + myself.__datatype__.__frames__[0].getFrame().select("input")[0].setValue(dc); } else { myself.__datatype__.__frames__[0].getFrame().select("input")[0].writeAttribute({"value" : ""});

1 0

[isidorus-cvs] r85 - trunk/src/json
by Lukas Giessmann 04 Jul '09

04 Jul '09

Author: lgiessmann Date: Sat Jul 4 06:54:10 2009 New Revision: 85 Log: json-server: fixed a bug with collecting constraint topics for a give topic-type or topic-instance Modified: trunk/src/json/json_tmcl.lisp trunk/src/json/json_tmcl_validation.lisp Modified: trunk/src/json/json_tmcl.lisp ============================================================================== --- trunk/src/json/json_tmcl.lisp (original) +++ trunk/src/json/json_tmcl.lisp Sat Jul 4 06:54:10 2009 @@ -991,8 +991,24 @@ (let ((akos-and-isas-of-this (remove-duplicates (if (eql treat-as 'type) - (topictype-p topic-instance) - (valid-instance-p topic-instance))))) + (progn + (topictype-p topic-instance) + (get-all-upper-constrainted-topics topic-instance)) + (progn + (valid-instance-p topic-instance) + (let ((topictypes + (get-direct-types-of-topic topic-instance)) + (all-constraints nil)) + (dolist (tt topictypes) + (let ((upts + (get-all-upper-constrainted-topics tt))) + (dolist (upt upts) + (pushnew upt all-constraints)))) + (remove-if #'(lambda(x) + (when (eql x topic-instance) + t)) + all-constraints))))))) + (let ((all-abstract-topictype-constraints nil) (all-exclusive-instance-constraints nil) (all-subjectidentifier-constraints nil) @@ -1068,8 +1084,9 @@ (defun get-all-constraint-topics-of-association(associationtype-topic) "Returns all constraint topics defined for associations if the passed associationtype-topic." + (topictype-p associationtype-topic (get-item-by-psi *associationtype-psi*) (is-type-constrained :what *associationtype-constraint-psi*)) (let ((akos-and-isas-of-this - (topictype-p associationtype-topic (get-item-by-psi *associationtype-psi*) (is-type-constrained :what *associationtype-constraint-psi*)))) + (get-all-upper-constrainted-topics associationtype-topic))) (let ((all-associationrole-constraints nil) (all-roleplayer-constraints nil) (all-otherrole-constraints nil)) Modified: trunk/src/json/json_tmcl_validation.lisp ============================================================================== --- trunk/src/json/json_tmcl_validation.lisp (original) +++ trunk/src/json/json_tmcl_validation.lisp Sat Jul 4 06:54:10 2009 @@ -420,4 +420,31 @@ (remove-if #'(lambda(x) (when (eql topictype-constraint x) t)) (get-direct-instances-of-topic topictype-constraint)))))) - ttc)))) \ No newline at end of file + ttc)))) + + +(defun list-all-supertypes (topic-instance &optional (checked-topics nil)) + "Returns all supertypes of the given topic recursively." + (let ((current-checked-topics (append checked-topics (list topic-instance))) + (akos-of-this (get-direct-supertypes-of-topic topic-instance))) + (dolist (ako-of-this akos-of-this) + (when (not (find ako-of-this current-checked-topics)) + (let ((new-checked-topics + (list-all-supertypes ako-of-this current-checked-topics))) + (dolist (new-topic new-checked-topics) + (pushnew new-topic current-checked-topics))))) + current-checked-topics)) + + +(defun get-all-upper-constrainted-topics (topic) + "Returns all topics that are supertypes or direct types + of the given topic-type. So all direct constraints of the found + topics are valid constraints for the given one." + ;; find all direct types + (let ((direct-isas-of-this + (get-direct-types-of-topic topic))) + + ;; find all supertypes (recursive -> transitive relationship + (let ((all-akos-of-this + (list-all-supertypes topic))) + (remove-duplicates (union direct-isas-of-this all-akos-of-this))))) \ No newline at end of file

1 0