Context Navigation

← Previous Revision
Next Revision →
Blame
Revision Log

jtm_exporter.lisp

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

xtm-im/exporter | rdf-im/exporter | jtm-im/exporter | isidorus-json-im/exporter: if an untyped name is imported the default-name-type defined by TMDM 7.5 is set. This topic is contained in the file core_psis.xtm and is only imported in the topic map that is created by init-isidorus, i.e. the topic is not added to topics where it is used as name-type. When a name is exported that is typed by the defualt-name-type, the name-type is ignored and the name is exported as untyped name

File size: 25.0 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
11	(in-package :jtm)
12
13
14	(defgeneric export-to-jtm (construct &key item-type-p parent-p prefixes
15	prefixes-p revision &allow-other-keys)
16	(:documentation "Exports the given construct in JTM notation.
17	If item-type-p is t the corresponding item-type
18	will be also set. If parent-p is t the corresponding
19	parent of the given construct is also set.
20	prefixes is a plist of the form ((:pref pref :value <value>) ...),
21	whereas pref is used as prefix identifier and value is
22	used as actual value. If prefix-p is set to t the member
23	prefixes will be set to the corresponding values in prefixes.
24	If prefixes is set these prefixes are used for the given
25	construct and all its sub-constructs."))
26
27
28	(defmethod export-to-jtm ((construct TopicC) &key (item-type-p t)
29	(parent-p nil) prefixes prefixes-p
30	(revision TM-REVISION) (instance-of-p t))
31	"Exports a topic as JTM string."
32	(declare (Boolean item-type-p parent-p prefixes-p)
33	(List prefixes)
34	(Integer revision))
35	(unless (get-all-identifiers-of-construct construct :revision revision)
36	(error (make-condition 'JTM-error :message (format nil "The topic ~a has no identifiers" construct))))
37	(let ((prefix-value (when prefixes-p
38	(concat "\"prefixes\":"
39	(export-prefix-list-to-jtm prefixes) ",")))
40	(top-psis
41	(concat "\"subject_identifiers\":"
42	(export-identifiers-to-jtm
43	construct :identifier-type 'PersistentIdC :prefixes prefixes
44	:revision revision) ","))
45	(top-sls
46	(concat "\"subject_locators\":"
47	(export-identifiers-to-jtm
48	construct :identifier-type 'SubjectLocatorC :prefixes prefixes
49	:revision revision) ","))
50	(top-iis
51	(concat "\"item_identifiers\":"
52	(export-identifiers-to-jtm
53	construct :identifier-type 'ItemIdentifierC :prefixes prefixes
54	:revision revision) ","))
55	(instance-ofs
56	(when instance-of-p
57	(concat "\"instance_of\":"
58	(export-instance-ofs-to-jtm construct :prefixes prefixes
59	:revision revision) ",")))
60	(item-type (when item-type-p
61	(concat "\"item_type\":\"" item_type-topic "\",")))
62	(top-parent
63	(when parent-p
64	(concat "\"parent\":"
65	(export-parent-references-to-jtm construct :prefixes prefixes
66	:revision revision) ",")))
67	(top-names
68	(concat "\"names\":"
69	(export-names-to-jtm
70	construct :item-type-p nil :prefixes prefixes
71	:prefixes-p nil :revision revision) ","))
72	(top-occs
73	(concat "\"occurrences\":"
74	(export-occurrences-to-jtm
75	construct :item-type-p nil :prefixes prefixes
76	:prefixes-p nil :revision revision))))
77	(concat "{" prefix-value top-psis top-sls top-iis instance-ofs item-type
78	top-parent top-names top-occs "}")))
79
80
81	(defmethod export-to-jtm ((construct IdentifierC) &key item-type-p parent-p
82	prefixes prefixes-p (revision TM-REVISION))
83	"Exports any given object of the type IdentifierC"
84	(declare (Ignorable item-type-p parent-p revision prefixes-p)
85	(List prefixes))
86	(json:encode-json-to-string (identifier-to-curie construct :prefixes prefixes)))
87
88
89	(defgeneric identifier-to-curie (construct &key prefixes)
90	(:documentation "Returns a string of the form [pref:identifier-suffix].
91	If prefixes is empty the return value is the uri-string
92	of the passed identifier.")
93	(:method ((construct IdentifierC) &key prefixes)
94	(declare (List prefixes))
95	(let ((possible-prefix
96	(when prefixes
97	(loop for item in prefixes
98	when (and (string-starts-with (uri construct) (getf item :value))
99	(> (length (uri construct)) (length (getf item :value))))
100	return item))))
101	(if possible-prefix
102	(concat "[" (getf possible-prefix :pref) ":"
103	(subseq (uri construct) (length (getf possible-prefix :value)))
104	"]")
105	(uri construct)))))
106
107
108	(defgeneric export-identifiers-to-jtm (construct &key identifier-type prefixes
109	revision)
110	(:documentation "Exports all identifiers of the given construct and type
111	given by identifier-type as JTM-array.")
112	(:method ((construct ReifiableConstructC) &key (identifier-type 'ItemIdentifierC)
113	prefixes (revision TM-REVISION))
114	(declare (Symbol identifier-type)
115	(List prefixes)
116	(Integer revision))
117	(let ((ids
118	(funcall (cond ((eql identifier-type 'PersistentIdC)
119	#'psis)
120	((eql identifier-type 'SubjectLocatorC)
121	#'locators)
122	((eql identifier-type 'ItemIdentifierC)
123	#'item-identifiers)
124	(t
125	(error (make-condition 'JTM-error
126	:message (format nil "From export-identifiers-to-jtm(): identifier type must be one of 'PersistentIdC, 'ItemIdentifierC, or 'SubjectLocatorC, but is: ~a" identifier-type)))))
127	construct :revision revision)))
128	(if ids
129	(let ((values "["))
130	(loop for id in ids
131	do (push-string
132	(concat (export-to-jtm id :prefixes prefixes)
133	",") values))
134	(concat (subseq values 0 (1- (length values))) "]"))
135	"null"))))
136
137
138	(defmethod export-to-jtm ((construct NameC) &key (item-type-p t) parent-p
139	prefixes prefixes-p (revision TM-REVISION))
140	"Exports any given object bof the type NameC"
141	(declare (Boolean item-type-p parent-p prefixes-p)
142	(List prefixes)
143	(Integer revision))
144	(let ((prefix-value (when prefixes-p
145	(concat "\"prefixes\":"
146	(export-prefix-list-to-jtm prefixes) "," )))
147	(iis (concat "\"item_identifiers\":"
148	(export-identifiers-to-jtm
149	construct :prefixes prefixes :revision revision) ","))
150	(value (concat "\"value\":"
151	(json:encode-json-to-string (charvalue construct)) ","))
152	(type
153	(concat "\"type\":"
154	(if (eql (instance-of construct :revision revision)
155	(get-item-by-psi topic-name-psi))
156	"null"
157	(export-type-to-jtm construct :prefixes prefixes
158	:error-if-nil nil :revision revision))
159	","))
160	(item-type (when item-type-p
161	(concat "\"item_type\":\"" item_type-name "\",")))
162	(name-parent
163	(when parent-p
164	(concat "\"parent\":"
165	(export-parent-references-to-jtm construct :prefixes prefixes
166	:revision revision) ",")))
167	(scopes (concat "\"scope\":"
168	(export-scopes-to-jtm
169	construct :prefixes prefixes :revision revision) ","))
170	(vars (concat "\"variants\":"
171	(export-variants-to-jtm
172	construct :item-type-p nil :prefixes prefixes
173	:prefixes-p nil :revision revision) ","))
174	(name-reifier (concat "\"reifier\":"
175	(export-reifier-to-jtm construct :prefixes prefixes
176	:revision revision))))
177	(concat "{" prefix-value iis value type item-type name-parent scopes vars
178	name-reifier "}")))
179
180
181	(defgeneric export-reifier-to-jtm (construct &key prefixes revision)
182	(:documentation "Returns a topic reference that represents the construct's
183	reifier-topic.")
184	(:method ((construct ReifiableConstructC) &key prefixes
185	(revision TM-REVISION))
186	(declare (List prefixes)
187	(Integer revision))
188	(if (reifier construct :revision revision)
189	(export-topic-reference-to-jtm
190	(reifier construct :revision revision) :prefixes prefixes
191	:revision revision)
192	"null")))
193
194
195	(defgeneric export-scopes-to-jtm (construct &key prefixes revision)
196	(:documentation "Exports all topics within the scope of the passed construct.
197	The result value is a JSON array of topic references.")
198	(:method ((construct ScopableC) &key prefixes (revision TM-REVISION))
199	(declare (List prefixes)
200	(Integer revision))
201	(let ((scope-tops
202	(if (and (typep construct 'VariantC)
203	(parent construct :revision revision))
204	(set-difference (themes construct :revision revision)
205	(themes (parent construct :revision revision)
206	:revision revision))
207	(themes construct :revision revision))))
208	(if scope-tops
209	(let ((result "["))
210	(loop for top in scope-tops
211	do (push-string
212	(concat (export-topic-reference-to-jtm top :prefixes prefixes
213	:revision revision) ",")
214	result))
215	(concat (subseq result 0 (1- (length result))) "]"))
216	"null"))))
217
218
219	(defgeneric export-type-to-jtm (construct &key prefixes error-if-nil revision)
220	(:documentation "Returns a string of the type \"type\":<type-uri>. If
221	error-if-nil is set to t and the given construct has no
222	name, a JTM-error is thrown.")
223	(:method ((construct TypableC) &key prefixes (error-if-nil t)
224	(revision TM-REVISION))
225	(declare (List prefixes)
226	(Boolean error-if-nil)
227	(Integer revision))
228	(let ((type (instance-of construct :revision revision)))
229	(when (and error-if-nil (not type))
230	(error (make-condition 'JTM-error :message (format nil "From export-type-to-jtm(): the construct ~a is not bound to a type" construct))))
231	(if type
232	(export-topic-reference-to-jtm type :prefixes prefixes :revision revision)
233	"null"))))
234
235
236	(defgeneric export-topic-reference-to-jtm (construct &key prefixes revision)
237	(:documentation "Returns an identifier that is the reference of the given
238	topic. If the topic owns at least one psi the return value
239	is si:psi-value. If the topic owns no psi but at least one
240	subject-locator the return value is sl:sl-value. If the
241	topic owns no psi and no subject-locator but at least one
242	item-identifier the return value is ii:ii-value. If the
243	topic does not have any identifiers a JTM-error is thrown.")
244	(:method ((construct TopicC) &key prefixes(revision TM-REVISION))
245	(declare (List prefixes)
246	(Integer revision))
247	(let ((result
248	(cond ((psis construct :revision revision)
249	(concat "si:"
250	(identifier-to-curie
251	(first (psis construct :revision revision))
252	:prefixes prefixes)))
253	((locators construct :revision revision)
254	(concat "sl:"
255	(identifier-to-curie
256	(first (locators construct :revision revision))
257	:prefixes prefixes)))
258	((item-identifiers construct :revision revision)
259	(concat "ii:"
260	(identifier-to-curie
261	(first (item-identifiers construct :revision revision))
262	:prefixes prefixes)))
263	(t
264	(error (make-condition 'JTM-error :message (format nil "From export-topic-reference-to-jtm(): the topic ~a has no identifiers" construct)))))))
265	(json:encode-json-to-string result))))
266
267
268	(defgeneric export-parent-references-to-jtm (construct &key prefixes revision)
269	(:documentation "Returns an identifier that is the reference of the given
270	construct's parent. If the parent is a topic
271	export-topic-reference-to-jtm is called otherwise an
272	item-identifier of the parent is returned.")
273	(:method ((construct ReifiableConstructC) &key prefixes (revision TM-REVISION))
274	(declare (List prefixes)
275	(Integer revision))
276	(let ((parents
277	(cond ((or (typep construct 'TopicC)
278	(typep construct 'AssociationC))
279	(in-topicmaps construct :revision revision))
280	((and (or (typep construct 'CharacteristicC)
281	(typep construct 'RoleC))
282	(parent construct :revision revision))
283	(list (parent construct :revision revision))))))
284	(unless parents
285	(error (make-condition 'JTM-error :message (format nil "From export-parent-references-to-jtm(): the passed construct ~a is not bound to parent" construct))))
286	(let ((result "["))
287	(loop for parent in parents
288	do (if (not (get-all-identifiers-of-construct parent
289	:revision revision))
290	(error (make-condition 'JTM-error :message "From export-parent-references-to-jtm(): the parent ~a has no identifiers, but must have at least one" parent))
291	(cond ((typep parent 'TopicC)
292	(push-string
293	(concat
294	(export-topic-reference-to-jtm
295	parent :prefixes prefixes
296	:revision revision) ",") result))
297	(t
298	(push-string
299	(concat
300	(json:encode-json-to-string
301	(concat "ii:" (identifier-to-curie
302	(first (item-identifiers
303	parent :revision revision))
304	:prefixes prefixes))) ",") result)))))
305	(concat (subseq result 0 (1- (length result))) "]")))))
306
307
308	(defmethod export-to-jtm ((construct VariantC) &key (item-type-p t)
309	parent-p prefixes prefixes-p (revision TM-REVISION))
310	"Exports any object of the type VariantC as JTM-object."
311	(declare (Boolean item-type-p parent-p prefixes-p)
312	(List prefixes)
313	(Integer revision))
314	(unless (themes construct :revision revision)
315	(error (make-condition 'JTM-error :message (format nil "The variant ~a has no topic set as theme, at least one is required" construct))))
316	(let ((prefix-value (when prefixes-p
317	(concat "\"prefixes\":"
318	(export-prefix-list-to-jtm prefixes) ",")))
319	(iis (concat "\"item_identifiers\":"
320	(export-identifiers-to-jtm
321	construct :prefixes prefixes :revision revision) ","))
322	(value (concat "\"value\":"
323	(json:encode-json-to-string (charvalue construct)) ","))
324	(datatype (concat "\"datatype\":"
325	(json:encode-json-to-string (datatype construct)) ","))
326	(item-type (when item-type-p
327	(concat "\"item_type\":\"" item_type-variant "\",")))
328	(var-parent
329	(when parent-p
330	(concat "\"parent\":"
331	(export-parent-references-to-jtm construct :prefixes prefixes
332	:revision revision) ",")))
333	(scopes (concat "\"scope\":"
334	(export-scopes-to-jtm
335	construct :prefixes prefixes :revision revision) ","))
336	(var-reifier (concat "\"reifier\":"
337	(export-reifier-to-jtm construct :prefixes prefixes
338	:revision revision))))
339	(concat "{" prefix-value iis datatype value item-type var-parent scopes
340	var-reifier "}")))
341
342
343	(defgeneric export-variants-to-jtm (construct &key item-type-p parent-p
344	prefixes prefixes-p revision)
345	(:documentation "Returns a json array of JTM variant-objects.")
346	(:method ((construct NameC) &key (item-type-p t) parent-p
347	prefixes prefixes-p (revision TM-REVISION))
348	(declare (Boolean item-type-p parent-p prefixes-p)
349	(List prefixes)
350	(Integer revision))
351	(if (variants construct :revision revision)
352	(let ((result "["))
353	(loop for var in (variants construct :revision revision)
354	do (push-string
355	(concat (export-to-jtm
356	var :item-type-p item-type-p :parent-p parent-p
357	:prefixes prefixes :prefixes-p prefixes-p
358	:revision revision) ",")
359	result))
360	(concat (subseq result 0 (1- (length result))) "]"))
361	"null")))
362
363
364	(defgeneric export-names-to-jtm (construct &key item-type-p parent-p
365	prefixes prefixes-p revision)
366	(:documentation "Returns a json array of JTM name-objects.")
367	(:method ((construct TopicC) &key (item-type-p t) parent-p
368	prefixes prefixes-p (revision TM-REVISION))
369	(declare (Boolean item-type-p parent-p prefixes-p)
370	(List prefixes)
371	(Integer revision))
372	(if (names construct :revision revision)
373	(let ((result "["))
374	(loop for name in (names construct :revision revision)
375	do (push-string
376	(concat (export-to-jtm
377	name :item-type-p item-type-p :parent-p parent-p
378	:prefixes prefixes :prefixes-p prefixes-p
379	:revision revision) ",")
380	result))
381	(concat (subseq result 0 (1- (length result))) "]"))
382	"null")))
383
384
385	(defmethod export-to-jtm ((construct OccurrenceC) &key (item-type-p t)
386	parent-p prefixes prefixes-p (revision TM-REVISION))
387	"Exports any object of the type OccurrenceC as JTM-object."
388	(declare (Boolean item-type-p parent-p prefixes-p)
389	(List prefixes)
390	(Integer revision))
391	(let ((prefix-value (when prefixes-p
392	(concat "\"prefixes\":"
393	(export-prefix-list-to-jtm prefixes) ",")))
394	(iis (concat "\"item_identifiers\":"
395	(export-identifiers-to-jtm
396	construct :prefixes prefixes :revision revision) ","))
397	(value (concat "\"value\":"
398	(json:encode-json-to-string (charvalue construct)) ","))
399	(datatype (concat "\"datatype\":"
400	(json:encode-json-to-string (datatype construct)) ","))
401	(type (concat "\"type\":"
402	(export-type-to-jtm construct :prefixes prefixes
403	:revision revision)
404	","))
405	(item-type (when item-type-p
406	(concat "\"item_type\":\"" item_type-occurrence "\",")))
407	(occ-parent
408	(when parent-p
409	(concat "\"parent\":"
410	(export-parent-references-to-jtm construct :prefixes prefixes
411	:revision revision) ",")))
412	(scopes (concat "\"scope\":"
413	(export-scopes-to-jtm
414	construct :prefixes prefixes :revision revision) ","))
415	(occ-reifier (concat "\"reifier\":"
416	(export-reifier-to-jtm construct :prefixes prefixes
417	:revision revision))))
418	(concat "{" prefix-value iis datatype type value item-type occ-parent
419	scopes occ-reifier "}")))
420
421
422	(defgeneric export-occurrences-to-jtm (construct &key item-type-p parent-p
423	prefixes prefixes-p revision)
424	(:documentation "Returns a json array of JTM occurrence-objects.")
425	(:method ((construct TopicC) &key (item-type-p t) parent-p
426	prefixes prefixes-p (revision TM-REVISION))
427	(declare (Boolean item-type-p parent-p prefixes-p)
428	(List prefixes)
429	(Integer revision))
430	(if (occurrences construct :revision revision)
431	(let ((result "["))
432	(loop for occ in (occurrences construct :revision revision)
433	do (push-string
434	(concat (export-to-jtm
435	occ :item-type-p item-type-p :parent-p parent-p
436	:prefixes prefixes :prefixes-p prefixes-p
437	:revision revision) ",")
438	result))
439	(concat (subseq result 0 (1- (length result))) "]"))
440	"null")))
441
442
443	(defgeneric export-instance-ofs-to-jtm (construct &key prefixes revision)
444	(:documentation "Exports a list of topic references, whereas every topic
445	reference represents a topic type that the given topic
446	is an instance of.")
447	(:method ((construct TopicC) &key prefixes (revision TM-REVISION))
448	(let ((instance-ofs (list-instanceof construct :revision revision)))
449	(if instance-ofs
450	(let ((result "["))
451	(loop for top in instance-ofs
452	do (push-string
453	(concat (export-topic-reference-to-jtm
454	top :prefixes prefixes :revision revision) ",")
455	result))
456	(concat (subseq result 0 (1- (length result))) "]"))
457	"null"))))
458
459
460	(defmethod export-to-jtm ((construct RoleC) &key (item-type-p t)
461	(parent-p nil) prefixes prefixes-p (revision TM-REVISION))
462	"Exports any object of type RoleC as JTM-role-object."
463	(declare (Boolean item-type-p parent-p prefixes-p)
464	(List prefixes)
465	(Integer revision))
466	(let ((prefix-value (when prefixes-p
467	(concat "\"prefixes\":"
468	(export-prefix-list-to-jtm prefixes) ",")))
469	(iis (concat "\"item_identifiers\":"
470	(export-identifiers-to-jtm
471	construct :prefixes prefixes :revision revision) ","))
472	(type (concat "\"type\":"
473	(export-type-to-jtm construct :prefixes prefixes
474	:revision revision)
475	","))
476	(item-type (when item-type-p
477	(concat "\"item_type\":\"" item_type-role "\",")))
478	(role-parent
479	(when parent-p
480	(concat "\"parent\":"
481	(export-parent-references-to-jtm construct :prefixes prefixes
482	:revision revision) ",")))
483	(role-reifier (concat "\"reifier\":"
484	(export-reifier-to-jtm construct :prefixes prefixes
485	:revision revision) ","))
486	(role-player
487	(progn
488	(unless (player construct :revision revision)
489	(error (make-condition 'JTM-error :message "From export-to-jtm(): the role [~a] is not bound to a player" construct)))
490	(concat "\"player\":"
491	(export-topic-reference-to-jtm
492	(player construct :revision revision) :prefixes prefixes
493	:revision revision)))))
494	(concat "{" prefix-value iis type item-type role-parent role-reifier
495	role-player "}")))
496
497
498	(defgeneric export-roles-to-jtm (construct &key item-type-p parent-p prefixes
499	prefixes-p revision)
500	(:documentation "Exports a json array of roles serialised
501	as JTM-role-objects.")
502	(:method ((construct AssociationC) &key parent-p prefixes item-type-p prefixes-p
503	(revision TM-REVISION))
504	(declare (List prefixes)
505	(Boolean prefixes-p parent-p item-type-p)
506	(Integer revision))
507	(let ((assoc-roles (roles construct :revision revision)))
508	(if assoc-roles
509	(let ((result "["))
510	(loop for role in assoc-roles
511	do (push-string
512	(concat (export-to-jtm
513	role :prefixes prefixes :prefixes-p prefixes-p
514	:parent-p parent-p :item-type-p item-type-p
515	:revision revision) ",")
516	result))
517	(concat (subseq result 0 (1- (length result))) "]"))
518	"null"))))
519
520
521	(defmethod export-to-jtm ((construct AssociationC) &key (item-type-p t)
522	(parent-p nil) prefixes prefixes-p
523	(revision TM-REVISION))
524	"Exports any object of type AssociationC as JTM-association-object."
525	(declare (Boolean item-type-p parent-p prefixes-p)
526	(List prefixes)
527	(Integer revision))
528	(let ((prefix-value (when prefixes-p
529	(concat "\"prefixes\":"
530	(export-prefix-list-to-jtm prefixes) ",")))
531	(iis (concat "\"item_identifiers\":"
532	(export-identifiers-to-jtm
533	construct :prefixes prefixes :revision revision) ","))
534	(type (concat "\"type\":"
535	(export-type-to-jtm construct :prefixes prefixes
536	:revision revision)
537	","))
538	(item-type (when item-type-p
539	(concat "\"item_type\":\"" item_type-association "\",")))
540	(assoc-parent
541	(when parent-p
542	(concat "\"parent\":"
543	(export-parent-references-to-jtm construct :prefixes prefixes
544	:revision revision) ",")))
545	(assoc-reifier (concat "\"reifier\":"
546	(export-reifier-to-jtm construct :prefixes prefixes
547	:revision revision) ","))
548	(scopes (concat "\"scope\":"
549	(export-scopes-to-jtm
550	construct :prefixes prefixes :revision revision) ","))
551	(assoc-roles
552	(concat "\"roles\":"
553	(export-roles-to-jtm construct :prefixes prefixes :item-type-p nil
554	:prefixes-p nil :revision revision))))
555	(concat "{" prefix-value iis type item-type assoc-parent assoc-reifier
556	scopes assoc-roles "}")))
557
558
559	(defmethod export-to-jtm ((construct FragmentC) &key (item-type-p t)
560	(parent-p nil) prefixes prefixes-p
561	(revision TM-REVISION))
562	"Note if prefixes-p is set to nil the export format is JTM 1.0.
563	If prefixes-p is set to t the export format is JTM 1.1."
564	(declare (Boolean prefixes-p item-type-p)
565	(Ignorable parent-p prefixes)
566	(Integer revision))
567	(let* ((prefixes-list
568	(when prefixes-p
569	(if prefixes
570	prefixes
571	(create-prefix-list-for-construct construct :revision revision))))
572	(prefixes-value
573	(when prefixes-p
574	(concat "\"prefixes\":" (export-prefix-list-to-jtm prefixes-list) ",")))
575	(frag-tops
576	(concat "\"topics\":"
577	(export-topics-to-jtm
578	(append
579	(referenced-topics construct)
580	(list (topic construct))
581	(unless prefixes-p
582	(remove-null
583	(list
584	(get-item-by-psi type-instance-psi :revision revision)
585	(get-item-by-psi instance-psi :revision revision)
586	(get-item-by-psi type-psi :revision revision)))))
587	:prefixes prefixes-list :revision revision
588	:item-type-p nil :instance-of-p (if prefixes-p t nil))
589	","))
590	(frag-assocs
591	(concat "\"associations\":"
592	(export-associations-to-jtm
593	(append
594	(associations construct)
595	(unless prefixes-p
596	(instance-of-associations (topic construct) :revision revision)))
597	:prefixes prefixes-list :revision revision :item-type-p nil)
598	","))
599	(item-type (when item-type-p
600	(concat "\"item_type\":\"" item_type-topicmap "\",")))
601	(iis "\"item_identifiers\":null,")
602	(frag-reifier "\"reifier\":null"))
603	(concat "{" prefixes-value frag-tops frag-assocs item-type
604	iis frag-reifier "}")))
605
606
607	(defgeneric export-topics-to-jtm (topics &key item-type-p parent-p prefixes
608	instance-of-p revision)
609	(:documentation "Exports a json array of topics serialised as JTM-role-objects.")
610	(:method ((topics List) &key (item-type-p t) parent-p prefixes (instance-of-p t)
611	(revision TM-REVISION))
612	(declare (List prefixes)
613	(Boolean parent-p item-type-p instance-of-p)
614	(Integer revision))
615	(if topics
616	(let ((result "["))
617	(loop for top in topics
618	do (push-string
619	(concat
620	(export-to-jtm top :item-type-p item-type-p :prefixes prefixes
621	:parent-p parent-p :revision revision
622	:instance-of-p instance-of-p) ",")
623	result))
624	(concat (subseq result 0 (1- (length result))) "]"))
625	"null")))
626
627
628	(defgeneric export-associations-to-jtm (associations &key item-type-p parent-p
629	prefixes revision)
630	(:documentation "Exports a json array of topics serialised as JTM-role-objects.")
631	(:method ((associations List) &key (item-type-p t) parent-p prefixes
632	(revision TM-REVISION))
633	(declare (List prefixes)
634	(Boolean parent-p item-type-p)
635	(Integer revision))
636	(if associations
637	(let ((result "["))
638	(loop for assoc in associations
639	do (push-string
640	(concat
641	(export-to-jtm assoc :item-type-p item-type-p :prefixes prefixes
642	:parent-p parent-p :revision revision) ",")
643	result))
644	(concat (subseq result 0 (1- (length result))) "]"))
645	"null")))

Note: See TracBrowser for help on using the repository browser.

Context Navigation

source: trunk/src/json/JTM/jtm_exporter.lisp

Download in other formats: