|
1 "{ Package: 'stx:goodies/xmlsuite/relaxng' }" |
|
2 |
|
3 "{ NameSpace: RNG }" |
|
4 |
|
5 Object subclass:#Serializator |
|
6 instanceVariableNames:'schema currentNode objects rootObject idMapping' |
|
7 classVariableNames:'' |
|
8 poolDictionaries:'' |
|
9 category:'Relax NG-Serialization' |
|
10 ! |
|
11 |
|
12 |
|
13 !Serializator class methodsFor:'instance creation'! |
|
14 |
|
15 for:aSchema |
|
16 |
|
17 ^self new schema:aSchema |
|
18 |
|
19 "Created: / 29-04-2005 / 10:10:48 / janfrog" |
|
20 ! ! |
|
21 |
|
22 !Serializator methodsFor:'accessing'! |
|
23 |
|
24 idMapping |
|
25 ^ idMapping |
|
26 |
|
27 "Created: / 26-05-2005 / 13:28:25 / masca" |
|
28 ! |
|
29 |
|
30 popObject |
|
31 |
|
32 ^objects pop |
|
33 |
|
34 "Created: / 29-04-2005 / 10:09:27 / janfrog" |
|
35 ! |
|
36 |
|
37 pushObject: anObject |
|
38 |
|
39 ^objects push: anObject |
|
40 |
|
41 "Created: / 29-04-2005 / 10:09:27 / janfrog" |
|
42 ! |
|
43 |
|
44 schema |
|
45 ^ schema |
|
46 |
|
47 "Created: / 29-04-2005 / 10:08:28 / janfrog" |
|
48 ! |
|
49 |
|
50 schema:aSchema |
|
51 schema := aSchema. |
|
52 |
|
53 "Created: / 29-04-2005 / 10:08:28 / janfrog" |
|
54 ! |
|
55 |
|
56 topObject |
|
57 |
|
58 ^objects top |
|
59 |
|
60 "Created: / 29-04-2005 / 10:09:27 / janfrog" |
|
61 ! ! |
|
62 |
|
63 !Serializator methodsFor:'experiments'! |
|
64 |
|
65 visitCollectionNode: collectionNode |
|
66 |
|
67 collectionNode hasBinding ifTrue: [ |object | |
|
68 object := self topObjectUsing: collectionNode bindingInfo. |
|
69 (collectionNode pattern isValidObject: object) |
|
70 ifFalse: [^SerializationError raiseErrorString: 'Invalid class']. |
|
71 collectionNode bindingInfo |
|
72 serializeContent: [:o | |
|
73 self pushObject: o. |
|
74 o acceptVisitor: self. |
|
75 self popObject. |
|
76 currentNode := currentNode parent] |
|
77 with: object |
|
78 ]. |
|
79 |
|
80 "Created: / 25-08-2005 / 14:25:47 / masca" |
|
81 ! ! |
|
82 |
|
83 !Serializator methodsFor:'private'! |
|
84 |
|
85 addElementNode: nameString namespace: nsString |
|
86 |
|
87 | element | |
|
88 element := XML::Element tag: (XML::NodeTag new qualifier: '' ns: nsString type: nameString). |
|
89 currentNode addNode: element. |
|
90 currentNode := element. |
|
91 ^element |
|
92 |
|
93 "Created: / 29-04-2005 / 16:16:39 / janfrog" |
|
94 ! |
|
95 |
|
96 addText: aString |
|
97 |
|
98 aString isString ifFalse:[self halt]. |
|
99 |
|
100 ^currentNode addNode: (self textNodeFromString: aString) |
|
101 |
|
102 "Created: / 02-05-2005 / 16:31:13 / janfrog" |
|
103 "Modified: / 16-05-2005 / 13:57:05 / masca" |
|
104 ! |
|
105 |
|
106 checkKeyData: aPattern |
|
107 |
|
108 | key dataType | |
|
109 aPattern isForAttribute ifFalse:[^nil]. |
|
110 dataType := aPattern pcDataContentPattern dataType. |
|
111 |
|
112 (dataType isKey and: [(idMapping includesKey: self topObject) not]) |
|
113 ifTrue: [ |
|
114 key := aPattern hasBinding |
|
115 ifTrue: [self topObjectUsing: aPattern bindingInfo] |
|
116 ifFalse: [currentNode tag type , self topObject identityHash printString]. |
|
117 idMapping at: self topObject put: key. |
|
118 ^key] |
|
119 ifFalse: [ |
|
120 dataType isKeyRef |
|
121 ifTrue: [ |
|
122 key := idMapping |
|
123 at: self topObject |
|
124 ifAbsent: [SerializationError raiseErrorString: 'Cannot find key for reference']. |
|
125 currentNode |
|
126 attributes: OrderedCollection new; |
|
127 elements: #(). |
|
128 ^key |
|
129 ] |
|
130 ]. |
|
131 ^nil |
|
132 |
|
133 "Created: / 29-04-2005 / 15:50:49 / janfrog" |
|
134 "Modified: / 02-05-2005 / 18:04:54 / janfrog" |
|
135 "Modified: / 16-05-2005 / 11:50:53 / masca" |
|
136 ! |
|
137 |
|
138 recoverState: anArray |
|
139 |
|
140 | keptObjects | |
|
141 keptObjects := anArray at: 1. |
|
142 objects size > keptObjects ifTrue: [objects removeLast: (objects size - keptObjects)]. |
|
143 |
|
144 currentNode := anArray at: 2. |
|
145 currentNode attributes: (anArray at: 3) copy. |
|
146 currentNode elements: (anArray at: 4) copy |
|
147 |
|
148 "Created: / 29-04-2005 / 13:45:26 / janfrog" |
|
149 ! |
|
150 |
|
151 saveState |
|
152 |
|
153 ^Array |
|
154 with: objects size |
|
155 with: currentNode |
|
156 with: currentNode attributes copy asOrderedCollection |
|
157 with: currentNode elements copy asOrderedCollection |
|
158 |
|
159 "Created: / 29-04-2005 / 13:42:57 / janfrog" |
|
160 ! |
|
161 |
|
162 textNodeFromString: aString |
|
163 |
|
164 ^XML::Text text: aString |
|
165 |
|
166 "Created: / 02-05-2005 / 16:31:56 / janfrog" |
|
167 ! ! |
|
168 |
|
169 !Serializator methodsFor:'processing'! |
|
170 |
|
171 topObjectAt: aString |
|
172 |
|
173 | obj | |
|
174 aString ifNil:[SerializationError raiseErrorString: |
|
175 'Instvar name is nil...']. |
|
176 obj := self hasTopObject |
|
177 ifTrue: [ |
|
178 [ |
|
179 self topObject instVarNamed: aString |
|
180 ] on:NonIntegerIndexError do:[ |
|
181 SerializationError raiseErrorString: |
|
182 self topObject printString |
|
183 , ' ( instance of ',self topObject class name , ')' |
|
184 ,' has no instvar named ',aString |
|
185 ] |
|
186 ] |
|
187 ifFalse:[rootObject]. |
|
188 obj |
|
189 ifNil:[SerializationError raiseErrorString:'nil value in instvar named ',aString |
|
190 , ' in object ', self topObject printString. ^self]. |
|
191 ^obj |
|
192 |
|
193 "Modified: / 29-04-2005 / 11:01:26 / janfrog" |
|
194 "Modified: / 16-05-2005 / 15:45:53 / masca" |
|
195 ! |
|
196 |
|
197 topObjectUsing: aBindingInfo |
|
198 |
|
199 self hasTopObject ifFalse:[^rootObject]. |
|
200 |
|
201 ^aBindingInfo hasConverters |
|
202 ifTrue:[ |
|
203 | topObject | |
|
204 topObject := self hasTopObject ifTrue:[self topObject] ifFalse:[rootObject]. |
|
205 topObject |
|
206 perform:aBindingInfo readConverter |
|
207 ifNotUnderstood:[ |
|
208 SerializationError raiseErrorString:'Failed to retrieve data by readConverter' |
|
209 ] |
|
210 ] ifFalse:[ |
|
211 self topObjectAt:aBindingInfo name |
|
212 ] |
|
213 |
|
214 "Modified: / 29-04-2005 / 11:01:26 / janfrog" |
|
215 "Created: / 16-05-2005 / 11:50:37 / masca" |
|
216 "Modified: / 25-08-2005 / 16:59:55 / masca" |
|
217 ! ! |
|
218 |
|
219 !Serializator methodsFor:'serialization'! |
|
220 |
|
221 serialize: anObject |
|
222 |
|
223 objects := Stack new. |
|
224 currentNode := XML::Document new. |
|
225 rootObject := anObject. |
|
226 idMapping := IdentityDictionary new. |
|
227 |
|
228 self visitElement: schema rootPattern node firstChild pattern. |
|
229 |
|
230 currentNode isDocument ifFalse: [SerializationError raiseErrorString: 'Improper nesting (bug in serialization code)']. |
|
231 ^currentNode |
|
232 |
|
233 "Created: / 29-04-2005 / 10:14:19 / janfrog" |
|
234 "Modified: / 02-05-2005 / 17:04:52 / janfrog" |
|
235 ! |
|
236 |
|
237 serialize: anObject using: aSchema |
|
238 |
|
239 schema := aSchema. |
|
240 ^self serialize: anObject |
|
241 |
|
242 "Created: / 29-04-2005 / 10:18:27 / janfrog" |
|
243 "Modified: / 29-04-2005 / 11:34:32 / janfrog" |
|
244 ! ! |
|
245 |
|
246 !Serializator methodsFor:'support'! |
|
247 |
|
248 visitAttribute: aPattern |
|
249 |
|
250 | attribute object | |
|
251 |
|
252 attribute := XML::Attribute new tag: |
|
253 (XML::NodeTag new qualifier: '' ns: aPattern namespace type: aPattern localName). |
|
254 aPattern hasBinding |
|
255 ifTrue: [ |
|
256 object := self topObjectUsing: aPattern bindingInfo. |
|
257 object ifNil:[ |
|
258 ^SerializationError raiseErrorString:'Bound attribute is nil'. |
|
259 ]. |
|
260 attribute value: (aPattern node firstChild pattern charactersFromObject: object)] |
|
261 ifFalse: [ |
|
262 attribute value: (self checkKeyData: aPattern) |
|
263 ]. |
|
264 |
|
265 attribute value |
|
266 ifNil: [ |
|
267 SerializationError raiseErrorString: 'Unknown attribute for serialization'] |
|
268 ifNotNil: [ |
|
269 | atts | |
|
270 atts := currentNode attributes. |
|
271 atts isEmpty ifTrue:[currentNode attributes:(atts := XMLv2::Attributes new)]. |
|
272 atts add:attribute |
|
273 ]. |
|
274 |
|
275 "Created: / 29-04-2005 / 10:48:55 / janfrog" |
|
276 "Modified: / 02-05-2005 / 17:09:57 / janfrog" |
|
277 "Modified: / 16-05-2005 / 13:49:07 / masca" |
|
278 ! |
|
279 |
|
280 visitData: aPattern |
|
281 |
|
282 | binding | |
|
283 binding := aPattern bindingInfo hasBinding |
|
284 ifTrue:[aPattern bindingInfo] |
|
285 ifFalse:[aPattern node parent pattern bindingInfo]. |
|
286 binding hasBinding |
|
287 ifFalse:[^SerializationError raiseErrorString: 'Invalid data binding']. |
|
288 self topObject |
|
289 ifNil:[^SerializationError raiseErrorString: 'No data']. |
|
290 |
|
291 self addText: (aPattern charactersFromObject: self topObject) |
|
292 |
|
293 "Created: / 29-04-2005 / 11:31:04 / janfrog" |
|
294 "Modified: / 02-05-2005 / 17:06:42 / janfrog" |
|
295 "Modified: / 16-05-2005 / 13:55:26 / masca" |
|
296 ! |
|
297 |
|
298 visitElement: aPattern |
|
299 |
|
300 | object | |
|
301 |
|
302 aPattern hasBinding ifFalse: [ |
|
303 self addElementNode: aPattern localName namespace: aPattern namespace. |
|
304 |
|
305 (self checkKeyData: aPattern) |
|
306 ifNil: [aPattern node childrenDo: [:e | e acceptVisitor: self]]. |
|
307 currentNode := currentNode parent. |
|
308 ^self |
|
309 ]. |
|
310 |
|
311 object := self topObjectUsing: aPattern bindingInfo. |
|
312 (aPattern isValidObject: object) |
|
313 ifFalse: [^SerializationError raiseErrorString: 'Invalid class']. |
|
314 "(aPattern hasComplexContentModel and:[(object isKindOf: aPattern bindingInfo instanceVariableClass) not]) |
|
315 ifTrue: [^SerializationError raiseErrorString: 'Invalid class']." |
|
316 |
|
317 aPattern bindingInfo |
|
318 serializeContent: [:o | |
|
319 self addElementNode: aPattern localName namespace: aPattern namespace. |
|
320 self pushObject: o. |
|
321 aPattern node childrenDo: [:e | e acceptVisitor: self]. |
|
322 self popObject. |
|
323 currentNode := currentNode parent] |
|
324 with: object |
|
325 |
|
326 "Created: / 29-04-2005 / 10:17:15 / janfrog" |
|
327 "Modified: / 02-05-2005 / 17:06:04 / janfrog" |
|
328 "Modified: / 25-08-2005 / 14:17:28 / masca" |
|
329 ! ! |
|
330 |
|
331 !Serializator methodsFor:'testing'! |
|
332 |
|
333 hasTopObject |
|
334 |
|
335 ^objects isEmpty not |
|
336 |
|
337 "Created: / 29-04-2005 / 10:12:26 / janfrog" |
|
338 ! ! |
|
339 |
|
340 !Serializator methodsFor:'visiting'! |
|
341 |
|
342 visitChoiceNode: aChoiceNode |
|
343 |
|
344 | state errors | |
|
345 state := self saveState. |
|
346 errors := Set new. |
|
347 |
|
348 aChoiceNode children do: [:e | |
|
349 [ |
|
350 e acceptVisitor: self. |
|
351 ^self |
|
352 ] |
|
353 on: SerializationError |
|
354 do: [:ex | errors add:ex errorString. ex return]. |
|
355 self recoverState: state |
|
356 ]. |
|
357 |
|
358 SerializationError raiseErrorString: |
|
359 (errors inject:'No choice matches: ' into:[:msg :errMsg| msg , '[',errMsg,']']) |
|
360 |
|
361 "Created: / 02-05-2005 / 16:46:12 / janfrog" |
|
362 "Modified: / 08-06-2005 / 14:16:01 / masca" |
|
363 ! |
|
364 |
|
365 visitEmptyNode: anEmptyNode |
|
366 |
|
367 ^self |
|
368 |
|
369 "Created: / 02-05-2005 / 16:49:51 / janfrog" |
|
370 ! |
|
371 |
|
372 visitGroupNode: aGroupNode |
|
373 |
|
374 aGroupNode children do: [:e | |
|
375 e acceptVisitor: self |
|
376 ] |
|
377 |
|
378 "Created: / 02-05-2005 / 16:45:56 / janfrog" |
|
379 ! |
|
380 |
|
381 visitOneOrMoreNode: aOneOrMoreNode |
|
382 |
|
383 "self topObject isEmpty ifTrue: [SerializationError raiseErrorString: 'Need at least one item in collection']." |
|
384 self visitGroupNode: aOneOrMoreNode |
|
385 |
|
386 "Created: / 02-05-2005 / 16:45:37 / janfrog" |
|
387 ! |
|
388 |
|
389 visitOptionalNode: anOptionalNode |
|
390 |
|
391 | state | |
|
392 state := self saveState. |
|
393 |
|
394 [ |
|
395 anOptionalNode children do: [:e | e acceptVisitor: self]. |
|
396 ^self |
|
397 ] |
|
398 on: SerializationError |
|
399 do: [:ex | |
|
400 self recoverState: state. |
|
401 ex return] |
|
402 |
|
403 "Created: / 02-05-2005 / 16:45:24 / janfrog" |
|
404 ! |
|
405 |
|
406 visitPatternNode: aPatternNode |
|
407 |
|
408 | pattern | |
|
409 pattern := aPatternNode pattern. |
|
410 |
|
411 pattern isPCDataPattern ifTrue: [^self visitData: pattern]. |
|
412 pattern isForElement ifTrue: [^self visitElement: pattern]. |
|
413 pattern isForAttribute ifTrue: [^self visitAttribute: pattern]. |
|
414 |
|
415 SerializationError raiseErrorString: 'Unknown pattern type' |
|
416 |
|
417 "Created: / 02-05-2005 / 16:42:11 / janfrog" |
|
418 ! |
|
419 |
|
420 visitZeroOrMoreNode: aZeroOrMoreNode |
|
421 |
|
422 | state | |
|
423 state := self saveState. |
|
424 |
|
425 [ |
|
426 self visitGroupNode: aZeroOrMoreNode. |
|
427 ^self |
|
428 ] |
|
429 on: SerializationError |
|
430 do: [:ex | |
|
431 self recoverState: state. |
|
432 ex return] |
|
433 |
|
434 "Created: / 02-05-2005 / 16:45:55 / janfrog" |
|
435 "Modified: / 25-08-2005 / 14:36:59 / masca" |
|
436 ! ! |
|
437 |
|
438 !Serializator class methodsFor:'documentation'! |
|
439 |
|
440 version |
|
441 ^ '$Header: /opt/data/cvs/stx/goodies/xmlsuite/relaxng/RNG__Serializator.st,v 1.1.1.1 2005-11-01 22:07:16 vranyj1 Exp $' |
|
442 ! ! |