source: branches/gdl-frontend/src/json/isidorus-json/json_importer.lisp

Last change on this file was 470, checked in by lgiessmann, 14 years ago

fixed ticket #111 and adapted all unit-tests
File size: 24.2 KB
Line 
1;;+-----------------------------------------------------------------------------
2;;+  Isidorus
3;;+  (c) 2008-2010 Marc Kuester, Christoph Ludwig, Lukas Georgieff
4;;+
5;;+  Isidorus is freely distributable under the LLGPL license.
6;;+  You can find a detailed description in trunk/docs/LLGPL-LICENSE.txt and
7;;+  trunk/docs/LGPL-LICENSE.txt.
8;;+-----------------------------------------------------------------------------
9
10(defpackage :json-importer
11  (:use :cl :json :datamodel :xtm-importer :constants)
12  (:export :import-from-isidorus-json
13           :*json-xtm*))
14
15(in-package :json-importer)
16
17;; the json schema for our datamodel is in "docs/xtm_json.txt"
18
19
20(defvar *json-xtm* "json-xtm"); Represents the currently active TM of the JSON-Importer
21
22
23(defun import-from-isidorus-json(json-string &key (xtm-id *json-xtm*))
24  "creates all objects (topics, topic stubs, associations)
25   of the passed json-decoded-list (=fragment)"
26  (declare (type (or string null) json-string xtm-id))
27  (when json-string
28    (let ((fragment-values
29           (get-fragment-values-from-json-list
30            (json:decode-json-from-string json-string))))
31      (let ((topic-values (getf fragment-values :topic))
32            (topicStubs-values (getf fragment-values :topicStubs))
33            (associations-values (getf fragment-values :associations))
34            (rev (get-revision)) ; creates a new revision, equal for all elements of the passed fragment
35            (tm-ids (getf fragment-values :tm-ids)))
36        (unless tm-ids
37          (error "From import-from-isidorus-json(): tm-ids must be set"))
38        (let ((psi-of-topic
39               (let ((psi-uris (getf topic-values :subjectIdentifiers)))
40                 (when psi-uris
41                   (first psi-uris)))))
42          (elephant:ensure-transaction (:txn-nosync nil) 
43            (xtm-importer:with-tm (rev xtm-id (first tm-ids))
44              (loop for topicStub-values in
45                   (append topicStubs-values (list topic-values))
46                 do (json-to-stub topicStub-values rev :tm xtm-importer::tm
47                                  :xtm-id xtm-id))
48              (json-merge-topic topic-values rev :tm xtm-importer::tm :xtm-id xtm-id)
49              (loop for association-values in associations-values
50                 do (json-to-association association-values rev
51                                         :tm xtm-importer::tm))))
52          (when psi-of-topic
53            (create-latest-fragment-of-topic psi-of-topic)))))))
54
55
56(defun json-to-association (json-decoded-list start-revision
57                            &key tm)
58  "creates an association element of the passed json-decoded-list"
59  (elephant:ensure-transaction (:txn-nosync t) 
60    (let 
61        ((item-identifiers 
62          (map 'list #'(lambda(uri)
63                         (make-identifier 'ItemIdentifierC uri start-revision))
64               (getf json-decoded-list :itemIdentities)))
65         (instance-of
66          (psis-to-topic (getf json-decoded-list :type) :revision start-revision))
67         (themes
68          (json-to-scope (getf json-decoded-list :scopes) start-revision))
69         (roles 
70          (map 'list #'(lambda(role-values)
71                         (json-to-role role-values start-revision))
72               (getf json-decoded-list :roles))))
73      (declare (list json-decoded-list))
74      (declare (integer start-revision))
75      (declare (TopicMapC tm))
76      (setf roles (xtm-importer::set-standard-role-types roles start-revision))
77      (add-to-tm tm 
78                 (make-construct 'AssociationC
79                                 :start-revision start-revision
80                                 :item-identifiers item-identifiers
81                                 :instance-of instance-of
82                                 :themes themes
83                                 :roles roles)))))
84   
85
86(defun json-to-role (json-decoded-list start-revision)
87  "creates a role element"
88  (when json-decoded-list
89  (elephant:ensure-transaction (:txn-nosync t) 
90    (let
91        ((item-identifiers
92          (map 'list #'(lambda(uri)
93                         (make-identifier 'ItemIdentifierC uri start-revision))
94               (getf json-decoded-list :itemIdentities)))
95         (instance-of
96          (psis-to-topic (getf json-decoded-list :type) :revision start-revision))
97         (player
98          (psis-to-topic (getf json-decoded-list :topicRef)
99                         :revision start-revision)))
100      (declare (list json-decoded-list))
101      (declare (integer start-revision))
102      (unless player
103        (error "Role in association with topicref ~a not complete"
104               (getf json-decoded-list :topicRef)))
105      (list :instance-of instance-of
106            :player player
107            :item-identifiers item-identifiers
108            :start-revision start-revision)))))
109
110
111(defun json-merge-topic (json-decoded-list start-revision
112                         &key tm (xtm-id *json-xtm*))
113  "merges the a topic by setting the name, occurrence and instanceOf
114   elements from the json-decoded-list"
115  (when json-decoded-list
116    (elephant:ensure-transaction (:txn-nosync t) 
117      (let ((top
118             (d:get-item-by-id
119              (getf json-decoded-list :id)
120              :revision start-revision
121              :xtm-id xtm-id)))
122        (declare (list json-decoded-list))
123        (declare (integer start-revision))
124        (declare (TopicMapC tm))
125        (unless top
126          (error "topic ~a could not be found" (getf json-decoded-list :id)))
127        (let ((instanceof-topics
128               (remove-duplicates
129                (map 'list
130                     #'(lambda(psis)
131                         (psis-to-topic psis :revision start-revision))
132                     (getf json-decoded-list :instanceOfs)))))
133
134          (loop for name-values in (getf json-decoded-list :names)
135             do (json-to-name name-values top start-revision))
136          (loop for occurrence-values in (getf json-decoded-list :occurrences)
137             do (json-to-occurrence occurrence-values top start-revision))
138          (dolist (instanceOf-top instanceof-topics)
139            (json-create-instanceOf-association instanceOf-top top start-revision
140                                                :tm tm))
141          top)))))
142
143
144(defun json-to-stub(json-decoded-list start-revision &key tm (xtm-id *json-xtm*))
145  "creates a topic stub from the passed json-decoded list"
146  (when json-decoded-list
147    (elephant:ensure-transaction (:txn-nosync t) 
148      (let ((item-identifiers
149             (map 'list #'(lambda(uri)
150                            (make-identifier 'ItemIdentifierC uri start-revision))
151                  (getf json-decoded-list :itemIdentities)))
152            (subject-identifiers
153             (map 'list #'(lambda(uri)
154                            (make-identifier 'PersistentIdC uri start-revision))
155                  (getf json-decoded-list :subjectIdentifiers)))
156            (subject-locators
157             (map 'list #'(lambda(uri)
158                            (make-identifier 'SubjectLocatorC uri start-revision))
159                  (getf json-decoded-list :subjectLocators)))
160            (topic-ids
161             (when (getf json-decoded-list :id)
162               (list
163                (make-construct 'TopicIdentificationC
164                                :uri (getf json-decoded-list :id)
165                                :xtm-id xtm-id)))))
166        ;; all topic stubs has to be added top a topicmap object in this method
167        ;; becuase the only one topic that is handled in "json-merge-topic"
168        ;; is the main topic of the fragment
169        (let ((top
170               (make-construct 'TopicC :start-revision start-revision
171                                       :item-identifiers item-identifiers
172                                       :locators subject-locators
173                                       :psis subject-identifiers
174                                       :topic-identifiers topic-ids)))
175          (add-to-tm tm top)
176          top)))))
177       
178
179(defun json-to-occurrence (json-decoded-list top start-revision)
180  "Creates an occurrence element"
181  (when json-decoded-list
182    (let
183      ((themes
184        (json-to-scope (getf json-decoded-list :scopes) start-revision))
185       (item-identifiers
186        (map 'list #'(lambda(uri)
187                       (make-identifier 'ItemIdentifierC uri start-revision))
188             (getf json-decoded-list :itemIdentities)))
189       (instance-of 
190        (psis-to-topic (getf json-decoded-list :type) :revision start-revision))
191       (occurrence-value
192        (json-to-resourceX json-decoded-list)))
193     
194      (unless occurrence-value
195        (error "OccurrenceC: one of resourceRef and resourceData must be set"))
196      (make-construct 'OccurrenceC 
197                      :start-revision start-revision
198                      :parent top
199                      :themes themes
200                      :item-identifiers item-identifiers
201                      :instance-of instance-of
202                      :charvalue (getf occurrence-value :data)
203                      :datatype (getf occurrence-value :type)))))
204
205
206(defun make-identifier (classsymbol uri start-revision)
207  "creates an instance of a PersistentIdc, SubjectlocatorC or
208   ItemIdentifierC"
209  (declare (symbol classsymbol))
210  (declare (string uri))
211  (declare (integer start-revision))
212  (make-construct classsymbol
213                  :uri uri
214                  :start-revision start-revision))
215
216
217(defun json-to-scope (json-decoded-list start-revision)
218  "Generate set of themes (= topics) from this scope element and
219   return that set. If the input is nil, the list of themes is empty"
220  (when json-decoded-list
221    (let ((tops
222           (map 'list #'(lambda(psis)
223                          (psis-to-topic psis :revision start-revision))
224                json-decoded-list)))
225      (declare (list json-decoded-list))
226      (unless (>= (length tops) 1)
227        (error "need at least one topic in a scope"))
228      tops)))
229
230
231(defun psis-to-topic(psis &key (revision *TM-REVISION*))
232  "searches for a topic of the passed psis-list describing
233   exactly one topic"
234  (declare (list psis)
235           (type (or integer null) revision))
236  (when psis
237    (let ((top
238           (let ((psi
239                  (loop for uri in psis
240                     when (elephant:get-instance-by-value
241                           'd:PersistentIdC 'd:uri uri)
242                     return (elephant:get-instance-by-value
243                             'd:PersistentIdC 'd:uri uri))))
244             (when psi
245               (d:identified-construct psi :revision revision)))))
246      (unless top
247        (error (make-condition 'missing-reference-error
248                               :message (format nil "psis-to-topic: could not resolve reference ~a" psis))))
249      top)))
250
251
252(defun json-to-name (json-decoded-list top start-revision)
253  "creates a name element (NameC) of the passed json-decoded-list"
254  (when json-decoded-list
255    (let ((item-identifiers
256           (map 'list #'(lambda(uri)
257                          (make-identifier 'ItemIdentifierC uri start-revision))
258                (getf json-decoded-list :itemIdentities)))
259          (namevalue (getf json-decoded-list :value))
260          (themes
261           (json-to-scope (getf json-decoded-list :scopes) start-revision))
262          (instance-of
263           (psis-to-topic (getf json-decoded-list :type) :revision start-revision)))
264      (unless namevalue
265        (error "A name must have exactly one namevalue"))
266      (let ((name (make-construct
267                   'NameC 
268                   :start-revision start-revision
269                   :parent top
270                   :charvalue namevalue
271                   :instance-of (if instance-of
272                                    instance-of
273                                    (get-item-by-psi *topic-name-psi*
274                                                     :revision start-revision
275                                                     :error-if-nil t))
276                   :item-identifiers item-identifiers
277                   :themes themes)))
278        (loop for variant in (getf json-decoded-list :variants)
279           do (json-to-variant variant name start-revision))
280        name))))
281
282
283(defun json-to-variant(json-decoded-list name start-revision)
284  "creates a variant element (VariantC) of the passed json-decoded-list"
285  (when json-decoded-list
286    (let ((item-identifiers
287           (map 'list #'(lambda(uri)
288                          (make-identifier 'ItemIdentifierC uri start-revision))
289                (getf json-decoded-list :itemIdentities)))
290          (themes
291           (remove-duplicates
292            (append (d:themes name :revision start-revision)
293                    (json-to-scope (getf json-decoded-list :scopes)
294                                   start-revision))))
295          (variant-value
296           (json-to-resourceX json-decoded-list)))
297      (declare (list json-decoded-list))
298      (make-construct 'VariantC
299                      :start-revision start-revision
300                      :item-identifiers item-identifiers
301                      :themes themes
302                      :charvalue (getf variant-value :data)
303                      :datatype (getf variant-value :type)
304                      :parent name))))
305
306
307(defun json-to-resourceX(json-decoded-list)
308  "creates a resourceRef or resourceData element"
309  (when json-decoded-list
310    (let ((resourceRef
311           (getf json-decoded-list :resourceRef))
312          (resourceData
313           (getf json-decoded-list :resourceData)))
314      (declare (list json-decoded-list))
315      (let ((value
316             (if resourceRef
317                 (list :data resourceRef
318                       :type "http://www.w3.org/2001/XMLSchema#anyURI")
319                 (list :data (getf resourceData :value)
320                       :type (if (getf resourceData :datatype)
321                                 (getf resourceData :datatype)
322                                 "http://www.w3.org/2001/XMLSchema#string")))))
323        (unless (getf value :data)
324          (error "json-to-resourceX: one of resourceRef or resourceData must be set"))
325        value))))
326
327
328(defun json-create-instanceOf-association (supertype player2-obj start-revision 
329                                      &key tm)
330  "handle the instanceOf element. The instanceOf element is different
331  from all the others in that it is not modelled one to one, but
332  following the suggestion of the XTM 2.0 spec (4.9) and the
333  TMDM (7.2) as an association"
334  (declare (TopicC supertype player2-obj)
335           (TopicMapC tm))
336  (let
337      ((associationtype 
338        (get-item-by-psi constants:*type-instance-psi* :revision start-revision))
339       (roletype1
340        (get-item-by-psi constants:*type-psi* :revision start-revision))
341       (roletype2
342        (get-item-by-psi constants:*instance-psi* :revision start-revision))
343       (player1 supertype))
344    (unless (and associationtype roletype1 roletype2)
345      (error "Error in the creation of an instanceof association: core topics are missing"))
346    (add-to-tm tm associationtype)
347    (add-to-tm tm roletype1)
348    (add-to-tm tm roletype2)
349    (add-to-tm 
350     tm
351     (make-construct 
352      'AssociationC
353      :item-identifiers nil
354      :themes nil
355      :start-revision start-revision
356      :instance-of associationtype
357      :roles (list (list :instance-of roletype1
358                         :player player1
359                         :start-revision start-revision)
360                   (list :instance-of roletype2
361                         :player player2-obj
362                         :start-revision start-revision))))))
363
364
365(defun get-fragment-values-from-json-list(json-decoded-list)
366  "returns all fragment values of the passed json-decoded-list
367   as a named list"
368  (when json-decoded-list
369    (let ((topic nil)
370          (topicStubs nil)
371          (associations nil)
372          (tm-ids nil))
373      (declare (list json-decoded-list))
374      (loop for j-elem in json-decoded-list
375         do (cond
376              ((string= (car j-elem) :topic)
377               (setf topic (cdr j-elem)))
378              ((string= (car j-elem) :topic-Stubs)
379               (setf topicStubs (cdr j-elem)))
380              ((string= (car j-elem) :associations)
381               (setf associations (cdr j-elem)))
382              ((string= (car j-elem) :tm-Ids)
383               (setf tm-ids (cdr j-elem)))
384              (t
385               (error "json-importer:get-fragment-values-from-json-string:
386                       bad item-specifier found in json-list"))))
387      (unless topic
388        (error "json-importer:get-fragment-values-from-json-string: the element topic must be set"))
389      (unless (= (length tm-ids) 1)
390        (error "There must be given exactly one tm-id in the tm-ids list"))
391      (let ((topic-list (get-topic-values-from-json-list topic))
392            (topicStubs-list (map 'list #'get-topicStub-values-from-json-list topicStubs))
393            (associations-list (map 'list #'get-association-values-from-json-list associations)))
394        (list :topic topic-list
395              :topicStubs topicStubs-list
396              :associations associations-list
397              :tm-ids tm-ids)))))
398
399
400(defun get-topicStub-values-from-json-list (json-decoded-list)
401  "returns all topicStub values of the passed json-decoded-list
402   as a named list"
403  (when json-decoded-list
404    (let ((id nil)
405          (itemIdentities nil)
406          (subjectLocators nil)
407          (subjectIdentifiers nil))
408      (declare (list json-decoded-list))
409      (loop for j-elem in json-decoded-list
410         do (cond
411              ((string= (car j-elem) :ID)
412               (setf id (cdr j-elem)))
413              ((string= (car j-elem) :item-Identities)
414               (setf itemIdentities (cdr j-elem)))
415              ((string= (car j-elem) :subject-Locators)
416               (setf subjectLocators (cdr j-elem)))
417              ((string= (car j-elem) :subject-Identifiers)
418               (setf subjectIdentifiers (cdr j-elem)))
419              (t
420               (error "json-importer:get-topicStub-values-from-json-string:
421                       bad item-specifier found in json-list"))))
422       (unless subjectIdentifiers
423        (error "json-importer:get-topicStub-values-from-json-string: the element subjectIdentifiers mus be set!"))
424      (unless id
425        (error "json-importer:get-topic-valuesStub-from-json-string: the element id must be set"))
426      (list :id id
427            :itemIdentities itemIdentities
428            :subjectLocators subjectLocators
429            :subjectIdentifiers subjectIdentifiers))))
430     
431
432(defun get-topic-values-from-json-list (json-decoded-list)
433  "extracts all values of the passed json-list and
434   returns them as a named list"
435  (when json-decoded-list
436    (let ((id nil)
437          (itemIdentities nil)
438          (subjectLocators nil)
439          (subjectIdentifiers nil)
440          (instanceOfs nil)
441          (names nil)
442          (occurrences nil))
443      (declare (list json-decoded-list))
444      (loop for j-elem in json-decoded-list
445         do (cond
446              ((string= (car j-elem) :ID)
447               (setf id (cdr j-elem)))
448              ((string= (car j-elem) :item-Identities) ;json-decoder transforms camelcase to '-' from
449               (setf itemIdentities (cdr j-elem)))
450              ((string= (car j-elem) :subject-Locators)
451               (setf subjectLocators (cdr j-elem)))
452              ((string= (car j-elem) :subject-Identifiers)
453               (setf subjectIdentifiers (cdr j-elem)))
454              ((string= (car j-elem) :instance-Ofs)
455               (setf instanceOfs (cdr j-elem)))
456              ((string= (car j-elem) :names)
457               (setf names (cdr j-elem)))
458              ((string= (car j-elem) :occurrences)
459               (setf occurrences (cdr j-elem)))
460              (t
461               (error "json-importer:get-topic-values-from-json-string:
462                       bad item-specifier found in json-list ~a" (car j-elem)))))
463      (unless subjectIdentifiers
464        (error "json-importer:get-topic-values-from-json-string: the element subjectIdentifiers must be set!"))
465      (unless id
466        (error "json-importer:get-topic-values-from-json-string: the element id must be set"))
467      (let ((names-list (map 'list #'get-name-values-from-json-list names))
468            (occurrences-list (map 'list #'get-occurrence-values-from-json-list occurrences)))
469        (list :id id
470              :itemIdentities itemIdentities
471              :subjectLocators subjectLocators
472              :subjectIdentifiers subjectIdentifiers
473              :instanceOfs instanceOfs
474              :names names-list
475              :occurrences occurrences-list)))))
476
477
478(defun get-name-values-from-json-list (json-decoded-list)
479  "returns all element values of a name element as
480   a named list"
481  (when json-decoded-list
482    (let ((itemIdentities nil)
483          (type nil)
484          (scopes nil)
485          (value nil)
486          (variants nil))
487      (declare (list json-decoded-list))
488      (loop for j-elem in json-decoded-list
489         do (cond
490              ((string= (car j-elem) :item-Identities)
491               (setf itemIdentities (cdr j-elem)))
492              ((string= (car j-elem) :type)
493               (setf type (cdr j-elem)))
494              ((string= (car j-elem) :scopes)
495               (setf scopes (cdr j-elem)))
496              ((string= (car j-elem) :value)
497               (setf value (cdr j-elem)))
498              ((string= (car j-elem) :variants)
499               (setf variants (cdr j-elem)))
500              (t
501               (error "json-importer:get-name-values-from-json-list:
502                       bad item-specifier found in json-list"))))
503      (unless value
504        (error "json-importer:get-name-values-from-json-list: value must be set"))
505      (let ((variants-list (map 'list #'get-variant-values-from-json-list variants)))
506        (list :itemIdentities itemIdentities
507              :type type
508              :scopes scopes
509              :value value
510              :variants variants-list)))))
511           
512
513(defun get-variant-values-from-json-list (json-decoded-list)
514  "returns all element values of a variant element as
515   a named list"
516  (when json-decoded-list
517    (let ((itemIdentities nil)
518          (scopes nil)
519          (resourceRef nil)
520          (resourceData nil))
521      (declare (list json-decoded-list))
522      (loop for j-elem in json-decoded-list
523         do (cond
524              ((string= (car j-elem) :item-Identities)
525               (setf itemIdentities (cdr j-elem)))
526              ((string= (car j-elem) :scopes)
527               (setf scopes (cdr j-elem)))
528              ((string= (car j-elem) :resource-Ref)
529               (setf resourceRef (cdr j-elem)))
530              ((string= (car j-elem) :resource-Data)
531               (setf resourceData (cdr j-elem)))
532              (t
533               (error "json-importer:get-variant-values-from-json-list:
534                       bad item-specifier found in json-list"))))
535      (when (or (and (not resourceRef)
536                     (not resourceData))
537                (and resourceRef resourceData))
538        (error "json-importer:get-variant-values-from-json-list: ONE of the elements
539                  resourceRef or resourceData must be set"))
540      (let ((resourceData-list (get-resourceData-values-from-json-list resourceData)))
541        (list :itemIdentities itemIdentities 
542              :scopes scopes
543              :resourceRef resourceRef
544              :resourceData resourceData-list)))))
545 
546
547(defun get-resourceData-values-from-json-list (json-decoded-list)
548  "returns the resourceData value and the datatype value, if there
549   is no datatype given, there will be set the standard type string"
550  (when json-decoded-list
551    (let ((value nil)
552          (datatype nil))
553      (declare (list json-decoded-list))
554      (loop for j-elem in json-decoded-list
555         do (cond
556              ((string= (car j-elem) :value)
557               (setf value (cdr j-elem)))
558              ((string= (car j-elem) :datatype)
559               (setf datatype (cdr j-elem)))
560              (t
561               (error "json-importer:get-resourceData-values-from-json-list:
562                       bad item-specifier found in json-list"))))
563      (unless value
564        (error "json-importer:get-resourceData-values-from-json-list: resourceData must have a value"))
565      (list :value value
566            :datatype (if datatype datatype "http://www.w3.org/2001/XMLSchema#string")))))
567
568
569(defun get-occurrence-values-from-json-list (json-decoded-list)
570  "returns all occurrence values of the passed json-list as
571   a named list"
572  (when json-decoded-list
573    (let ((itemIdentities nil)
574          (type nil)
575          (scopes nil)
576          (resourceRef nil)
577          (resourceData nil))
578      (declare (list json-decoded-list))
579      (loop for j-elem in json-decoded-list
580         do (cond
581              ((string= (car j-elem) :item-Identities)
582               (setf itemIdentities (cdr j-elem)))
583              ((string= (car j-elem) :type)
584               (setf type (cdr j-elem)))
585              ((string= (car j-elem) :scopes)
586               (setf scopes (cdr j-elem)))
587              ((string= (car j-elem) :resource-Ref)
588               (setf resourceRef (cdr j-elem)))
589              ((string= (car j-elem) :resource-Data)
590               (setf resourceData (cdr j-elem)))
591              (t
592               (error "json-importer:get-occurrence-values-from-json-list:
593                       bad item-specifier found in json-list"))))
594      (when (or (and (not resourceRef)
595                     (not resourceData))
596                (and resourceRef resourceData))
597        (error "json-importer:get-occurrence-values-from-json-list: ONE of the elements
598                  resourceRef or resourceData must be set"))
599      (unless type
600        (error "json-importer:get-occurrence-values-from-json-list: type must be set"))
601      (let ((resourceData-list (get-resourceData-values-from-json-list resourceData)))
602        (list :itemIdentities itemIdentities
603              :type type
604              :scopes scopes
605              :resourceRef resourceRef
606              :resourceData resourceData-list)))))
607
608
609(defun get-association-values-from-json-list (json-decoded-list)
610  "extracts all values of the passed json-list and
611   returns them as a named list"
612  (when json-decoded-list
613    (let ((itemIdentities nil)
614          (type nil)
615          (scopes nil)
616          (roles nil))
617      (declare (list json-decoded-list))
618      (loop for j-elem in json-decoded-list
619         do (cond
620              ((string= (car j-elem) :item-Identities)
621               (setf itemIdentities (cdr j-elem)))
622              ((string= (car j-elem) :type)
623               (setf type (cdr j-elem)))
624              ((string= (car j-elem) :scopes)
625               (setf scopes (cdr j-elem)))
626              ((string= (car j-elem) :roles)
627               (setf roles (cdr j-elem)))
628              (t
629               (error "json-importer:get-association-values-from-json-list:
630                       bad item-specifier found in json-list"))))
631      (unless (and type roles)
632        (error "json-importer:get-occurrence-values-from-json-list: type and role must be set"))
633      (let ((roles-list (map 'list #'get-role-values-from-json-list roles)))
634        (list :itemIdentities itemIdentities
635              :type type
636              :scopes scopes
637              :roles roles-list)))))
638 
639
640(defun get-role-values-from-json-list (json-decoded-list)
641  "extracts all values of the passed json-list and
642   returns them as a named list"
643  (when json-decoded-list
644    (let ((itemIdentities nil)
645          (type nil)
646          (topicRef nil))
647      (declare (list json-decoded-list))
648      (loop for j-elem in json-decoded-list
649         do (cond
650              ((string= (car j-elem) :item-Identities)
651               (setf itemIdentities (cdr j-elem)))
652              ((string= (car j-elem) :type)
653               (setf type (cdr j-elem)))
654              ((string= (car j-elem) :topic-Ref)
655               (setf topicRef (cdr j-elem)))
656              (t
657               (error "json-importer:get-role-values-from-json-list:
658                       bad item-specifier found in json-list"))))
659      (unless (and type topicRef)
660        (error "json-importer:get-occurrence-values-from-json-list: type and topicRef must be set"))
661      (list :itemIdentities itemIdentities
662            :type type
663            :topicRef topicRef))))
664
665
Note: See TracBrowser for help on using the repository browser.