1 /*----------------------------------------------------------------------------
2 | Copyright (c) 1999 Jochen Loewer (loewerj@hotmail.com)
3 +-----------------------------------------------------------------------------
4 |
5 | $Id$
6 |
7 |
8 | A DOM implementation for Tcl using James Clark's expat XML parser
9 |
10 |
11 | The contents of this file are subject to the Mozilla Public License
12 | Version 1.1 (the "License"); you may not use this file except in
13 | compliance with the License. You may obtain a copy of the License at
14 | http://www.mozilla.org/MPL/
15 |
16 | Software distributed under the License is distributed on an "AS IS"
17 | basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
18 | License for the specific language governing rights and limitations
19 | under the License.
20 |
21 | The Original Code is tDOM.
22 |
23 | The Initial Developer of the Original Code is Jochen Loewer
24 | Portions created by Jochen Loewer are Copyright (C) 1998, 1999
25 | Jochen Loewer. All Rights Reserved.
26 |
27 | Contributor(s):
28 | Sept99 Carsten Zerbst Added comment and processing instructions
29 | nodes.
30 | June00 Zoran Vasiljevic Made thread-safe.
31 | July00 Zoran Vasiljevic Added "domNode appendFromScript"
32 |
33 |
34 | written by Jochen Loewer
35 | April, 1999
36 |
37 \---------------------------------------------------------------------------*/
38
39
40 /*----------------------------------------------------------------------------
41 | Includes
42 |
43 \---------------------------------------------------------------------------*/
44 #include <tcl.h>
45 #include <dom.h>
46 #include <domxpath.h>
47 #include <domxslt.h>
48 #include <xmlsimple.h>
49 #include <domjson.h>
50 #include <domhtml.h>
51 #include <domhtml5.h>
52 #include <nodecmd.h>
53 #include <tcldom.h>
54 #include <versionhash.h>
55
56 /* #define DEBUG */
57 /*----------------------------------------------------------------------------
58 | Debug Macros
59 |
60 \---------------------------------------------------------------------------*/
61 #ifdef DEBUG
62 # define DBG(x) x
63 #else
64 # define DBG(x)
65 #endif
66
67
68 /*----------------------------------------------------------------------------
69 | Macros
70 |
71 \---------------------------------------------------------------------------*/
72 #define XP_CHILD 0
73 #define XP_DESCENDANT 1
74 #define XP_ANCESTOR 2
75 #define XP_FSIBLING 3
76 #define XP_PSIBLING 4
77
78 #define MAX_REWRITE_ARGS 50
79
80 #define MAX_XSLT_APPLY_DEPTH 3000
81
82 #define SetResult(str) Tcl_ResetResult(interp); \
83 Tcl_SetStringObj(Tcl_GetObjResult(interp), (str), -1)
84
85 #define SetResult3(str1,str2,str3) Tcl_ResetResult(interp); \
86 Tcl_AppendResult(interp, (str1), (str2), (str3), NULL)
87
88 #define SetIntResult(i) Tcl_ResetResult(interp); \
89 Tcl_SetIntObj(Tcl_GetObjResult(interp), (i))
90
91 #define SetDoubleResult(d) Tcl_ResetResult(interp); \
92 Tcl_SetDoubleObj(Tcl_GetObjResult(interp), (d))
93
94 #define SetBooleanResult(i) Tcl_ResetResult(interp); \
95 Tcl_SetBooleanObj(Tcl_GetObjResult(interp), (i))
96
97 #define AppendResult(str) {Tcl_Obj *o = Tcl_GetObjResult(interp); \
98 if (Tcl_IsShared(o)) { \
99 o = Tcl_DuplicateObj(o); \
100 Tcl_SetObjResult(interp, o); \
101 } \
102 Tcl_AppendToObj(o, (str), -1);}
103
104 #define CheckArgs(min,max,n,msg) \
105 if ((objc < min) || (objc >max)) { \
106 Tcl_WrongNumArgs(interp, n, objv, msg); \
107 return TCL_ERROR; \
108 }
109 #define CheckName(interp, name, errText, isFQ) \
110 if (!TSD(dontCheckName)) { \
111 if (!tcldom_nameCheck(interp, name, errText, isFQ)) {\
112 return TCL_ERROR; \
113 } \
114 }
115
116 #define CheckPIName(interp, name) \
117 if (!TSD(dontCheckName)) { \
118 if (!tcldom_PINameCheck(interp, name)) {\
119 return TCL_ERROR; \
120 } \
121 }
122
123 #define CheckText(interp, text, errText) \
124 if (!TSD(dontCheckCharData)) { \
125 if (!tcldom_textCheck(interp, text, errText)) {\
126 return TCL_ERROR; \
127 } \
128 }
129
130 #define CheckComment(interp, text) \
131 if (!TSD(dontCheckCharData)) { \
132 if (!tcldom_commentCheck(interp, text)) {\
133 return TCL_ERROR; \
134 } \
135 }
136
137 #define CheckCDATA(interp, text) \
138 if (!TSD(dontCheckCharData)) { \
139 if (!tcldom_CDATACheck(interp, text)) {\
140 return TCL_ERROR; \
141 } \
142 }
143
144 #define CheckPIValue(interp, text) \
145 if (!TSD(dontCheckCharData)) { \
146 if (!tcldom_PIValueCheck(interp, text)) {\
147 return TCL_ERROR; \
148 } \
149 }
150
151 #define writeChars(var,chan,buf,len) (chan) ? \
152 ((void)Tcl_WriteChars ((chan), (buf), (len) )) : \
153 (Tcl_AppendToObj ((var), (buf), (len) ));
154
155 #define DOM_CREATECMDMODE_AUTO 0
156 #define DOM_CREATECMDMODE_CMDS 1
157 #define DOM_CREATECMDMODE_TOKENS 2
158
159 #define SERIALIZE_XML_DECLARATION 1
160 #define SERIALIZE_DOCTYPE_DECLARATION 2
161 #define SERIALIZE_FOR_ATTR 4
162 #define SERIALIZE_ESCAPE_NON_ASCII 8
163 #define SERIALIZE_HTML_ENTITIES 16
164 #define SERIALIZE_ESCAPE_ALL_QUOT 32
165 #define SERIALIZE_NO_GT_ESCAPE 64
166 #define SERIALIZE_NO_EMPTY_ELEMENT_TAG 128
167
168 /*----------------------------------------------------------------------------
169 | Module Globals
170 |
171 \---------------------------------------------------------------------------*/
172 #ifndef TCL_THREADS
173 static int storeLineColumn = 0;
174 static int dontCreateObjCommands = 0;
175 static int dontCheckCharData = 0;
176 static int dontCheckName = 0;
177 static int domCreateCmdMode = 0;
178 # define TSD(x) x
179 # define GetTcldomTSD()
180 #else
181 typedef struct ThreadSpecificData {
182 int storeLineColumn;
183 int dontCreateObjCommands;
184 int dontCheckCharData;
185 int dontCheckName;
186 int domCreateCmdMode;
187 } ThreadSpecificData;
188 static Tcl_ThreadDataKey dataKey;
189 static Tcl_HashTable sharedDocs;
190 static Tcl_Mutex tableMutex;
191 static int tcldomInitialized;
192 # define TSD(x) tsdPtr->x
193 # define GetTcldomTSD() ThreadSpecificData *tsdPtr = \
194 (ThreadSpecificData*) \
195 Tcl_GetThreadData( \
196 &dataKey, \
197 sizeof(ThreadSpecificData));
198 #endif /* TCL_THREADS */
199
200 static char dom_usage[] =
201 "Usage dom <subCommand> <args>, where subCommand can be: \n"
202 " parse ?-keepEmpties? ?-channel <channel> ?-baseurl <baseurl>? \n"
203 " ?-feedbackAfter <#Bytes>? \n"
204 " ?-feedbackcmd <cmd>? \n"
205 " ?-externalentitycommand <cmd>? \n"
206 " ?-useForeignDTD <boolean>? \n"
207 " ?-paramentityparsing <none|always|standalone>\n"
208 " ?-simple? ?-html? ?-html5? ?-json? \n"
209 " ?-jsonmaxnesting <#nr>? \n"
210 " ?-jsonroot name? \n"
211 " ?<xml|html|json>? ?<objVar>? \n"
212 " createDocument docElemName ?objVar? \n"
213 " createDocumentNS uri docElemName ?objVar? \n"
214 " createDocumentNode ?objVar? \n"
215 TDomThreaded(
216 " attachDocument domDoc ?objVar? \n"
217 " detachDocument domDoc \n"
218 )
219 " createNodeCmd ?-returnNodeCmd? ?-tagName name? ?-jsonType jsonType? ?-namespace URI? (element|comment|text|cdata|pi)Node cmdName \n"
220 " setStoreLineColumn ?boolean? \n"
221 " setNameCheck ?boolean? \n"
222 " setTextCheck ?boolean? \n"
223 " setObjectCommands ?(automatic|token|command)? \n"
224 " isCharData string \n"
225 " isComment string \n"
226 " isCDATA string \n"
227 " isPIValue string \n"
228 " isName string \n"
229 " isQName string \n"
230 " isNCName string \n"
231 " isPIName string \n"
232 " featureinfo feature \n"
233 ;
234
235 static char doc_usage[] =
236 "Usage domDoc <method> <args>, where method can be:\n"
237 " documentElement ?objVar? \n"
238 " getElementsByTagName name \n"
239 " getElementsByTagNameNS uri localname \n"
240 " createElement tagName ?objVar? \n"
241 " createElementNS uri tagName ?objVar? \n"
242 " createCDATASection data ?objVar? \n"
243 " createTextNode text ?objVar? \n"
244 " createComment text ?objVar? \n"
245 " createProcessingInstruction target data ?objVar? \n"
246 " asXML ?-indent <none,0..8>? ?-channel <channel>? ?-escapeNonASCII? ?-escapeAllQuot? ?-doctypeDeclaration <boolean>?\n"
247 " asHTML ?-channel <channelId>? ?-escapeNonASCII? ?-htmlEntities?\n"
248 " asText \n"
249 " asJSON ?-indent <none,0..8>? \n"
250 " getDefaultOutputMethod \n"
251 " publicId ?publicId? \n"
252 " systemId ?systemId? \n"
253 " internalSubset ?internalSubset? \n"
254 " indent ?boolean? \n"
255 " omit-xml-declaration ?boolean? \n"
256 " encoding ?value? \n"
257 " standalone ?boolean? \n"
258 " mediaType ?value? \n"
259 " delete \n"
260 " xslt ?-parameters parameterList? ?-ignoreUndeclaredParameters? ?-xsltmessagecmd cmd? <xsltDocNode> ?objVar?\n"
261 " toXSLTcmd \n"
262 " cdataSectionElements (?URI:?localname|*) ?boolean?\n"
263 " normalize ?-forXPath? \n"
264 " nodeType \n"
265 " hasChildNodes \n"
266 " childNodes \n"
267 " firstChild ?nodeObjVar? \n"
268 " lastChild ?nodeObjVar? \n"
269 " appendChild new \n"
270 " insertBefore new ref \n"
271 " replaceChild new old \n"
272 " removeChild child \n"
273 " ownerDocument \n"
274 " getElementById id \n"
275 " baseURI ?URI? \n"
276 " appendFromList nestedList \n"
277 " appendFromScript script \n"
278 " insertBeforeFromScript script ref \n"
279 " appendXML xmlString \n"
280 " selectNodesNamespaces ?prefixUriList? \n"
281 " selectNodes ?-namespaces prefixUriList? ?-cache <boolean>? xpathQuery ?typeVar? \n"
282 " renameNode <nodelist> <newName> \n"
283 " deleteXPathCache ?xpathQuery? \n"
284 TDomThreaded(
285 " readlock \n"
286 " writelock \n"
287 " renumber \n"
288 )
289 ;
290
291 static char node_usage[] =
292 "Usage nodeObj <method> <args>, where method can be:\n"
293 " nodeType \n"
294 " nodeName \n"
295 " nodeValue ?newValue? \n"
296 " hasChildNodes \n"
297 " childNodes \n"
298 " childNodesLive \n"
299 " parentNode \n"
300 " firstChild ?nodeObjVar? \n"
301 " lastChild ?nodeObjVar? \n"
302 " nextSibling ?nodeObjVar? \n"
303 " previousSibling ?nodeObjVar? \n"
304 " hasAttribute attrName \n"
305 " getAttribute attrName ?defaultValue? \n"
306 " setAttribute attrName value ?attrName value ...? \n"
307 " removeAttribute attrName \n"
308 " hasAttributeNS uri localName \n"
309 " getAttributeNS uri localName ?defaultValue? \n"
310 " setAttributeNS uri attrName value ?attrName value ...? \n"
311 " removeAttributeNS uri attrName \n"
312 " attributes ?attrNamePattern? \n"
313 " attributeNames ?attrNamePattern? \n"
314 " appendChild new \n"
315 " insertBefore new ref \n"
316 " replaceChild new old \n"
317 " removeChild child \n"
318 " cloneNode ?-deep? \n"
319 " ownerDocument \n"
320 " getElementsByTagName name \n"
321 " getElementsByTagNameNS uri localname \n"
322 " getElementById id \n"
323 " find attrName attrValue ?nodeObjVar? \n"
324 " child number|all ?type? ?attrName attrValue? \n"
325 " descendant number|all ?type? ?attrName attrValue? \n"
326 " ancestor number|all ?type? ?attrName attrValue? \n"
327 " fsibling number|all ?type? ?attrName attrValue? \n"
328 " psibling number|all ?type? ?attrName attrValue? \n"
329 " root ?nodeObjVar? \n"
330 " target \n"
331 " data \n"
332 " text \n"
333 " prefix \n"
334 " namespaceURI \n"
335 " getBaseURI \n"
336 " baseURI ?URI? \n"
337 " localName \n"
338 " delete \n"
339 " getLine \n"
340 " getColumn \n"
341 " @<attrName> ?defaultValue? \n"
342 " asList \n"
343 " asXML ?-indent <none,0..8>? ?-channel <channel>? ?-escapeNonASCII? ?-escapeAllQuot? ?-doctypeDeclaration <boolean>?\n"
344 " asHTML ?-channel <channelId>? ?-escapeNonASCII? ?-htmlEntities?\n"
345 " asText \n"
346 " asJSON ?-indent <none,0..8>? \n"
347 " appendFromList nestedList \n"
348 " appendFromScript script \n"
349 " insertBeforeFromScript script ref \n"
350 " appendXML xmlString \n"
351 " selectNodes ?-namespaces prefixUriList? ?-cache <boolean>? xpathQuery ?typeVar? \n"
352 " toXPath ?-legacy? \n"
353 " disableOutputEscaping ?boolean? \n"
354 " precedes node \n"
355 " normalize ?-forXPath? \n"
356 " xslt ?-parameters parameterList? <xsltDocNode>\n"
357 " jsonType ?jsonType? \n"
358 TDomThreaded(
359 " readlock \n"
360 " writelock \n"
361 )
362 ;
363
364 static const char *jsonTypes[] = {
365 "NONE",
366 "ARRAY",
367 "OBJECT",
368 "NULL",
369 "TRUE",
370 "FALSE",
371 "STRING",
372 "NUMBER",
373 NULL
374 };
375
376 /*----------------------------------------------------------------------------
377 | Types
378 |
379 \---------------------------------------------------------------------------*/
380
381 typedef struct XsltMsgCBInfo {
382 Tcl_Interp * interp;
383 Tcl_Obj * msgcmd;
384 } XsltMsgCBInfo;
385
386
387 static void UpdateStringOfTdomNode(Tcl_Obj *objPtr);
388 static int SetTdomNodeFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
389
390 const Tcl_ObjType tdomNodeType = {
391 "tdom-node",
392 NULL,
393 NULL,
394 UpdateStringOfTdomNode,
395 SetTdomNodeFromAny
396 };
397
398 /*----------------------------------------------------------------------------
399 | Prototypes for procedures defined later in this file:
400 |
401 \---------------------------------------------------------------------------*/
402 #if (TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION <= 3)
403 /*
404 * Before Tcl 8.4, Tcl_VarTraceProc and Tcl_CmdDeleteProc were not
405 * CONST84'ified. When compiling with -DTCL_NO_DEPRECATED, CONST84 is
406 * gone, therefore we can't use the function type definitions of
407 * Tcl_VarTraceProc and Tcl_CmdDeleteProc for these old version.
408 *
409 */
410 static char * tcldom_docTrace(
411 ClientData clientData, Tcl_Interp *interp,
412 const char *part1, const char *part2, int flags);
413 static void tcldom_docCmdDeleteProc(ClientData clientData);
414 #else
415 static Tcl_VarTraceProc tcldom_docTrace;
416 static Tcl_CmdDeleteProc tcldom_docCmdDeleteProc;
417 #endif
418
419 static void tcldom_treeAsJSON(Tcl_Obj *jstring, domNode *node,
420 Tcl_Channel channel, int indent,
421 int level,
422 int inside);
423
424 #ifdef TCL_THREADS
425
426 static int tcldom_EvalLocked(Tcl_Interp* interp, Tcl_Obj** objv,
427 domDocument* doc, int flag);
428
429 static int tcldom_RegisterDocShared(domDocument* doc);
430 static int tcldom_CheckDocShared(domDocument* doc);
431 static int tcldom_UnregisterDocShared(Tcl_Interp* interp, domDocument* doc);
432
433 /*----------------------------------------------------------------------------
434 | tcldom_Finalize
435 |
436 | Activated in application exit handler to delete shared document table
437 | Table entries are deleted by the object command deletion callbacks,
438 | so at this time, table should be empty. If not, we will leave some
439 | memory leaks. This is not fatal, though: we're exiting the app anyway.
440 | This is a private function to this file.
441 \---------------------------------------------------------------------------*/
442
443 static void
tcldom_Finalize(ClientData unused)444 tcldom_Finalize(
445 ClientData unused
446 )
447 {
448 DBG(fprintf(stderr, "--> tcldom_Finalize\n"));
449 Tcl_MutexLock(&tableMutex);
450 Tcl_DeleteHashTable(&sharedDocs);
451 tcldomInitialized = 0;
452 Tcl_MutexUnlock(&tableMutex);
453 }
454
455 /*----------------------------------------------------------------------------
456 | tcldom_initialize
457 | Activated at module load to initialize shared document table.
458 | This is exported since we need it in tdominit.c.
459 \---------------------------------------------------------------------------*/
460
tcldom_initialize(void)461 void tcldom_initialize(void)
462 {
463 if (!tcldomInitialized) {
464 DBG(fprintf(stderr, "--> tcldom_initialize\n"));
465 Tcl_MutexLock(&tableMutex);
466 Tcl_InitHashTable(&sharedDocs, TCL_ONE_WORD_KEYS);
467 Tcl_CreateExitHandler(tcldom_Finalize, NULL);
468 tcldomInitialized = 1;
469 Tcl_MutexUnlock(&tableMutex);
470 }
471 }
472
473 #endif /* TCL_THREADS */
474
475 /*----------------------------------------------------------------------------
476 | tcldom_deleteNode
477 |
478 \---------------------------------------------------------------------------*/
479 static void
tcldom_deleteNode(domNode * node,void * clientData)480 tcldom_deleteNode (
481 domNode * node,
482 void * clientData
483 )
484 {
485 Tcl_Interp *interp = clientData;
486 char objCmdName[80];
487
488 /* Try to delete the node object commands, ignore errors */
489 if (node->nodeFlags & VISIBLE_IN_TCL) {
490 NODE_CMD(objCmdName, node);
491 Tcl_DeleteCommand(interp, objCmdName);
492 node->nodeFlags &= ~VISIBLE_IN_TCL;
493 }
494 }
495
496 /*----------------------------------------------------------------------------
497 | tcldom_deleteDoc
498 |
499 \---------------------------------------------------------------------------*/
500 static
tcldom_deleteDoc(Tcl_Interp * interp,domDocument * doc)501 void tcldom_deleteDoc (
502 Tcl_Interp * interp,
503 domDocument * doc
504 )
505 {
506 int deleted = 1;
507
508 TDomThreaded(deleted = tcldom_UnregisterDocShared(interp, doc));
509 if (deleted) {
510 domFreeDocument(doc, tcldom_deleteNode, interp);
511 }
512 }
513
514 /*----------------------------------------------------------------------------
515 | tcldom_docCmdDeleteProc
516 |
517 \---------------------------------------------------------------------------*/
518 static
tcldom_docCmdDeleteProc(ClientData clientData)519 void tcldom_docCmdDeleteProc(
520 ClientData clientData
521 )
522 {
523 domDeleteInfo *dinfo = (domDeleteInfo *)clientData;
524 domDocument *doc = dinfo->document;
525 int hasTrace = dinfo->document->nodeFlags & VAR_TRACE;
526
527 DBG(fprintf(stderr, "--> tcldom_docCmdDeleteProc doc %p\n", doc));
528 tcldom_deleteDoc(dinfo->interp, doc);
529
530 if (hasTrace) {
531 dinfo->document = NULL;
532 } else {
533 FREE((void*)dinfo);
534 }
535 }
536
537 /*----------------------------------------------------------------------------
538 | tcldom_docTrace
539 |
540 \---------------------------------------------------------------------------*/
541 static
tcldom_docTrace(ClientData clientData,Tcl_Interp * interp,const char * name1,const char * name2,int flags)542 char * tcldom_docTrace (
543 ClientData clientData,
544 Tcl_Interp *interp,
545 const char *name1,
546 const char *name2,
547 int flags
548 )
549 {
550 domDeleteInfo *dinfo = (domDeleteInfo*) clientData;
551 domDocument *doc = dinfo->document;
552 char objCmdName[80];
553
554 DBG(fprintf(stderr, "--> tcldom_docTrace %x %p\n", flags, doc));
555
556 if (doc == NULL) {
557 if (!(flags & TCL_INTERP_DESTROYED)) {
558 Tcl_UntraceVar(dinfo->interp, dinfo->traceVarName,
559 TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
560 tcldom_docTrace, clientData);
561 }
562 FREE (dinfo->traceVarName);
563 FREE (dinfo);
564 return NULL;
565 }
566 if (flags & TCL_TRACE_WRITES) {
567 DOC_CMD(objCmdName, doc);
568 Tcl_SetVar2 (interp, name1, name2, objCmdName, TCL_LEAVE_ERR_MSG);
569 return "var is read-only";
570 }
571 if (flags & TCL_TRACE_UNSETS) {
572 DOC_CMD(objCmdName, doc);
573 DBG(fprintf(stderr, "--> tcldom_docTrace delete doc %p\n", doc));
574 Tcl_DeleteCommand(interp, objCmdName);
575 FREE (dinfo->traceVarName);
576 FREE (dinfo);
577 }
578
579 return NULL;
580 }
581
582 /*----------------------------------------------------------------------------
583 | UpdateStringOfTdomNode
584 |
585 \---------------------------------------------------------------------------*/
586 static void
UpdateStringOfTdomNode(Tcl_Obj * objPtr)587 UpdateStringOfTdomNode(
588 Tcl_Obj *objPtr)
589 {
590 char nodeName[80];
591 int len;
592
593 NODE_CMD(nodeName, objPtr->internalRep.otherValuePtr);
594 len = strlen(nodeName);
595 objPtr->bytes = (ckalloc((unsigned char) len+1));
596 memcpy(objPtr->bytes, nodeName, len+1);
597 objPtr->length = len;
598 }
599
600 /*----------------------------------------------------------------------------
601 | SetTdomNodeFromAny
602 |
603 \---------------------------------------------------------------------------*/
604 static int
SetTdomNodeFromAny(Tcl_Interp * interp,Tcl_Obj * objPtr)605 SetTdomNodeFromAny(
606 Tcl_Interp *interp, /* Tcl interpreter or NULL */
607 Tcl_Obj *objPtr) /* Pointer to the object to parse */
608 {
609 Tcl_CmdInfo cmdInfo;
610 domNode *node = NULL;
611 char *nodeName;
612 char eolcheck;
613
614 if (objPtr->typePtr == &tdomNodeType) {
615 return TCL_OK;
616 }
617
618 nodeName = Tcl_GetString(objPtr);
619 if (strncmp(nodeName, "domNode", 7)) {
620 if (interp) {
621 SetResult3("Parameter \"", nodeName, "\" is not a domNode.");
622 return TCL_ERROR;
623 }
624 }
625 if (sscanf(&nodeName[7], "%p%1c", (void **)&node, &eolcheck) != 1) {
626 if (!Tcl_GetCommandInfo(interp, nodeName, &cmdInfo)) {
627 if (interp) {
628 SetResult3("Parameter \"", nodeName, "\" is not a domNode.");
629 return TCL_ERROR;
630 }
631 }
632 if ( (cmdInfo.isNativeObjectProc == 0)
633 || (cmdInfo.objProc != (Tcl_ObjCmdProc*)tcldom_NodeObjCmd)) {
634 if (interp) {
635 SetResult3("Parameter \"", nodeName, "\" is not a domNode"
636 " object command");
637 return TCL_ERROR;
638 }
639 }
640 node = (domNode*)cmdInfo.objClientData;
641 }
642 if (objPtr->typePtr && objPtr->typePtr->freeIntRepProc) {
643 objPtr->typePtr->freeIntRepProc(objPtr);
644 }
645 objPtr->internalRep.otherValuePtr = node;
646 objPtr->typePtr = &tdomNodeType;
647
648 return TCL_OK;
649 }
650
651 /*----------------------------------------------------------------------------
652 | tcldom_createNodeObj
653 |
654 \---------------------------------------------------------------------------*/
tcldom_createNodeObj(Tcl_Interp * interp,domNode * node,char * objCmdName)655 void tcldom_createNodeObj (
656 Tcl_Interp * interp,
657 domNode * node,
658 char * objCmdName
659 )
660 {
661 GetTcldomTSD()
662
663 NODE_CMD(objCmdName, node);
664
665 if (TSD(dontCreateObjCommands) == 0) {
666 DBG(fprintf(stderr,"--> creating node %s\n", objCmdName));
667
668 Tcl_CreateObjCommand(interp, objCmdName,
669 (Tcl_ObjCmdProc *) tcldom_NodeObjCmd,
670 (ClientData) node,
671 (Tcl_CmdDeleteProc*)NULL);
672 node->nodeFlags |= VISIBLE_IN_TCL;
673 }
674 }
675
676 /*----------------------------------------------------------------------------
677 | tcldom_setInterpAndReturnVar
678 |
679 \---------------------------------------------------------------------------*/
680 static
tcldom_setInterpAndReturnVar(Tcl_Interp * interp,domNode * node,int setVariable,Tcl_Obj * var_name)681 int tcldom_setInterpAndReturnVar (
682 Tcl_Interp *interp,
683 domNode *node,
684 int setVariable,
685 Tcl_Obj *var_name
686 )
687 {
688 char objCmdName[80];
689 Tcl_Obj *resultObj;
690
691 GetTcldomTSD()
692
693 if (node == NULL) {
694 if (setVariable) {
695 if (!Tcl_ObjSetVar2 (interp, var_name, NULL,
696 Tcl_NewStringObj("",0),
697 TCL_LEAVE_ERR_MSG)) {
698 return TCL_ERROR;
699 }
700 }
701 SetResult("");
702 return TCL_OK;
703 }
704 resultObj = Tcl_NewObj();
705 resultObj->bytes = NULL;
706 resultObj->length = 0;
707 resultObj->internalRep.otherValuePtr = node;
708 resultObj->typePtr = &tdomNodeType;
709 Tcl_SetObjResult (interp, resultObj);
710 if (TSD(dontCreateObjCommands) == 0) {
711 tcldom_createNodeObj(interp, node, objCmdName);
712 }
713 if (setVariable) {
714 if (!Tcl_ObjSetVar2 (interp, var_name, NULL, resultObj,
715 TCL_LEAVE_ERR_MSG)) {
716 return TCL_ERROR;
717 }
718 }
719 return TCL_OK;
720 }
721
722 /*----------------------------------------------------------------------------
723 | tcldom_returnNodeObj
724 |
725 \---------------------------------------------------------------------------*/
726 static
tcldom_returnNodeObj(Tcl_Interp * interp,domNode * node)727 Tcl_Obj *tcldom_returnNodeObj (
728 Tcl_Interp *interp,
729 domNode *node)
730 {
731 char objCmdName[80];
732 Tcl_Obj *resultObj;
733
734 GetTcldomTSD()
735
736 resultObj = Tcl_NewObj();
737 if (node == NULL) {
738 return resultObj;
739 }
740 if (TSD(dontCreateObjCommands) == 0) {
741 tcldom_createNodeObj(interp, node, objCmdName);
742 }
743 resultObj->bytes = NULL;
744 resultObj->length = 0;
745 resultObj->internalRep.otherValuePtr = node;
746 resultObj->typePtr = &tdomNodeType;
747 return resultObj;
748 }
749
750 /*----------------------------------------------------------------------------
751 | tcldom_returnDocumentObj
752 |
753 \---------------------------------------------------------------------------*/
tcldom_returnDocumentObj(Tcl_Interp * interp,domDocument * document,int setVariable,Tcl_Obj * var_name,int trace,int forOwnerDocument)754 int tcldom_returnDocumentObj (
755 Tcl_Interp *interp,
756 domDocument *document,
757 int setVariable,
758 Tcl_Obj *var_name,
759 int trace,
760 int forOwnerDocument
761 )
762 {
763 char objCmdName[80], *objVar;
764 domDeleteInfo *dinfo;
765 Tcl_CmdInfo cmd_info;
766
767 GetTcldomTSD()
768
769 if (document == NULL) {
770 if (setVariable) {
771 objVar = Tcl_GetString(var_name);
772 Tcl_UnsetVar(interp, objVar, 0);
773 Tcl_SetVar (interp, objVar, "", 0);
774 }
775 SetResult("");
776 return TCL_OK;
777 }
778
779 DOC_CMD(objCmdName, document);
780
781 if (TSD(dontCreateObjCommands)) {
782 if (setVariable) {
783 objVar = Tcl_GetString(var_name);
784 Tcl_SetVar(interp, objVar, objCmdName, 0);
785 }
786 } else {
787 if (!Tcl_GetCommandInfo(interp, objCmdName, &cmd_info)) {
788 dinfo = (domDeleteInfo*)MALLOC(sizeof(domDeleteInfo));
789 dinfo->interp = interp;
790 dinfo->document = document;
791 document->nodeFlags |= DOCUMENT_CMD;
792 dinfo->traceVarName = NULL;
793 Tcl_CreateObjCommand(interp, objCmdName,
794 (Tcl_ObjCmdProc *) tcldom_DocObjCmd,
795 (ClientData) dinfo,
796 (Tcl_CmdDeleteProc*)tcldom_docCmdDeleteProc);
797 } else {
798 dinfo = (domDeleteInfo*)cmd_info.objClientData;
799 }
800 if (setVariable) {
801 objVar = Tcl_GetString(var_name);
802 Tcl_UnsetVar(interp, objVar, 0);
803 Tcl_SetVar (interp, objVar, objCmdName, 0);
804 if (trace) {
805 document->nodeFlags |= VAR_TRACE;
806 dinfo->traceVarName = tdomstrdup(objVar);
807 Tcl_TraceVar(interp,objVar,TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
808 (Tcl_VarTraceProc*)tcldom_docTrace,
809 (ClientData)dinfo);
810 }
811 }
812 }
813
814 if (!forOwnerDocument) {
815 TDomThreaded(tcldom_RegisterDocShared(document));
816 }
817 SetResult(objCmdName);
818
819 return TCL_OK;
820 }
821
822
823 /*----------------------------------------------------------------------------
824 | tcldom_getElementsByTagName
825 |
826 \---------------------------------------------------------------------------*/
827 static int
tcldom_getElementsByTagName(Tcl_Interp * interp,char * namePattern,domNode * node,int nsIndex,const char * uri)828 tcldom_getElementsByTagName (
829 Tcl_Interp *interp,
830 char *namePattern,
831 domNode *node,
832 int nsIndex,
833 const char *uri
834 )
835 {
836 int result;
837 domNode *child;
838 char prefix[MAX_PREFIX_LEN];
839 const char *localName;
840 Tcl_Obj *namePtr, *resultPtr;
841
842 /* nsIndex == -1 ==> DOM 1 no NS i.e getElementsByTagName
843 nsIndex != -1 are the NS aware cases
844 nsIndex == -2 ==> more than one namespace in the document with the
845 requested namespace, we have to strcmp the URI
846 with the namespace uri of every node
847 nsIndex == -3 ==> NS wildcard '*'
848 nsIndex == -4 ==> special handled case uri == "", i.e. all
849 nodes not in a namespace */
850
851 while (node) {
852 if (node->nodeType != ELEMENT_NODE) {
853 node = node->nextSibling;
854 continue;
855 }
856 if ( (nsIndex == -1)
857 || (nsIndex == (int)node->namespace)
858 || (nsIndex == -3)
859 || (nsIndex == -2
860 && node->namespace
861 && strcmp(uri, domNamespaceURI (node)) == 0)
862 || (nsIndex == -4
863 && (!node->namespace
864 || strcmp ("", domNamespaceURI (node))==0)) )
865 {
866 if (nsIndex == -1) {
867 localName = node->nodeName;
868 } else {
869 domSplitQName(node->nodeName, prefix, &localName);
870 }
871 if (Tcl_StringMatch(localName, namePattern)) {
872 resultPtr = Tcl_GetObjResult(interp);
873 namePtr = tcldom_returnNodeObj(interp, node);
874 result = Tcl_ListObjAppendElement(interp, resultPtr, namePtr);
875 if (result != TCL_OK) {
876 Tcl_DecrRefCount(namePtr);
877 return result;
878 }
879 }
880 }
881
882 /* recurs to the child nodes */
883 child = node->firstChild;
884 result = tcldom_getElementsByTagName(interp, namePattern, child,
885 nsIndex, uri);
886 if (result != TCL_OK) {
887 return result;
888 }
889 node = node->nextSibling;
890 }
891
892 return TCL_OK;
893 }
894
895
896 /*----------------------------------------------------------------------------
897 | tcldom_find
898 |
899 \---------------------------------------------------------------------------*/
900 static
tcldom_find(domNode * node,char * attrName,char * attrVal,int length)901 domNode * tcldom_find (
902 domNode *node,
903 char *attrName,
904 char *attrVal,
905 int length
906 )
907 {
908 domNode *child, *result;
909 domAttrNode *attrs;
910
911 if (node->nodeType != ELEMENT_NODE) return NULL;
912
913 attrs = node->firstAttr;
914 while (attrs) {
915 if ((strcmp(attrs->nodeName, attrName)==0) &&
916 (length == attrs->valueLength) &&
917 (strncmp(attrs->nodeValue, attrVal, length)==0)) {
918
919 return node;
920 }
921 attrs = attrs->nextSibling;
922 }
923 child = node->firstChild;
924 while (child != NULL) {
925
926 result = tcldom_find(child, attrName, attrVal, length);
927 if (result != NULL) {
928 return result;
929 }
930 child = child->nextSibling;
931 }
932 return NULL;
933 }
934
935
936 /*----------------------------------------------------------------------------
937 | tcldom_xpointerAddCallback
938 |
939 \---------------------------------------------------------------------------*/
940 static
tcldom_xpointerAddCallback(domNode * node,void * clientData)941 int tcldom_xpointerAddCallback (
942 domNode * node,
943 void * clientData
944 )
945 {
946 Tcl_Interp * interp = (Tcl_Interp*)clientData;
947 Tcl_Obj * resultPtr = Tcl_GetObjResult(interp);
948 Tcl_Obj * namePtr;
949 int result;
950
951
952 namePtr = tcldom_returnNodeObj(interp, node);
953 result = Tcl_ListObjAppendElement(interp, resultPtr, namePtr);
954 if (result != TCL_OK) {
955 Tcl_DecrRefCount(namePtr);
956 }
957 return result;
958 }
959
960
961 /*----------------------------------------------------------------------------
962 | tcldom_xpointerSearch
963 |
964 \---------------------------------------------------------------------------*/
965 static
tcldom_xpointerSearch(Tcl_Interp * interp,int mode,domNode * node,int objc,Tcl_Obj * const objv[])966 int tcldom_xpointerSearch (
967 Tcl_Interp * interp,
968 int mode,
969 domNode * node,
970 int objc,
971 Tcl_Obj * const objv[]
972 )
973 {
974 char *str;
975 int i = 0;
976 int result = 0;
977 int all = 0;
978 int instance = 0;
979 int type = ELEMENT_NODE;
980 char *element = NULL;
981 char *attrName = NULL;
982 char *attrValue = NULL;
983 int attrLen;
984
985
986 str = Tcl_GetString(objv[2]);
987 if (strcmp(str, "all")==0) {
988 all = 1;
989 } else {
990 if (Tcl_GetIntFromObj(interp, objv[2], &instance) != TCL_OK) {
991 SetResult( "instance must be integer or 'all'");
992 return TCL_ERROR;
993 }
994 }
995 if (objc > 3) {
996 str = Tcl_GetString(objv[3]);
997 if (*str == '#') {
998 if (strcmp(str,"#text")==0) {
999 type = TEXT_NODE;
1000 } else if (strcmp(str,"#cdata")==0) {
1001 type = CDATA_SECTION_NODE;
1002 } else if (strcmp(str,"#all")==0) {
1003 type = ALL_NODES;
1004 } else if (strcmp(str,"#element")==0) {
1005 type = ELEMENT_NODE;
1006 } else {
1007 SetResult( "wrong node type");
1008 return TCL_ERROR;
1009 }
1010 } else {
1011 element = str;
1012 }
1013 }
1014 if (objc >= 5) {
1015 if ((type != ELEMENT_NODE) && (type != ALL_NODES)) {
1016 SetResult( "Attribute search only for element nodes");
1017 return TCL_ERROR;
1018 }
1019 attrName = Tcl_GetString(objv[4]);
1020 if (objc == 6) {
1021 attrValue = Tcl_GetStringFromObj(objv[5], &attrLen);
1022 } else {
1023 attrValue = "*";
1024 attrLen = 1;
1025 }
1026 }
1027 Tcl_ResetResult(interp);
1028 switch (mode) {
1029 case XP_CHILD:
1030 result = domXPointerChild
1031 (node, all, instance, type, element, attrName,
1032 attrValue, attrLen, tcldom_xpointerAddCallback, interp);
1033 break;
1034
1035 case XP_DESCENDANT:
1036 result = domXPointerDescendant
1037 (node, all, instance, &i, type, element, attrName,
1038 attrValue, attrLen, tcldom_xpointerAddCallback, interp);
1039 break;
1040
1041 case XP_ANCESTOR:
1042 result = domXPointerAncestor
1043 (node, all, instance, &i, type, element, attrName,
1044 attrValue, attrLen, tcldom_xpointerAddCallback, interp);
1045 break;
1046
1047 case XP_FSIBLING:
1048 result = domXPointerXSibling
1049 (node, 1, all, instance, type, element, attrName,
1050 attrValue, attrLen, tcldom_xpointerAddCallback, interp);
1051 break;
1052
1053 case XP_PSIBLING:
1054 result = domXPointerXSibling
1055 (node, 0, all, instance, type, element, attrName,
1056 attrValue, attrLen, tcldom_xpointerAddCallback, interp);
1057 break;
1058 }
1059 if (result != 0) {
1060 return TCL_ERROR;
1061 }
1062 return TCL_OK;
1063 }
1064
1065
1066 /*----------------------------------------------------------------------------
1067 | tcldom_getNodeFromObj
1068 |
1069 \---------------------------------------------------------------------------*/
tcldom_getNodeFromObj(Tcl_Interp * interp,Tcl_Obj * nodeObj)1070 domNode * tcldom_getNodeFromObj (
1071 Tcl_Interp *interp,
1072 Tcl_Obj *nodeObj
1073 )
1074 {
1075 Tcl_CmdInfo cmdInfo;
1076 domNode *node = NULL;
1077 char *nodeName;
1078 char eolcheck;
1079
1080 GetTcldomTSD()
1081
1082 if (nodeObj->typePtr == &tdomNodeType) {
1083 return (domNode*)nodeObj->internalRep.otherValuePtr;
1084 }
1085
1086 if (TSD(dontCreateObjCommands)) {
1087 if (SetTdomNodeFromAny (interp, nodeObj) == TCL_OK) {
1088 return (domNode*)nodeObj->internalRep.otherValuePtr;
1089 }
1090 return NULL;
1091 }
1092
1093 nodeName = Tcl_GetString(nodeObj);
1094 if (strncmp(nodeName, "domNode", 7)) {
1095 SetResult3("Parameter \"", nodeName, "\" is not a domNode.");
1096 return NULL;
1097 }
1098 if (sscanf(&nodeName[7], "%p%1c", (void **)&node, &eolcheck) != 1) {
1099 if (!Tcl_GetCommandInfo(interp, nodeName, &cmdInfo)) {
1100 SetResult3("Parameter \"", nodeName, "\" is not a domNode.");
1101 return NULL;
1102 }
1103 if ( (cmdInfo.isNativeObjectProc == 0)
1104 || (cmdInfo.objProc != (Tcl_ObjCmdProc*)tcldom_NodeObjCmd)) {
1105 SetResult3("Parameter \"", nodeName, "\" is not a domNode"
1106 " object command.");
1107 return NULL;
1108 }
1109 node = (domNode*)cmdInfo.objClientData;
1110 }
1111
1112 return node;
1113 }
1114
1115 /*----------------------------------------------------------------------------
1116 | tcldom_getNodeFromName
1117 |
1118 \---------------------------------------------------------------------------*/
tcldom_getNodeFromName(Tcl_Interp * interp,char * nodeName,char ** errMsg)1119 domNode * tcldom_getNodeFromName (
1120 Tcl_Interp *interp,
1121 char *nodeName,
1122 char **errMsg
1123 )
1124 {
1125 Tcl_CmdInfo cmdInfo;
1126 domNode *node = NULL;
1127 char eolcheck;
1128
1129 if (strncmp(nodeName, "domNode", 7)) {
1130 *errMsg = "parameter not a domNode!";
1131 return NULL;
1132 }
1133 if (sscanf(&nodeName[7], "%p%1c", (void **)&node, &eolcheck) != 1) {
1134 if (!Tcl_GetCommandInfo(interp, nodeName, &cmdInfo)) {
1135 *errMsg = "parameter not a domNode!";
1136 return NULL;
1137 }
1138 if ( (cmdInfo.isNativeObjectProc == 0)
1139 || (cmdInfo.objProc != (Tcl_ObjCmdProc*)tcldom_NodeObjCmd)) {
1140 *errMsg = "parameter not a domNode object command!";
1141 return NULL;
1142 }
1143 node = (domNode*)cmdInfo.objClientData;
1144 }
1145
1146 return node;
1147 }
1148
1149 /*----------------------------------------------------------------------------
1150 | tcldom_getDocumentFromName
1151 |
1152 \---------------------------------------------------------------------------*/
tcldom_getDocumentFromName(Tcl_Interp * interp,char * docName,char ** errMsg)1153 domDocument * tcldom_getDocumentFromName (
1154 Tcl_Interp *interp,
1155 char *docName,
1156 char **errMsg
1157 )
1158 {
1159 Tcl_CmdInfo cmdInfo;
1160 domDocument *doc = NULL;
1161 int shared = 1;
1162 char eolcheck;
1163
1164 if (strncmp(docName, "domDoc", 6)) {
1165 *errMsg = "parameter not a domDoc!";
1166 return NULL;
1167 }
1168 if (sscanf(&docName[6], "%p%1c", (void **)&doc, &eolcheck) != 1) {
1169 if (!Tcl_GetCommandInfo(interp, docName, &cmdInfo)) {
1170 *errMsg = "parameter not a domDoc!";
1171 return NULL;
1172 }
1173 if ( (cmdInfo.isNativeObjectProc == 0)
1174 || (cmdInfo.objProc != (Tcl_ObjCmdProc*)tcldom_DocObjCmd)) {
1175 *errMsg = "parameter not a domDoc object command!";
1176 return NULL;
1177 }
1178 doc = ((domDeleteInfo*)cmdInfo.objClientData)->document;
1179 }
1180
1181 TDomThreaded(shared = tcldom_CheckDocShared(doc));
1182
1183 if (!shared) {
1184 *errMsg = "parameter not a shared domDoc!";
1185 return NULL;
1186 }
1187
1188 return doc;
1189 }
1190
1191
1192 /*----------------------------------------------------------------------------
1193 | tcldom_appendXML
1194 |
1195 \---------------------------------------------------------------------------*/
tcldom_appendXML(Tcl_Interp * interp,domNode * node,Tcl_Obj * obj)1196 int tcldom_appendXML (
1197 Tcl_Interp *interp,
1198 domNode *node,
1199 Tcl_Obj *obj
1200 )
1201 {
1202 char *xml_string;
1203 Tcl_Obj *extResolver = NULL;
1204 int xml_string_len;
1205 int resultcode = 0;
1206 int ignorexmlns = 0;
1207 domDocument *doc;
1208 domNode *nodeToAppend;
1209 XML_Parser parser;
1210
1211 GetTcldomTSD()
1212
1213 xml_string = Tcl_GetStringFromObj(obj, &xml_string_len);
1214
1215 #ifdef TDOM_NO_EXPAT
1216 SetResult("tDOM was compiled without Expat!");
1217 return TCL_ERROR;
1218 #else
1219 parser = XML_ParserCreate_MM(NULL, MEM_SUITE, NULL);
1220
1221 if (node->ownerDocument->extResolver) {
1222 extResolver = Tcl_NewStringObj(node->ownerDocument->extResolver, -1);
1223 Tcl_IncrRefCount (extResolver);
1224 }
1225 if (node->ownerDocument->nodeFlags & IGNORE_XMLNS) {
1226 ignorexmlns = 1;
1227 }
1228
1229 doc = domReadDocument(parser,
1230 xml_string,
1231 xml_string_len,
1232 1,
1233 0,
1234 TSD(storeLineColumn),
1235 ignorexmlns,
1236 0,
1237 NULL,
1238 NULL,
1239 NULL,
1240 extResolver,
1241 0,
1242 (int) XML_PARAM_ENTITY_PARSING_ALWAYS,
1243 interp,
1244 &resultcode);
1245 if (extResolver) {
1246 Tcl_DecrRefCount(extResolver);
1247 }
1248 if (doc == NULL) {
1249 char s[50];
1250 long byteIndex, i;
1251
1252 Tcl_ResetResult(interp);
1253 sprintf(s, "%ld", XML_GetCurrentLineNumber(parser));
1254 Tcl_AppendResult(interp, "error \"",
1255 XML_ErrorString(XML_GetErrorCode(parser)),
1256 "\" at line ", s, " character ", NULL);
1257 sprintf(s, "%ld", XML_GetCurrentColumnNumber(parser));
1258 Tcl_AppendResult(interp, s, NULL);
1259 byteIndex = XML_GetCurrentByteIndex(parser);
1260 if (byteIndex != -1) {
1261 Tcl_AppendResult(interp, "\n\"", NULL);
1262 s[1] = '\0';
1263 for (i=-20; i < 40; i++) {
1264 if ((byteIndex+i)>=0) {
1265 if (xml_string[byteIndex+i]) {
1266 s[0] = xml_string[byteIndex+i];
1267 Tcl_AppendResult(interp, s, NULL);
1268 if (i==0) {
1269 Tcl_AppendResult(interp, " <--Error-- ", NULL);
1270 }
1271 } else {
1272 break;
1273 }
1274 }
1275 }
1276 Tcl_AppendResult(interp, "\"",NULL);
1277 }
1278 XML_ParserFree(parser);
1279 return TCL_ERROR;
1280 }
1281 XML_ParserFree(parser);
1282
1283
1284 nodeToAppend = doc->rootNode->firstChild;
1285 while (nodeToAppend) {
1286 domAppendChild(node, nodeToAppend);
1287 nodeToAppend = nodeToAppend->nextSibling;
1288 }
1289 domFreeDocument(doc, NULL, NULL);
1290
1291 return tcldom_setInterpAndReturnVar(interp, node, 0, NULL);
1292 #endif
1293 }
1294
1295
1296 /*----------------------------------------------------------------------------
1297 | tcldom_xpathResultSet
1298 |
1299 \---------------------------------------------------------------------------*/
1300 static
tcldom_xpathResultSet(Tcl_Interp * interp,xpathResultSet * rs,Tcl_Obj * type,Tcl_Obj * value)1301 int tcldom_xpathResultSet (
1302 Tcl_Interp *interp,
1303 xpathResultSet *rs,
1304 Tcl_Obj *type,
1305 Tcl_Obj *value
1306 )
1307 {
1308 int rc, i;
1309 Tcl_Obj *namePtr, *objv[2];
1310 domAttrNode *attr;
1311 domNodeType startType;
1312 int mixedNodeSet;
1313
1314 switch (rs->type) {
1315 case EmptyResult:
1316 Tcl_SetStringObj(type, "empty", -1);
1317 Tcl_SetStringObj(value, "", -1);
1318 break;
1319
1320 case BoolResult:
1321 Tcl_SetStringObj(type, "bool", -1);
1322 Tcl_SetIntObj(value, rs->intvalue);
1323 break;
1324
1325 case IntResult:
1326 Tcl_SetStringObj(type, "number", -1);
1327 Tcl_SetIntObj(value, rs->intvalue);
1328 break;
1329
1330 case RealResult:
1331 Tcl_SetStringObj(type, "number", -1);
1332 Tcl_SetDoubleObj(value, rs->realvalue);
1333 break;
1334
1335 case NaNResult:
1336 Tcl_SetStringObj(type, "number", -1);
1337 Tcl_SetStringObj(value, "NaN", -1);
1338 break;
1339
1340 case InfResult:
1341 Tcl_SetStringObj(type, "number", -1);
1342 Tcl_SetStringObj(value, "Infinity", -1);
1343 break;
1344
1345 case NInfResult:
1346 Tcl_SetStringObj(type, "number", -1);
1347 Tcl_SetStringObj(value, "-Infinity", -1);
1348 break;
1349
1350 case StringResult:
1351 Tcl_SetStringObj(type, "string", -1);
1352 Tcl_SetStringObj(value, rs->string, rs->string_len);
1353 break;
1354
1355 case xNodeSetResult:
1356 startType = rs->nodes[0]->nodeType;
1357 mixedNodeSet = 0;
1358 for (i=0; i<rs->nr_nodes; i++) {
1359 if (rs->nodes[i]->nodeType != startType) mixedNodeSet = 1;
1360
1361 if (rs->nodes[i]->nodeType == ATTRIBUTE_NODE) {
1362 attr = (domAttrNode*)rs->nodes[i];
1363 objv[0] = Tcl_NewStringObj(attr->nodeName, -1);
1364 objv[1] = Tcl_NewStringObj(attr->nodeValue,
1365 attr->valueLength);
1366 namePtr = Tcl_NewListObj(2, objv);
1367 } else {
1368 namePtr = tcldom_returnNodeObj(interp, rs->nodes[i]);
1369 }
1370 rc = Tcl_ListObjAppendElement(interp, value, namePtr);
1371 if (rc != TCL_OK) {
1372 Tcl_DecrRefCount(namePtr);
1373 return rc;
1374 }
1375 }
1376 if (mixedNodeSet) {
1377 Tcl_SetStringObj(type, "mixed", 5);
1378 } else {
1379 if (startType == ATTRIBUTE_NODE)
1380 Tcl_SetStringObj(type, "attrnodes",-1);
1381 else
1382 Tcl_SetStringObj(type, "nodes", 5);
1383 }
1384 break;
1385
1386 }
1387 return TCL_OK;
1388 }
1389
1390
1391 /*----------------------------------------------------------------------------
1392 | tcldom_xpathFuncCallBack
1393 |
1394 \---------------------------------------------------------------------------*/
1395 static
tcldom_xpathFuncCallBack(void * clientData,char * functionName,domNode * ctxNode,int position,xpathResultSet * nodeList,domNode * exprContext,int argc,xpathResultSets * args,xpathResultSet * result,char ** errMsg)1396 int tcldom_xpathFuncCallBack (
1397 void *clientData,
1398 char *functionName,
1399 domNode *ctxNode,
1400 int position,
1401 xpathResultSet *nodeList,
1402 domNode *exprContext,
1403 int argc,
1404 xpathResultSets *args,
1405 xpathResultSet *result,
1406 char **errMsg
1407 )
1408 {
1409 Tcl_Interp *interp = (Tcl_Interp*) clientData;
1410 char tclxpathFuncName[200], objCmdName[80];
1411 char *errStr, *typeStr;
1412 Tcl_Obj *resultPtr, *objv[MAX_REWRITE_ARGS], *type, *value, *nodeObj,
1413 *tmpObj;
1414 Tcl_CmdInfo cmdInfo;
1415 int objc, rc, i, errStrLen, listLen, intValue, res;
1416 double doubleValue;
1417 domNode *node;
1418
1419 DBG(fprintf(stderr, "tcldom_xpathFuncCallBack functionName=%s "
1420 "position=%d argc=%d\n", functionName, position, argc);)
1421
1422 if (strlen(functionName) > 199) {
1423 *errMsg = (char*)MALLOC (80 + strlen (functionName));
1424 strcpy (*errMsg, "Unreasonable long XPath function name: \"");
1425 strcat (*errMsg, functionName);
1426 strcat (*errMsg, "\"!");
1427 return XPATH_EVAL_ERR;
1428 }
1429 sprintf (tclxpathFuncName, "::dom::xpathFunc::%s", functionName);
1430 DBG(fprintf(stderr, "testing %s\n", tclxpathFuncName);)
1431 rc = Tcl_GetCommandInfo (interp, tclxpathFuncName, &cmdInfo);
1432 if (!rc) {
1433 *errMsg = (char*)MALLOC (80 + strlen (functionName));
1434 strcpy (*errMsg, "Unknown XPath function: \"");
1435 strcat (*errMsg, functionName);
1436 strcat (*errMsg, "\"!");
1437 return XPATH_EVAL_ERR;
1438 }
1439 if (!cmdInfo.isNativeObjectProc) {
1440 *errMsg = (char*)tdomstrdup("can't access Tcl level method!");
1441 return XPATH_EVAL_ERR;
1442 }
1443 if ( (5+(2*argc)) >= MAX_REWRITE_ARGS) {
1444 *errMsg = (char*)tdomstrdup("too many args for Tcl level method!");
1445 return XPATH_EVAL_ERR;
1446 }
1447 objc = 0;
1448 objv[objc] = Tcl_NewStringObj(tclxpathFuncName, -1);
1449 Tcl_IncrRefCount(objv[objc++]);
1450 if (ctxNode->nodeType == ATTRIBUTE_NODE) {
1451 tcldom_createNodeObj(interp, ((domAttrNode*)ctxNode)->parentNode,
1452 objCmdName);
1453 tmpObj = Tcl_NewListObj(0, NULL);
1454 Tcl_ListObjAppendElement(interp, tmpObj,
1455 Tcl_NewStringObj(objCmdName, -1));
1456 Tcl_ListObjAppendElement(
1457 interp, tmpObj,
1458 Tcl_NewStringObj(((domAttrNode*)ctxNode)->nodeName, -1));
1459 } else {
1460 tmpObj = tcldom_returnNodeObj(interp, ctxNode);
1461 }
1462 objv[objc] = tmpObj;
1463 Tcl_IncrRefCount(objv[objc++]);
1464
1465 objv[objc] = Tcl_NewIntObj(position);
1466 Tcl_IncrRefCount(objv[objc++]);
1467
1468 type = Tcl_NewObj();
1469 value = Tcl_NewObj();
1470 tcldom_xpathResultSet(interp, nodeList, type, value);
1471 objv[objc] = type;
1472 Tcl_IncrRefCount(objv[objc++]);
1473 objv[objc] = value;
1474 Tcl_IncrRefCount(objv[objc++]);
1475
1476 for (i=0; i<argc; i++) {
1477 type = Tcl_NewObj();
1478 value = Tcl_NewObj();
1479 tcldom_xpathResultSet(interp, args[i], type, value);
1480 objv[objc] = type;
1481 Tcl_IncrRefCount(objv[objc++]);
1482 objv[objc] = value;
1483 Tcl_IncrRefCount(objv[objc++]);
1484 }
1485 rc = (cmdInfo.objProc(cmdInfo.objClientData, interp, objc, objv));
1486 if (rc == TCL_OK) {
1487 xpathRSInit(result);
1488 resultPtr = Tcl_GetObjResult(interp);
1489 rc = Tcl_ListObjLength(interp, resultPtr, &listLen);
1490 if (rc == TCL_OK) {
1491 if (listLen == 1) {
1492 rsSetString(result, Tcl_GetString(resultPtr));
1493 res = XPATH_OK;
1494 Tcl_ResetResult(interp);
1495 goto funcCallCleanup;
1496 }
1497 if (listLen != 2) {
1498 *errMsg = (char*)tdomstrdup("wrong return tuple; "
1499 "must be {type value}!");
1500 res = XPATH_EVAL_ERR;
1501 goto funcCallCleanup;
1502 }
1503 rc = Tcl_ListObjIndex(interp, resultPtr, 0, &type);
1504 rc = Tcl_ListObjIndex(interp, resultPtr, 1, &value);
1505 typeStr = Tcl_GetString(type);
1506 if (strcmp(typeStr, "bool")==0) {
1507 rc = Tcl_GetBooleanFromObj(interp, value, &intValue);
1508 rsSetBool(result, intValue );
1509 } else
1510 if (strcmp(typeStr, "number")==0) {
1511 rc = Tcl_GetIntFromObj(interp, value, &intValue);
1512 if (rc == TCL_OK) {
1513 rsSetInt(result, intValue);
1514 } else {
1515 rc = Tcl_GetDoubleFromObj(interp, value, &doubleValue);
1516 rsSetReal(result, doubleValue);
1517 }
1518 } else
1519 if (strcmp(typeStr, "string")==0) {
1520 rsSetString(result, Tcl_GetString(value));
1521 } else
1522 if (strcmp(typeStr, "nodes")==0) {
1523 rc = Tcl_ListObjLength(interp, value, &listLen);
1524 if (rc != TCL_OK) {
1525 *errMsg = tdomstrdup("value not a node list!");
1526 res = XPATH_EVAL_ERR;
1527 goto funcCallCleanup;
1528 }
1529 for (i=0; i < listLen; i++) {
1530 rc = Tcl_ListObjIndex(interp, value, i, &nodeObj);
1531 node = tcldom_getNodeFromObj(interp, nodeObj);
1532 if (node == NULL) {
1533 *errMsg = tdomstrdup(Tcl_GetStringResult(interp));
1534 res = XPATH_EVAL_ERR;
1535 goto funcCallCleanup;
1536 }
1537 rsAddNode(result, node);
1538 }
1539 sortByDocOrder(result);
1540 } else
1541 if (strcmp(typeStr, "attrnodes")==0) {
1542 *errMsg = tdomstrdup("attrnodes not implemented yet!");
1543 res = XPATH_EVAL_ERR;
1544 goto funcCallCleanup;
1545 } else
1546 if (strcmp(typeStr, "attrvalues")==0) {
1547 rsSetString(result, Tcl_GetString(value));
1548 } else {
1549 *errMsg = (char*)MALLOC (80 + strlen (typeStr)
1550 + strlen (functionName));
1551 strcpy(*errMsg, "Unknown type of return value \"");
1552 strcat(*errMsg, typeStr);
1553 strcat(*errMsg, "\" from Tcl coded XPath function \"");
1554 strcat(*errMsg, functionName);
1555 strcat(*errMsg, "\"!");
1556 res = XPATH_EVAL_ERR;
1557 goto funcCallCleanup;
1558 }
1559 } else {
1560 DBG(fprintf(stderr, "ListObjLength != TCL_OK "
1561 "--> returning XPATH_EVAL_ERR \n");)
1562 res = XPATH_EVAL_ERR;
1563 goto funcCallCleanup;
1564 }
1565 Tcl_ResetResult(interp);
1566 res = XPATH_OK;
1567 } else {
1568 errStr = Tcl_GetStringFromObj( Tcl_GetObjResult(interp), &errStrLen);
1569 *errMsg = (char*)MALLOC(120+strlen(functionName) + errStrLen);
1570 strcpy(*errMsg, "Tcl error while executing XPath extension function '");
1571 strcat(*errMsg, functionName );
1572 strcat(*errMsg, "':\n" );
1573 strcat(*errMsg, errStr);
1574 Tcl_ResetResult(interp);
1575 DBG(fprintf(stderr, "returning XPATH_EVAL_ERR \n");)
1576 res = XPATH_EVAL_ERR;
1577 }
1578 funcCallCleanup:
1579 for (i = 0; i < objc; i++) {
1580 Tcl_DecrRefCount(objv[i]);
1581 }
1582 return res;
1583 }
1584
1585 /*----------------------------------------------------------------------------
1586 | tcldom_xsltMsgCB
1587 |
1588 \---------------------------------------------------------------------------*/
1589 static
tcldom_xsltMsgCB(void * clientData,char * str,int length,int terminate)1590 int tcldom_xsltMsgCB (
1591 void *clientData,
1592 char *str,
1593 int length,
1594 int terminate
1595 )
1596 {
1597 XsltMsgCBInfo *msgCBInfo = (XsltMsgCBInfo *)clientData;
1598 Tcl_Obj *cmdPtr;
1599 int rc;
1600
1601 if (msgCBInfo->msgcmd == NULL) {
1602 return 0;
1603 }
1604
1605 cmdPtr = Tcl_DuplicateObj(msgCBInfo->msgcmd);
1606 Tcl_IncrRefCount(cmdPtr);
1607 if (Tcl_ListObjAppendElement(msgCBInfo->interp, cmdPtr,
1608 Tcl_NewStringObj(str, length)) != TCL_OK) {
1609 Tcl_DecrRefCount(cmdPtr);
1610 return 1;
1611 }
1612 if (terminate) {
1613 Tcl_ListObjAppendElement(msgCBInfo->interp, cmdPtr,
1614 Tcl_NewBooleanObj(1));
1615 } else {
1616 Tcl_ListObjAppendElement(msgCBInfo->interp, cmdPtr,
1617 Tcl_NewBooleanObj(0));
1618 }
1619 rc = Tcl_GlobalEvalObj(msgCBInfo->interp, cmdPtr);
1620 Tcl_DecrRefCount(cmdPtr);
1621 switch (rc) {
1622 case TCL_OK: return 0;
1623 case TCL_BREAK: return 3;
1624 default: return rc;
1625 }
1626 }
1627
1628 /*----------------------------------------------------------------------------
1629 | tcldom_xpathResolveVar
1630 |
1631 \---------------------------------------------------------------------------*/
1632 static
tcldom_xpathResolveVar(void * clientData,char * strToParse,int * offset,char ** errMsg)1633 char * tcldom_xpathResolveVar (
1634 void *clientData,
1635 char *strToParse,
1636 int *offset,
1637 char **errMsg
1638 )
1639 {
1640 const char *varValue;
1641 const char *termPtr;
1642 Tcl_Interp *interp = (Tcl_Interp *) clientData;
1643
1644 *offset = 0;
1645 varValue = Tcl_ParseVar(interp, strToParse, &termPtr);
1646 if (varValue) {
1647 *offset = termPtr - strToParse;
1648 /* If strToParse start with a single '$' without a following
1649 * var name (according to Tcl var name rules), Tcl_ParseVar()
1650 * doesn't report a parsing error but returns just a pointer
1651 * to a static string "$". */
1652 if (*offset == 1) {
1653 *errMsg = tdomstrdup ("Missing var name after '$'.");
1654 varValue = NULL;
1655 }
1656 } else {
1657 *errMsg = tdomstrdup (Tcl_GetStringResult(interp));
1658 }
1659 Tcl_ResetResult (interp);
1660 return (char*)varValue;
1661 }
1662
1663 /*----------------------------------------------------------------------------
1664 | tcldom_selectNodes
1665 |
1666 \---------------------------------------------------------------------------*/
1667 static
tcldom_selectNodes(Tcl_Interp * interp,domNode * node,int objc,Tcl_Obj * const objv[])1668 int tcldom_selectNodes (
1669 Tcl_Interp *interp,
1670 domNode *node,
1671 int objc,
1672 Tcl_Obj *const objv[]
1673 )
1674 {
1675 char *xpathQuery, *typeVar, *option;
1676 char *errMsg = NULL, **mappings = NULL;
1677 int rc, i, len, optionIndex, localmapping = 0, cache = 0;
1678 int mappingListObjLen = 0;
1679 xpathResultSet rs;
1680 Tcl_Obj *type, *objPtr, *objPtr1, *mappingListObj = NULL;
1681 xpathCBs cbs;
1682 xpathParseVarCB parseVarCB;
1683
1684 static const char *selectNodesOptions[] = {
1685 "-namespaces", "-cache", NULL
1686 };
1687 enum selectNodesOption {
1688 o_namespaces, o_cache
1689 };
1690
1691 if (objc < 2) {
1692 SetResult("Wrong # of arguments.");
1693 return TCL_ERROR;
1694 }
1695 while (objc > 2) {
1696 option = Tcl_GetString (objv[1]);
1697 if (option[0] != '-') {
1698 break;
1699 }
1700 if (Tcl_GetIndexFromObj (NULL, objv[1], selectNodesOptions, "option",
1701 0, &optionIndex) != TCL_OK) {
1702 break;
1703 }
1704 switch ((enum selectNodesOption) optionIndex) {
1705 case o_namespaces:
1706 rc = Tcl_ListObjLength (interp, objv[2], &len);
1707 if (rc != TCL_OK || (len % 2) != 0) {
1708 SetResult ("The \"-namespaces\" option requires a 'prefix"
1709 " namespace' pairs list as argument");
1710 rc = TCL_ERROR;
1711 goto cleanup;
1712 }
1713 if (mappings) {
1714 for (i = 0; i < mappingListObjLen; i++) {
1715 Tcl_ListObjIndex (interp, mappingListObj, i, &objPtr1);
1716 Tcl_DecrRefCount (objPtr1);
1717 }
1718 Tcl_DecrRefCount (mappingListObj);
1719 FREE (mappings);
1720 }
1721 mappings = MALLOC (sizeof (char *) * (len + 1));
1722 localmapping = 1;
1723 for (i = 0; i < len; i++) {
1724 Tcl_ListObjIndex (interp, objv[2], i, &objPtr);
1725 Tcl_IncrRefCount (objPtr);
1726 mappings[i] = Tcl_GetString (objPtr);
1727 }
1728 mappings[len] = NULL;
1729 mappingListObj = objv[2];
1730 Tcl_IncrRefCount (mappingListObj);
1731 mappingListObjLen = len;
1732 objc -= 2;
1733 objv += 2;
1734 break;
1735
1736 case o_cache:
1737 if (Tcl_GetBooleanFromObj (interp, objv[2], &cache) != TCL_OK) {
1738 return TCL_ERROR;
1739 }
1740 objc -= 2;
1741 objv += 2;
1742 break;
1743
1744 default:
1745 Tcl_ResetResult (interp);
1746 Tcl_AppendResult (interp, "bad option \"",
1747 Tcl_GetString (objv[1]), "\"; must be "
1748 "-namespaces", NULL);
1749 return TCL_ERROR;
1750 }
1751 }
1752 if (objc != 2 && objc != 3) {
1753 SetResult("Wrong # of arguments.");
1754 rc = TCL_ERROR;
1755 goto cleanup;
1756 }
1757
1758 xpathQuery = Tcl_GetString(objv[1]);
1759
1760 xpathRSInit(&rs);
1761
1762 cbs.funcCB = tcldom_xpathFuncCallBack;
1763 cbs.funcClientData = interp;
1764 cbs.varCB = NULL;
1765 cbs.varClientData = NULL;
1766
1767 parseVarCB.parseVarCB = tcldom_xpathResolveVar;
1768 parseVarCB.parseVarClientData = interp;
1769
1770 if (mappings == NULL) {
1771 mappings = node->ownerDocument->prefixNSMappings;
1772 }
1773
1774 if (cache) {
1775 if (!node->ownerDocument->xpathCache) {
1776 node->ownerDocument->xpathCache = MALLOC (sizeof (Tcl_HashTable));
1777 Tcl_InitHashTable (node->ownerDocument->xpathCache,
1778 TCL_STRING_KEYS);
1779 }
1780 rc = xpathEval (node, node, xpathQuery, mappings, &cbs, &parseVarCB,
1781 node->ownerDocument->xpathCache, &errMsg, &rs);
1782 } else {
1783 rc = xpathEval (node, node, xpathQuery, mappings, &cbs, &parseVarCB,
1784 NULL, &errMsg, &rs);
1785 }
1786
1787 if (rc != XPATH_OK) {
1788 xpathRSFree(&rs);
1789 SetResult(errMsg);
1790 DBG(fprintf(stderr, "errMsg = %s \n", errMsg);)
1791 if (errMsg) {
1792 FREE(errMsg);
1793 }
1794 rc = TCL_ERROR;
1795 goto cleanup;
1796 }
1797 if (errMsg) {
1798 fprintf (stderr, "Why this: '%s'\n", errMsg);
1799 FREE(errMsg);
1800 }
1801 typeVar = NULL;
1802 if (objc > 2) {
1803 typeVar = Tcl_GetString(objv[2]);
1804 }
1805 type = Tcl_NewObj();
1806 Tcl_IncrRefCount(type);
1807 DBG(fprintf(stderr, "before tcldom_xpathResultSet \n");)
1808 tcldom_xpathResultSet(interp, &rs, type, Tcl_GetObjResult(interp));
1809 DBG(fprintf(stderr, "after tcldom_xpathResultSet \n");)
1810 if (typeVar) {
1811 Tcl_SetVar(interp,typeVar, Tcl_GetString(type), 0);
1812 }
1813 rc = TCL_OK;
1814 Tcl_DecrRefCount(type);
1815
1816 xpathRSFree( &rs );
1817 cleanup:
1818 if (localmapping) {
1819 for (i = 0; i < mappingListObjLen; i++) {
1820 Tcl_ListObjIndex (interp, mappingListObj, i, &objPtr1);
1821 Tcl_DecrRefCount (objPtr1);
1822 }
1823 Tcl_DecrRefCount (mappingListObj);
1824 FREE (mappings);
1825 }
1826 return rc;
1827 }
1828
1829 /*----------------------------------------------------------------------------
1830 | tcldom_nameCheck
1831 |
1832 \---------------------------------------------------------------------------*/
tcldom_nameCheck(Tcl_Interp * interp,char * name,char * nameType,int isFQName)1833 int tcldom_nameCheck (
1834 Tcl_Interp *interp,
1835 char *name,
1836 char *nameType,
1837 int isFQName
1838 )
1839 {
1840 int result;
1841
1842 if (isFQName) {
1843 result = domIsQNAME (name);
1844 } else {
1845 result = domIsNAME (name);
1846 }
1847 if (!result) {
1848 Tcl_ResetResult (interp);
1849 Tcl_AppendResult (interp, "Invalid ", nameType, " name '", name, "'",
1850 (char *) NULL);
1851 return 0;
1852 }
1853 return 1;
1854 }
1855
1856 /*----------------------------------------------------------------------------
1857 | tcldom_PINameCheck
1858 |
1859 \---------------------------------------------------------------------------*/
tcldom_PINameCheck(Tcl_Interp * interp,char * name)1860 int tcldom_PINameCheck (
1861 Tcl_Interp *interp,
1862 char *name
1863 )
1864 {
1865 /* XML rec, production 17 */
1866 if (!domIsPINAME (name)) {
1867 Tcl_ResetResult (interp);
1868 Tcl_AppendResult (interp, "Invalid processing instruction name '",
1869 name, "'", NULL);
1870 return 0;
1871 }
1872 return 1;
1873 }
1874
1875 /*----------------------------------------------------------------------------
1876 | tcldom_textCheck
1877 |
1878 \---------------------------------------------------------------------------*/
tcldom_textCheck(Tcl_Interp * interp,char * text,char * errText)1879 int tcldom_textCheck (
1880 Tcl_Interp *interp,
1881 char *text,
1882 char *errText
1883 )
1884 {
1885 if (!domIsChar (text)) {
1886 Tcl_ResetResult (interp);
1887 Tcl_AppendResult (interp, "Invalid ", errText, " value '", text, "'",
1888 (char *) NULL);
1889 return 0;
1890 }
1891 return 1;
1892 }
1893
1894
1895 /*----------------------------------------------------------------------------
1896 | tcldom_commentCheck
1897 |
1898 \---------------------------------------------------------------------------*/
tcldom_commentCheck(Tcl_Interp * interp,char * text)1899 int tcldom_commentCheck (
1900 Tcl_Interp *interp,
1901 char *text
1902 )
1903 {
1904 if (!domIsComment (text)) {
1905 Tcl_ResetResult (interp);
1906 Tcl_AppendResult (interp, "Invalid comment value '", text, "'",
1907 (char *) NULL);
1908 return 0;
1909 }
1910 return 1;
1911 }
1912
1913 /*----------------------------------------------------------------------------
1914 | tcldom_CDATACheck
1915 |
1916 \---------------------------------------------------------------------------*/
tcldom_CDATACheck(Tcl_Interp * interp,char * text)1917 int tcldom_CDATACheck (
1918 Tcl_Interp *interp,
1919 char *text
1920 )
1921 {
1922 if (!domIsCDATA (text)) {
1923 Tcl_ResetResult (interp);
1924 Tcl_AppendResult (interp, "Invalid CDATA section value '", text, "'",
1925 (char *) NULL);
1926 return 0;
1927 }
1928 return 1;
1929 }
1930
1931 /*----------------------------------------------------------------------------
1932 | tcldom_PIValueCheck
1933 |
1934 \---------------------------------------------------------------------------*/
tcldom_PIValueCheck(Tcl_Interp * interp,char * text)1935 int tcldom_PIValueCheck (
1936 Tcl_Interp *interp,
1937 char *text
1938 )
1939 {
1940 if (!domIsPIValue (text)) {
1941 Tcl_ResetResult (interp);
1942 Tcl_AppendResult (interp, "Invalid processing instruction value '",
1943 text, "'", (char *) NULL);
1944 return 0;
1945 }
1946 return 1;
1947 }
1948
1949 /*----------------------------------------------------------------------------
1950 | tcldom_appendFromTclList
1951 |
1952 \---------------------------------------------------------------------------*/
1953 static
tcldom_appendFromTclList(Tcl_Interp * interp,domNode * node,Tcl_Obj * obj)1954 int tcldom_appendFromTclList (
1955 Tcl_Interp *interp,
1956 domNode *node,
1957 Tcl_Obj *obj
1958 )
1959 {
1960 int i, rc, length, valueLength, attrLength, attrValueLength;
1961 int childListLength;
1962 Tcl_Obj *lnode, *tagNameObj, *piNameObj, *valueObj,
1963 *attrListObj, *attrObj, *childListObj, *childObj;
1964 char *tag_name, *pi_name, *value, *attrName, *attrValue;
1965 domNode *newnode;
1966
1967 GetTcldomTSD();
1968
1969 /*------------------------------------------------------------------------
1970 | check format of Tcl list node
1971 \-----------------------------------------------------------------------*/
1972 lnode = obj;
1973 if ((rc = Tcl_ListObjLength(interp, lnode, &length)) != TCL_OK) {
1974 return rc;
1975 }
1976 if ((length != 3) && (length != 2)) {
1977 SetResult( "invalid node list format!");
1978 return TCL_ERROR;
1979 }
1980
1981 /*------------------------------------------------------------------------
1982 | create node
1983 \-----------------------------------------------------------------------*/
1984 if ((rc = Tcl_ListObjIndex(interp, lnode, 0, &tagNameObj)) != TCL_OK) {
1985 return rc;
1986 }
1987 tag_name = Tcl_GetString(tagNameObj);
1988
1989 if ( (strcmp(tag_name,"#cdata")==0)
1990 || (strcmp(tag_name,"#text")==0)
1991 || (strcmp(tag_name,"#comment")==0) ) {
1992 if (length != 2) {
1993 SetResult( "invalid text or comment node list format!");
1994 return TCL_ERROR;
1995 }
1996 /*--------------------------------------------------------------------
1997 | create text node
1998 \-------------------------------------------------------------------*/
1999 if ((rc = Tcl_ListObjIndex(interp, lnode, 1, &valueObj)) != TCL_OK) {
2000 return rc;
2001 }
2002 value = Tcl_GetStringFromObj(valueObj, &valueLength);
2003 if (strcmp(tag_name, "#text")==0) {
2004 CheckText (interp, value, "text");
2005 newnode = (domNode*)domNewTextNode(node->ownerDocument, value,
2006 valueLength, TEXT_NODE);
2007 } else if (strcmp(tag_name, "#comment")==0) {
2008 CheckComment (interp, value);
2009 newnode = (domNode*)domNewTextNode(node->ownerDocument, value,
2010 valueLength, COMMENT_NODE);
2011 } else {
2012 CheckCDATA (interp, value);
2013 newnode = (domNode*)domNewTextNode(node->ownerDocument, value,
2014 valueLength, CDATA_SECTION_NODE);
2015 }
2016 domAppendChild(node, newnode);
2017 return TCL_OK;
2018 }
2019
2020 if (strcmp(tag_name,"#pi")==0) {
2021 if (length != 3) {
2022 SetResult( "invalid PI node list format!");
2023 return TCL_ERROR;
2024 }
2025 /*--------------------------------------------------------------------
2026 | create processing instruction node
2027 \-------------------------------------------------------------------*/
2028 if ((rc = Tcl_ListObjIndex(interp, lnode, 1, &piNameObj)) != TCL_OK) {
2029 return rc;
2030 }
2031 if ((rc = Tcl_ListObjIndex(interp, lnode, 2, &valueObj)) != TCL_OK) {
2032 return rc;
2033 }
2034 pi_name = Tcl_GetStringFromObj(piNameObj, &length);
2035 CheckPIName (interp, pi_name);
2036 value = Tcl_GetStringFromObj(valueObj, &valueLength);
2037 CheckPIValue (interp, value);
2038 newnode = (domNode*)domNewProcessingInstructionNode
2039 (node->ownerDocument, pi_name, length, value, valueLength);
2040
2041 domAppendChild(node, newnode);
2042 return TCL_OK;
2043 }
2044
2045 /*------------------------------------------------------------------------
2046 | create element node
2047 \-----------------------------------------------------------------------*/
2048 if (length != 3) {
2049 SetResult("invalid element node list format!");
2050 return TCL_ERROR;
2051 }
2052 CheckName (interp, tag_name, "tag", 0);
2053 newnode = domNewElementNode(node->ownerDocument, tag_name);
2054 domAppendChild(node, newnode);
2055
2056 /*------------------------------------------------------------------------
2057 | create attributes
2058 \-----------------------------------------------------------------------*/
2059 if ((rc = Tcl_ListObjIndex(interp, lnode, 1, &attrListObj)) != TCL_OK) {
2060 return rc;
2061 }
2062 if ((rc = Tcl_ListObjLength(interp, attrListObj, &attrLength))
2063 != TCL_OK) {
2064 return rc;
2065 }
2066 if (attrLength % 2) {
2067 SetResult("invalid attributes list format!");
2068 return TCL_ERROR;
2069 }
2070 for (i=0; i<attrLength; i++) {
2071
2072 if ((rc = Tcl_ListObjIndex(interp, attrListObj, i, &attrObj))
2073 != TCL_OK) {
2074 return rc;
2075 }
2076 attrName = Tcl_GetString(attrObj);
2077 CheckName (interp, attrName, "attribute", 0);
2078 i++;
2079
2080 if ((rc = Tcl_ListObjIndex(interp, attrListObj, i, &attrObj))
2081 != TCL_OK) {
2082 return rc;
2083 }
2084 attrValue = Tcl_GetStringFromObj(attrObj, &attrValueLength);
2085 CheckText (interp, attrValue, "attribute");
2086 domSetAttribute(newnode, attrName, attrValue);
2087 }
2088
2089 /*------------------------------------------------------------------------
2090 | add child nodes
2091 \-----------------------------------------------------------------------*/
2092 if ((rc = Tcl_ListObjIndex(interp, lnode, 2, &childListObj))
2093 != TCL_OK) {
2094 return rc;
2095 }
2096 if ((rc = Tcl_ListObjLength(interp, childListObj, &childListLength))
2097 != TCL_OK) {
2098 return rc;
2099 }
2100 for (i=0; i<childListLength; i++) {
2101 if ((rc = Tcl_ListObjIndex(interp, childListObj, i, &childObj))
2102 != TCL_OK) {
2103 return rc;
2104 }
2105 if ((rc = tcldom_appendFromTclList(interp, newnode, childObj))
2106 != TCL_OK) {
2107 return rc;
2108 }
2109 }
2110 return tcldom_setInterpAndReturnVar(interp, node, 0, NULL);
2111 }
2112
2113
2114 /*----------------------------------------------------------------------------
2115 | tcldom_treeAsTclList
2116 |
2117 \---------------------------------------------------------------------------*/
2118 static
tcldom_treeAsTclList(Tcl_Interp * interp,domNode * node)2119 Tcl_Obj * tcldom_treeAsTclList (
2120 Tcl_Interp *interp,
2121 domNode *node
2122 )
2123 {
2124 Tcl_Obj *name, *value;
2125 Tcl_Obj *attrsList, *attrName, *attrValue;
2126 Tcl_Obj *childList;
2127 Tcl_Obj *objv[4];
2128 int result;
2129 domNode *child;
2130 domAttrNode *attrs;
2131
2132
2133
2134 if ( (node->nodeType == TEXT_NODE)
2135 || (node->nodeType == CDATA_SECTION_NODE)) {
2136
2137 value = Tcl_NewStringObj(((domTextNode*)node)->nodeValue,
2138 ((domTextNode*)node)->valueLength);
2139 objv[0] = Tcl_NewStringObj("#text", -1);
2140 objv[1] = value;
2141 return Tcl_NewListObj(2, objv);
2142 }
2143
2144 if (node->nodeType == COMMENT_NODE) {
2145 value = Tcl_NewStringObj(((domTextNode*)node)->nodeValue,
2146 ((domTextNode*)node)->valueLength);
2147 objv[0] = Tcl_NewStringObj("#comment", -1);
2148 objv[1] = value;
2149 return Tcl_NewListObj(2, objv);
2150 }
2151
2152 if (node->nodeType == PROCESSING_INSTRUCTION_NODE) {
2153 domProcessingInstructionNode *dpn;
2154 dpn = (domProcessingInstructionNode *)node;
2155 name = Tcl_NewStringObj(dpn->targetValue, dpn->targetLength);
2156 value = Tcl_NewStringObj(dpn->dataValue, dpn->dataLength);
2157 objv[0] = Tcl_NewStringObj("#pi", -1);
2158 objv[1] = name;
2159 objv[2] = value;
2160 return Tcl_NewListObj(3, objv);
2161 }
2162
2163 name = Tcl_NewStringObj(node->nodeName, -1);
2164
2165 attrsList = Tcl_NewListObj(0, NULL);
2166 attrs = node->firstAttr;
2167 while (attrs) {
2168 attrName = Tcl_NewStringObj(attrs->nodeName, -1);
2169 attrValue = Tcl_NewStringObj(attrs->nodeValue, attrs->valueLength);
2170 Tcl_ListObjAppendElement(interp, attrsList, attrName);
2171 Tcl_ListObjAppendElement(interp, attrsList, attrValue);
2172 attrs = attrs->nextSibling;
2173 }
2174
2175 childList = Tcl_NewListObj(0, NULL);
2176 if (node->nodeType == ELEMENT_NODE) {
2177 child = node->firstChild;
2178 while (child != NULL) {
2179 result = Tcl_ListObjAppendElement
2180 (interp, childList, tcldom_treeAsTclList(interp, child));
2181 if (result != TCL_OK) {
2182 return NULL;
2183 }
2184 child = child->nextSibling;
2185 }
2186 }
2187
2188 objv[0] = name;
2189 objv[1] = attrsList;
2190 objv[2] = childList;
2191
2192 return Tcl_NewListObj(3, objv);
2193 }
2194
2195 /*----------------------------------------------------------------------------
2196 | tcldom_AppendEscaped
2197 |
2198 \---------------------------------------------------------------------------*/
2199 static
tcldom_AppendEscaped(Tcl_Obj * xmlString,Tcl_Channel chan,char * value,int value_length,int outputFlags)2200 void tcldom_AppendEscaped (
2201 Tcl_Obj *xmlString,
2202 Tcl_Channel chan,
2203 char *value,
2204 int value_length,
2205 int outputFlags
2206 )
2207 {
2208 #define APESC_BUF_SIZE 512
2209 #define AP(c) *b++ = c;
2210 #define AE(s) pc1 = s; while(*pc1) *b++ = *pc1++;
2211 char buf[APESC_BUF_SIZE+80], *b, *bLimit, *pc, *pc1, *pEnd, charRef[10];
2212 int charDone, i;
2213 int clen = 0;
2214 int unicode;
2215 Tcl_UniChar uniChar;
2216
2217 b = buf;
2218 bLimit = b + APESC_BUF_SIZE;
2219 pc = pEnd = value;
2220 if (value_length != -1) {
2221 pEnd = pc + value_length;
2222 }
2223 while ( (value_length == -1 && *pc)
2224 || (value_length != -1 && pc != pEnd)
2225 ) {
2226 if ((*pc == '"') && (outputFlags & SERIALIZE_FOR_ATTR
2227 || outputFlags & SERIALIZE_ESCAPE_ALL_QUOT)) {
2228 AP('&') AP('q') AP('u') AP('o') AP('t') AP(';')
2229 } else
2230 if (*pc == '&') { AP('&') AP('a') AP('m') AP('p') AP(';')
2231 } else
2232 if (*pc == '<') { AP('&') AP('l') AP('t') AP(';')
2233 } else
2234 if (*pc == '>' && !(outputFlags & SERIALIZE_NO_GT_ESCAPE)) {
2235 AP('&') AP('g') AP('t') AP(';')
2236 } else
2237 if ((*pc == '\n') && outputFlags & SERIALIZE_FOR_ATTR) {
2238 AP('&') AP('#') AP('x') AP('A') AP(';')
2239 } else
2240 {
2241 charDone = 0;
2242 if (outputFlags & SERIALIZE_HTML_ENTITIES) {
2243 charDone = 1;
2244 Tcl_UtfToUniChar(pc, &uniChar);
2245 switch (uniChar)
2246 {
2247 case 0240: AE(" "); break;
2248 case 0241: AE("¡"); break;
2249 case 0242: AE("¢"); break;
2250 case 0243: AE("£"); break;
2251 case 0244: AE("¤"); break;
2252 case 0245: AE("¥"); break;
2253 case 0246: AE("¦"); break;
2254 case 0247: AE("§"); break;
2255 case 0250: AE("¨"); break;
2256 case 0251: AE("©"); break;
2257 case 0252: AE("ª"); break;
2258 case 0253: AE("«"); break;
2259 case 0254: AE("¬"); break;
2260 case 0255: AE("­"); break;
2261 case 0256: AE("®"); break;
2262 case 0257: AE("¯"); break;
2263 case 0260: AE("°"); break;
2264 case 0261: AE("±"); break;
2265 case 0262: AE("²"); break;
2266 case 0263: AE("³"); break;
2267 case 0264: AE("´"); break;
2268 case 0265: AE("µ"); break;
2269 case 0266: AE("¶"); break;
2270 case 0267: AE("·"); break;
2271 case 0270: AE("¸"); break;
2272 case 0271: AE("¹"); break;
2273 case 0272: AE("º"); break;
2274 case 0273: AE("»"); break;
2275 case 0274: AE("¼"); break;
2276 case 0275: AE("½"); break;
2277 case 0276: AE("¾"); break;
2278 case 0277: AE("¿"); break;
2279 case 0300: AE("À"); break;
2280 case 0301: AE("Á"); break;
2281 case 0302: AE("Â"); break;
2282 case 0303: AE("Ã"); break;
2283 case 0304: AE("Ä"); break;
2284 case 0305: AE("Å"); break;
2285 case 0306: AE("Æ"); break;
2286 case 0307: AE("Ç"); break;
2287 case 0310: AE("È"); break;
2288 case 0311: AE("É"); break;
2289 case 0312: AE("Ê"); break;
2290 case 0313: AE("Ë"); break;
2291 case 0314: AE("Ì"); break;
2292 case 0315: AE("Í"); break;
2293 case 0316: AE("Î"); break;
2294 case 0317: AE("Ï"); break;
2295 case 0320: AE("Ð"); break;
2296 case 0321: AE("Ñ"); break;
2297 case 0322: AE("Ò"); break;
2298 case 0323: AE("Ó"); break;
2299 case 0324: AE("Ô"); break;
2300 case 0325: AE("Õ"); break;
2301 case 0326: AE("Ö"); break;
2302 case 0327: AE("×"); break;
2303 case 0330: AE("Ø"); break;
2304 case 0331: AE("Ù"); break;
2305 case 0332: AE("Ú"); break;
2306 case 0333: AE("Û"); break;
2307 case 0334: AE("Ü"); break;
2308 case 0335: AE("Ý"); break;
2309 case 0336: AE("Þ"); break;
2310 case 0337: AE("ß"); break;
2311 case 0340: AE("à"); break;
2312 case 0341: AE("á"); break;
2313 case 0342: AE("â"); break;
2314 case 0343: AE("ã"); break;
2315 case 0344: AE("ä"); break;
2316 case 0345: AE("å"); break;
2317 case 0346: AE("æ"); break;
2318 case 0347: AE("ç"); break;
2319 case 0350: AE("è"); break;
2320 case 0351: AE("é"); break;
2321 case 0352: AE("ê"); break;
2322 case 0353: AE("ë"); break;
2323 case 0354: AE("ì"); break;
2324 case 0355: AE("í"); break;
2325 case 0356: AE("î"); break;
2326 case 0357: AE("ï"); break;
2327 case 0360: AE("ð"); break;
2328 case 0361: AE("ñ"); break;
2329 case 0362: AE("ò"); break;
2330 case 0363: AE("ó"); break;
2331 case 0364: AE("ô"); break;
2332 case 0365: AE("õ"); break;
2333 case 0366: AE("ö"); break;
2334 case 0367: AE("÷"); break;
2335 case 0370: AE("ø"); break;
2336 case 0371: AE("ù"); break;
2337 case 0372: AE("ú"); break;
2338 case 0373: AE("û"); break;
2339 case 0374: AE("ü"); break;
2340 case 0375: AE("ý"); break;
2341 case 0376: AE("þ"); break;
2342 case 0377: AE("ÿ"); break;
2343 /* "Special" chars, according to XHTML xhtml-special.ent */
2344 case 338: AE("Œ"); break;
2345 case 339: AE("œ"); break;
2346 case 352: AE("Š"); break;
2347 case 353: AE("š"); break;
2348 case 376: AE("Ÿ"); break;
2349 case 710: AE("ˆ"); break;
2350 case 732: AE("˜"); break;
2351 case 8194: AE(" "); break;
2352 case 8195: AE(" "); break;
2353 case 8201: AE(" "); break;
2354 case 8204: AE("‌"); break;
2355 case 8205: AE("‍"); break;
2356 case 8206: AE("‎"); break;
2357 case 8207: AE("‏"); break;
2358 case 8211: AE("–"); break;
2359 case 8212: AE("—"); break;
2360 case 8216: AE("‘"); break;
2361 case 8217: AE("’"); break;
2362 case 8218: AE("‚"); break;
2363 case 8220: AE("“"); break;
2364 case 8221: AE("”"); break;
2365 case 8222: AE("„"); break;
2366 case 8224: AE("†"); break;
2367 case 8225: AE("‡"); break;
2368 case 8240: AE("‰"); break;
2369 case 8249: AE("‹"); break;
2370 case 8250: AE("›"); break;
2371 case 8364: AE("€"); break;
2372 /* "Symbol" chars, according to XHTML xhtml-symbol.ent */
2373 case 402: AE("ƒ"); break;
2374 case 913: AE("Α"); break;
2375 case 914: AE("Β"); break;
2376 case 915: AE("Γ"); break;
2377 case 916: AE("Δ"); break;
2378 case 917: AE("Ε"); break;
2379 case 918: AE("Ζ"); break;
2380 case 919: AE("Η"); break;
2381 case 920: AE("Θ"); break;
2382 case 921: AE("Ι"); break;
2383 case 922: AE("Κ"); break;
2384 case 923: AE("Λ"); break;
2385 case 924: AE("Μ"); break;
2386 case 925: AE("Ν"); break;
2387 case 926: AE("Ξ"); break;
2388 case 927: AE("Ο"); break;
2389 case 928: AE("Π"); break;
2390 case 929: AE("Ρ"); break;
2391 case 931: AE("Σ"); break;
2392 case 932: AE("Τ"); break;
2393 case 933: AE("Υ"); break;
2394 case 934: AE("Φ"); break;
2395 case 935: AE("Χ"); break;
2396 case 936: AE("Ψ"); break;
2397 case 937: AE("Ω"); break;
2398 case 945: AE("α"); break;
2399 case 946: AE("β"); break;
2400 case 947: AE("γ"); break;
2401 case 948: AE("δ"); break;
2402 case 949: AE("ε"); break;
2403 case 950: AE("ζ"); break;
2404 case 951: AE("η"); break;
2405 case 952: AE("θ"); break;
2406 case 953: AE("ι"); break;
2407 case 954: AE("κ"); break;
2408 case 955: AE("λ"); break;
2409 case 956: AE("μ"); break;
2410 case 957: AE("ν"); break;
2411 case 958: AE("ξ"); break;
2412 case 959: AE("ο"); break;
2413 case 960: AE("π"); break;
2414 case 961: AE("ρ"); break;
2415 case 962: AE("ς"); break;
2416 case 963: AE("σ"); break;
2417 case 964: AE("τ"); break;
2418 case 965: AE("υ"); break;
2419 case 966: AE("φ"); break;
2420 case 967: AE("χ"); break;
2421 case 968: AE("ψ"); break;
2422 case 969: AE("ω"); break;
2423 case 977: AE("ϑ");break;
2424 case 978: AE("ϒ"); break;
2425 case 982: AE("ϖ"); break;
2426 case 8226: AE("•"); break;
2427 case 8230: AE("…"); break;
2428 case 8242: AE("′"); break;
2429 case 8243: AE("″"); break;
2430 case 8254: AE("‾"); break;
2431 case 8260: AE("⁄"); break;
2432 case 8472: AE("℘"); break;
2433 case 8465: AE("ℑ"); break;
2434 case 8476: AE("ℜ"); break;
2435 case 8482: AE("™"); break;
2436 case 8501: AE("ℵ"); break;
2437 case 8592: AE("←"); break;
2438 case 8593: AE("↑"); break;
2439 case 8594: AE("→"); break;
2440 case 8595: AE("↓"); break;
2441 case 8596: AE("↔"); break;
2442 case 8629: AE("↵"); break;
2443 case 8656: AE("⇐"); break;
2444 case 8657: AE("⇑"); break;
2445 case 8658: AE("⇒"); break;
2446 case 8659: AE("⇓"); break;
2447 case 8660: AE("⇔"); break;
2448 case 8704: AE("∀"); break;
2449 case 8706: AE("∂"); break;
2450 case 8707: AE("∃"); break;
2451 case 8709: AE("∅"); break;
2452 case 8711: AE("∇"); break;
2453 case 8712: AE("∈"); break;
2454 case 8713: AE("∉"); break;
2455 case 8715: AE("∋"); break;
2456 case 8719: AE("∏"); break;
2457 case 8721: AE("∑"); break;
2458 case 8722: AE("−"); break;
2459 case 8727: AE("∗"); break;
2460 case 8730: AE("√"); break;
2461 case 8733: AE("∝"); break;
2462 case 8734: AE("∞"); break;
2463 case 8736: AE("∠"); break;
2464 case 8743: AE("∧"); break;
2465 case 8744: AE("∨"); break;
2466 case 8745: AE("∩"); break;
2467 case 8746: AE("∪"); break;
2468 case 8747: AE("∫"); break;
2469 case 8756: AE("∴"); break;
2470 case 8764: AE("∼"); break;
2471 case 8773: AE("≅"); break;
2472 case 8776: AE("≈"); break;
2473 case 8800: AE("≠"); break;
2474 case 8801: AE("≡"); break;
2475 case 8804: AE("≤"); break;
2476 case 8805: AE("≥"); break;
2477 case 8834: AE("⊂"); break;
2478 case 8835: AE("⊃"); break;
2479 case 8836: AE("⊄"); break;
2480 case 8838: AE("⊆"); break;
2481 case 8839: AE("⊇"); break;
2482 case 8853: AE("⊕"); break;
2483 case 8855: AE("⊗"); break;
2484 case 8869: AE("⊥"); break;
2485 case 8901: AE("⋅"); break;
2486 case 8968: AE("⌈"); break;
2487 case 8969: AE("⌉"); break;
2488 case 8970: AE("⌊"); break;
2489 case 8971: AE("⌋"); break;
2490 case 9001: AE("⟨"); break;
2491 case 9002: AE("⟩"); break;
2492 case 9674: AE("◊"); break;
2493 case 9824: AE("♠"); break;
2494 case 9827: AE("♣"); break;
2495 case 9829: AE("♥"); break;
2496 case 9830: AE("♦"); break;
2497 default: charDone = 0;
2498 }
2499 if (charDone) {
2500 clen = UTF8_CHAR_LEN(*pc);
2501 pc += (clen - 1);
2502 }
2503 }
2504 if (!charDone) {
2505 if ((unsigned char)*pc > 127) {
2506 clen = UTF8_CHAR_LEN(*pc);
2507 if (!clen) {
2508 domPanic("tcldom_AppendEscaped: can only handle "
2509 "UTF-8 chars up to 4 bytes length");
2510
2511 }
2512 if (clen == 4 || outputFlags & SERIALIZE_ESCAPE_NON_ASCII) {
2513 if (clen == 4) {
2514 unicode = ((pc[0] & 0x07) << 18)
2515 + ((pc[1] & 0x3F) << 12)
2516 + ((pc[2] & 0x3F) << 6)
2517 + (pc[3] & 0x3F);
2518 } else {
2519 unicode = 0;
2520 Tcl_UtfToUniChar(pc, (Tcl_UniChar*)&unicode);
2521 }
2522 AP('&') AP('#')
2523 sprintf(charRef, "%d", unicode);
2524 for (i = 0; i < (int)strlen(charRef); i++) {
2525 AP(charRef[i]);
2526 }
2527 AP(';')
2528 pc += (clen - 1);
2529 } else {
2530 for (i = 0; i < clen; i++) {
2531 AP(*pc);
2532 pc++;
2533 }
2534 pc--;
2535 }
2536 } else {
2537 AP(*pc);
2538 }
2539 }
2540 }
2541 if (b >= bLimit) {
2542 writeChars(xmlString, chan, buf, b - buf);
2543 b = buf;
2544 }
2545 pc++;
2546 }
2547 if (b > buf) {
2548 writeChars(xmlString, chan, buf, b - buf);
2549 }
2550 }
2551
2552 /*----------------------------------------------------------------------------
2553 | tcldom_tolower
2554 |
2555 \---------------------------------------------------------------------------*/
tcldom_tolower(const char * str,char * str_out,int len)2556 void tcldom_tolower (
2557 const char *str,
2558 char *str_out,
2559 int len
2560 )
2561 {
2562 char *p;
2563 int i;
2564
2565 len--; i = 0; p = str_out;
2566 while (*str && (i < len)) {
2567 *p++ = tolower((unsigned char)*str++);
2568 i++;
2569 }
2570 *p++ = '\0';
2571 }
2572
2573
2574 /*----------------------------------------------------------------------------
2575 | tcldom_treeAsHTML
2576 |
2577 \---------------------------------------------------------------------------*/
2578 static
tcldom_treeAsHTML(Tcl_Obj * htmlString,domNode * node,Tcl_Channel chan,int escapeNonASCII,int htmlEntities,int doctypeDeclaration,int noEscaping)2579 void tcldom_treeAsHTML (
2580 Tcl_Obj *htmlString,
2581 domNode *node,
2582 Tcl_Channel chan,
2583 int escapeNonASCII,
2584 int htmlEntities,
2585 int doctypeDeclaration,
2586 int noEscaping
2587 )
2588 {
2589 int empty, scriptTag, outputFlags = 0;
2590 domNode *child;
2591 domAttrNode *attrs;
2592 domDocument *doc;
2593 char tag[80], attrName[80];
2594
2595 if (escapeNonASCII) outputFlags = SERIALIZE_ESCAPE_NON_ASCII;
2596 if (htmlEntities) outputFlags |= SERIALIZE_HTML_ENTITIES;
2597 if (node->nodeType == DOCUMENT_NODE) {
2598 doc = (domDocument*) node;
2599 if (doctypeDeclaration && doc->documentElement) {
2600 writeChars(htmlString, chan, "<!DOCTYPE ", 10);
2601 writeChars(htmlString, chan, doc->documentElement->nodeName, -1);
2602 if ( doc->doctype
2603 && doc->doctype->systemId
2604 && doc->doctype->systemId[0] != '\0') {
2605 if ( doc->doctype->publicId
2606 && doc->doctype->publicId[0] != '\0') {
2607 writeChars(htmlString, chan, " PUBLIC \"", 9);
2608 writeChars(htmlString, chan, doc->doctype->publicId, -1);
2609 writeChars(htmlString, chan, "\" \"", 3);
2610 writeChars(htmlString, chan, doc->doctype->systemId, -1);
2611 writeChars(htmlString, chan, "\"", 1);
2612 } else {
2613 writeChars(htmlString, chan, " SYSTEM \"", 9);
2614 writeChars(htmlString, chan, doc->doctype->systemId, -1);
2615 writeChars(htmlString, chan, "\"", 1);
2616 }
2617 }
2618 if (doc->doctype && doc->doctype->internalSubset) {
2619 writeChars(htmlString, chan, " [", 2);
2620 writeChars(htmlString, chan, doc->doctype->internalSubset, -1);
2621 writeChars(htmlString, chan, "]", 1);
2622 }
2623 writeChars(htmlString, chan, ">\n", 2);
2624 }
2625 child = doc->rootNode->firstChild;
2626 while (child) {
2627 tcldom_treeAsHTML(htmlString, child, chan, escapeNonASCII,
2628 htmlEntities, doctypeDeclaration, 0);
2629 child = child->nextSibling;
2630 }
2631 return;
2632 }
2633
2634 if (node->nodeType == PROCESSING_INSTRUCTION_NODE) {
2635 domProcessingInstructionNode *dpn;
2636 dpn = (domProcessingInstructionNode *)node;
2637 writeChars(htmlString, chan, "<?", 2);
2638 writeChars(htmlString, chan, dpn->targetValue, dpn->targetLength);
2639 writeChars(htmlString, chan, " ", 1);
2640 writeChars(htmlString, chan, dpn->dataValue, dpn->dataLength);
2641 writeChars(htmlString, chan, ">", 1);
2642 return;
2643 }
2644
2645 if (node->nodeType == TEXT_NODE) {
2646 if ((node->nodeFlags & DISABLE_OUTPUT_ESCAPING)
2647 || noEscaping) {
2648 writeChars(htmlString, chan, ((domTextNode*)node)->nodeValue,
2649 ((domTextNode*)node)->valueLength);
2650 } else {
2651 tcldom_AppendEscaped(htmlString, chan,
2652 ((domTextNode*)node)->nodeValue,
2653 ((domTextNode*)node)->valueLength,
2654 outputFlags);
2655 }
2656 return;
2657 }
2658
2659 if (node->nodeType == CDATA_SECTION_NODE) {
2660 if (noEscaping) {
2661 writeChars(htmlString, chan, ((domTextNode*)node)->nodeValue,
2662 ((domTextNode*)node)->valueLength);
2663 } else {
2664 tcldom_AppendEscaped(htmlString, chan,
2665 ((domTextNode*)node)->nodeValue,
2666 ((domTextNode*)node)->valueLength,
2667 outputFlags);
2668 }
2669 return;
2670 }
2671
2672 if (node->nodeType == COMMENT_NODE) {
2673 writeChars(htmlString, chan, "<!--", 4);
2674 writeChars(htmlString, chan, ((domTextNode*)node)->nodeValue,
2675 ((domTextNode*)node)->valueLength);
2676 writeChars(htmlString, chan, "-->", 3);
2677 return;
2678
2679 }
2680
2681 tcldom_tolower(node->nodeName, tag, 80);
2682 writeChars(htmlString, chan, "<", 1);
2683 writeChars(htmlString, chan, tag, -1);
2684
2685
2686 /*-----------------------------------------------------------
2687 | check for HTML tags, that must be handled special:
2688 | empty tags and script tags (todo: HTML tags with
2689 | URI attributes, to do escaping of Non-ASCII chars
2690 | in the URI).
2691 \----------------------------------------------------------*/
2692 empty = 0;
2693 scriptTag = 0;
2694 switch (tag[0]) {
2695 case 'a': if (!strcmp(tag,"area")) {empty = 1;} break;
2696 case 'b': if (!strcmp(tag,"br") ||
2697 !strcmp(tag,"base") ||
2698 !strcmp(tag,"basefont")) {empty = 1;} break;
2699 case 'c': if (!strcmp(tag,"col")) {empty = 1;} break;
2700 case 'f': if (!strcmp(tag,"frame")) {empty = 1;} break;
2701 case 'h': if (!strcmp(tag,"hr")) {empty = 1;} break;
2702 case 'i': if (!strcmp(tag,"img") ||
2703 !strcmp(tag,"input") ||
2704 !strcmp(tag,"isindex")) {empty = 1;} break;
2705 case 'l': if (!strcmp(tag,"link")) {empty = 1;} break;
2706 case 'm': if (!strcmp(tag,"meta")) {empty = 1;} break;
2707 case 'p': if (!strcmp(tag,"param")) {empty = 1;} break;
2708 case 's': if (!strcmp(tag,"script") ||
2709 !strcmp(tag,"style")) {scriptTag = 1;} break;
2710 }
2711
2712
2713 attrs = node->firstAttr;
2714 while (attrs) {
2715 tcldom_tolower(attrs->nodeName, attrName, 80);
2716 writeChars(htmlString, chan, " ", 1);
2717 writeChars (htmlString, chan, attrName, -1);
2718 writeChars(htmlString, chan, "=\"", 2);
2719 tcldom_AppendEscaped(htmlString, chan, attrs->nodeValue, -1,
2720 outputFlags | SERIALIZE_FOR_ATTR);
2721 writeChars(htmlString, chan, "\"", 1);
2722 attrs = attrs->nextSibling;
2723 }
2724 writeChars(htmlString, chan, ">", 1);
2725
2726
2727 if (empty) {
2728 /* strange ! should not happen ! */
2729 child = node->firstChild;
2730 while (child != NULL) {
2731 tcldom_treeAsHTML(htmlString, child, chan, escapeNonASCII,
2732 htmlEntities, doctypeDeclaration, scriptTag);
2733 child = child->nextSibling;
2734 }
2735 return;
2736 }
2737
2738 if (node->nodeType == ELEMENT_NODE) {
2739 child = node->firstChild;
2740 if ((child != NULL) && (child != node->lastChild)
2741 && (child->nodeType != TEXT_NODE)) {
2742 writeChars(htmlString, chan, "\n", 1);
2743 }
2744 while (child != NULL) {
2745 tcldom_treeAsHTML(htmlString, child, chan, escapeNonASCII,
2746 htmlEntities, doctypeDeclaration, scriptTag);
2747 child = child->nextSibling;
2748 }
2749 if ((node->firstChild != NULL) && (node->firstChild != node->lastChild)
2750 && (node->lastChild->nodeType != TEXT_NODE)) {
2751 writeChars(htmlString, chan, "\n", 1);
2752 }
2753 }
2754 writeChars(htmlString, chan, "</", 2);
2755 writeChars(htmlString, chan, tag, -1);
2756 writeChars(htmlString, chan, ">", 1);
2757 }
2758
2759
2760 /*----------------------------------------------------------------------------
2761 | tcldom_treeAsXML
2762 |
2763 \---------------------------------------------------------------------------*/
2764 static
tcldom_treeAsXML(Tcl_Obj * xmlString,domNode * node,int indent,int level,int doIndent,Tcl_Channel chan,Tcl_Obj * encString,int cdataChild,int outputFlags,int indentAttrs)2765 void tcldom_treeAsXML (
2766 Tcl_Obj *xmlString,
2767 domNode *node,
2768 int indent,
2769 int level,
2770 int doIndent,
2771 Tcl_Channel chan,
2772 Tcl_Obj *encString,
2773 int cdataChild,
2774 int outputFlags,
2775 int indentAttrs
2776 )
2777 {
2778 domAttrNode *attrs;
2779 domNode *child;
2780 domDocument *doc;
2781 int first, hasElements, i;
2782 char prefix[MAX_PREFIX_LEN], *start, *p;
2783 const char *localName;
2784 Tcl_HashEntry *h;
2785 Tcl_DString dStr;
2786
2787 if (outputFlags & SERIALIZE_XML_DECLARATION) {
2788 outputFlags &= ~SERIALIZE_XML_DECLARATION;
2789 writeChars(xmlString, chan, "<?xml version=\"1.0\"", 19);
2790 if (encString) {
2791 writeChars(xmlString, chan, " encoding=\"", 11);
2792 writeChars(xmlString, chan,
2793 Tcl_GetString(encString), -1);
2794 writeChars(xmlString, chan, "\"", 1);
2795 } else if (node->nodeType == DOCUMENT_NODE &&
2796 ((domDocument*) node)->doctype &&
2797 ((domDocument*) node)->doctype->encoding) {
2798 writeChars(xmlString, chan, " encoding=\"", 11);
2799 writeChars(xmlString, chan,
2800 ((domDocument*) node)->doctype->encoding, -1);
2801 writeChars(xmlString, chan, "\"", 1);
2802 }
2803 writeChars(xmlString, chan, "?>\n", 3);
2804 }
2805 if (node->nodeType == DOCUMENT_NODE) {
2806 doc = (domDocument*) node;
2807 if (outputFlags & SERIALIZE_DOCTYPE_DECLARATION
2808 && doc->documentElement) {
2809 writeChars(xmlString, chan, "<!DOCTYPE ", 10);
2810 writeChars(xmlString, chan, doc->documentElement->nodeName, -1);
2811 if ( doc->doctype
2812 && doc->doctype->systemId
2813 && (doc->doctype->systemId[0] != '\0')) {
2814 if ( doc->doctype->publicId
2815 && doc->doctype->publicId[0] != '\0') {
2816 writeChars(xmlString, chan, " PUBLIC \"", 9);
2817 writeChars(xmlString, chan, doc->doctype->publicId, -1);
2818 writeChars(xmlString, chan, "\" \"", 3);
2819 writeChars(xmlString, chan, doc->doctype->systemId, -1);
2820 writeChars(xmlString, chan, "\"", 1);
2821 } else {
2822 writeChars(xmlString, chan, " SYSTEM \"", 9);
2823 writeChars(xmlString, chan, doc->doctype->systemId, -1);
2824 writeChars(xmlString, chan, "\"", 1);
2825 }
2826 if (doc->doctype->internalSubset) {
2827 writeChars(xmlString, chan, " [", 2);
2828 writeChars(xmlString, chan, doc->doctype->internalSubset,
2829 -1);
2830 writeChars(xmlString, chan, "]", 1);
2831 }
2832 }
2833 writeChars(xmlString, chan, ">\n", 2);
2834 }
2835 child = doc->rootNode->firstChild;
2836 while (child) {
2837 tcldom_treeAsXML(xmlString, child, indent, level, doIndent, chan,
2838 NULL, 0, outputFlags, indentAttrs);
2839 child = child->nextSibling;
2840 }
2841 return;
2842 }
2843
2844 if (node->nodeType == TEXT_NODE) {
2845 if (cdataChild) {
2846 writeChars(xmlString, chan, "<![CDATA[", 9);
2847 i = 0;
2848 start = p = ((domTextNode*)node)->nodeValue;
2849 while (i < ((domTextNode*)node)->valueLength) {
2850 if (*p == ']') {
2851 p++; i++;;
2852 if (i >= ((domTextNode*)node)->valueLength) break;
2853 if (*p == ']') {
2854 p++; i++;;
2855 if (i >= ((domTextNode*)node)->valueLength) break;
2856 if (*p == '>') {
2857 writeChars(xmlString, chan, start, p-start);
2858 writeChars(xmlString, chan, "]]><![CDATA[>", 13);
2859 start = p+1;
2860 }
2861 }
2862 }
2863 p++; i++;;
2864 }
2865 writeChars(xmlString, chan, start, p-start);
2866 writeChars(xmlString, chan, "]]>", 3);
2867 } else {
2868 if (node->nodeFlags & DISABLE_OUTPUT_ESCAPING) {
2869 writeChars(xmlString, chan, ((domTextNode*)node)->nodeValue,
2870 ((domTextNode*)node)->valueLength);
2871 } else {
2872 tcldom_AppendEscaped(xmlString, chan,
2873 ((domTextNode*)node)->nodeValue,
2874 ((domTextNode*)node)->valueLength,
2875 outputFlags);
2876 }
2877 }
2878 return;
2879 }
2880
2881 if (node->nodeType == CDATA_SECTION_NODE) {
2882 writeChars(xmlString, chan, "<![CDATA[", 9);
2883 writeChars(xmlString, chan, ((domTextNode*)node)->nodeValue,
2884 ((domTextNode*)node)->valueLength);
2885 writeChars(xmlString, chan, "]]>", 3);
2886 return;
2887 }
2888
2889 if ((indent != -1) && doIndent) {
2890 for(i=0; i<level; i++) {
2891 writeChars(xmlString, chan, " ", indent);
2892 }
2893 }
2894
2895 if (node->nodeType == COMMENT_NODE) {
2896 writeChars(xmlString, chan, "<!--", 4);
2897 writeChars(xmlString, chan, ((domTextNode*)node)->nodeValue,
2898 ((domTextNode*)node)->valueLength);
2899 writeChars(xmlString, chan, "-->", 3);
2900 if (indent != -1) writeChars (xmlString, chan, "\n", 1);
2901 return;
2902 }
2903
2904 if (node->nodeType == PROCESSING_INSTRUCTION_NODE) {
2905 writeChars(xmlString, chan, "<?", 2);
2906 writeChars(xmlString, chan,
2907 ((domProcessingInstructionNode*)node)->targetValue,
2908 ((domProcessingInstructionNode*)node)->targetLength);
2909 writeChars(xmlString, chan, " ", 1);
2910 writeChars(xmlString, chan,
2911 ((domProcessingInstructionNode*)node)->dataValue,
2912 ((domProcessingInstructionNode*)node)->dataLength);
2913 writeChars(xmlString, chan, "?>", 2);
2914 if (indent != -1) writeChars (xmlString, chan, "\n", 1);
2915 return;
2916 }
2917
2918 writeChars(xmlString, chan, "<", 1);
2919 writeChars(xmlString, chan, node->nodeName, -1);
2920
2921 attrs = node->firstAttr;
2922 while (attrs) {
2923 if (indentAttrs > -1) {
2924 writeChars(xmlString, chan, "\n", 1);
2925 if ((indent != -1) && doIndent) {
2926 for(i=0; i<level; i++) {
2927 writeChars(xmlString, chan, " ", indent);
2928 }
2929 if (indentAttrs) {
2930 writeChars(xmlString, chan, " ", indentAttrs);
2931 }
2932 }
2933 } else {
2934 writeChars(xmlString, chan, " ", 1);
2935 }
2936 writeChars(xmlString, chan, attrs->nodeName, -1);
2937 writeChars(xmlString, chan, "=\"", 2);
2938 tcldom_AppendEscaped(xmlString, chan, attrs->nodeValue,
2939 attrs->valueLength,
2940 outputFlags | SERIALIZE_FOR_ATTR);
2941 writeChars(xmlString, chan, "\"", 1);
2942 attrs = attrs->nextSibling;
2943 }
2944
2945 hasElements = 0;
2946 first = 1;
2947 doIndent = 1;
2948
2949 if (node->nodeType == ELEMENT_NODE) {
2950 cdataChild = 0;
2951 if (node->ownerDocument->doctype
2952 && node->ownerDocument->doctype->cdataSectionElements) {
2953 if (node->namespace) {
2954 Tcl_DStringInit (&dStr);
2955 Tcl_DStringAppend (&dStr, domNamespaceURI(node), -1);
2956 Tcl_DStringAppend (&dStr, ":", 1);
2957 domSplitQName (node->nodeName, prefix, &localName);
2958 Tcl_DStringAppend (&dStr, localName, -1);
2959 h = Tcl_FindHashEntry (
2960 node->ownerDocument->doctype->cdataSectionElements,
2961 Tcl_DStringValue (&dStr));
2962 Tcl_DStringFree (&dStr);
2963 } else {
2964 h = Tcl_FindHashEntry (
2965 node->ownerDocument->doctype->cdataSectionElements,
2966 node->nodeName);
2967 }
2968 if (h) {
2969 cdataChild = 1;
2970 }
2971 }
2972 child = node->firstChild;
2973 while (child != NULL) {
2974
2975 if ( (child->nodeType == ELEMENT_NODE)
2976 ||(child->nodeType == PROCESSING_INSTRUCTION_NODE)
2977 ||(child->nodeType == COMMENT_NODE) )
2978 {
2979 hasElements = 1;
2980 }
2981 if (first) {
2982 writeChars(xmlString, chan, ">", 1);
2983 if ((indent != -1) && hasElements) {
2984 writeChars(xmlString, chan, "\n", 1);
2985 }
2986 }
2987 first = 0;
2988 tcldom_treeAsXML(xmlString, child, indent, level+1, doIndent,
2989 chan, NULL, cdataChild, outputFlags, indentAttrs);
2990 doIndent = 0;
2991 if ( (child->nodeType == ELEMENT_NODE)
2992 ||(child->nodeType == PROCESSING_INSTRUCTION_NODE)
2993 ||(child->nodeType == COMMENT_NODE) )
2994 {
2995 doIndent = 1;
2996 }
2997 child = child->nextSibling;
2998 }
2999 }
3000
3001 if (first) {
3002 if (indent != -1) {
3003 if (outputFlags & SERIALIZE_NO_EMPTY_ELEMENT_TAG) {
3004 writeChars (xmlString, chan, "></", 3);
3005 writeChars(xmlString, chan, node->nodeName, -1);
3006 writeChars(xmlString, chan, ">\n", 2);
3007 } else {
3008 writeChars(xmlString, chan, "/>\n", 3);
3009 }
3010 } else {
3011 if (outputFlags & SERIALIZE_NO_EMPTY_ELEMENT_TAG) {
3012 writeChars (xmlString, chan, "></", 3);
3013 writeChars(xmlString, chan, node->nodeName, -1);
3014 writeChars(xmlString, chan, ">", 1);
3015 } else {
3016 writeChars(xmlString, chan, "/>", 2);
3017 }
3018 }
3019 } else {
3020 if ((indent != -1) && hasElements) {
3021 for(i=0; i<level; i++) {
3022 writeChars(xmlString, chan, " ", indent);
3023 }
3024 }
3025 writeChars (xmlString, chan, "</", 2);
3026 writeChars(xmlString, chan, node->nodeName, -1);
3027 if (indent != -1) {
3028 writeChars(xmlString, chan, ">\n", 2);
3029 } else {
3030 writeChars(xmlString, chan, ">", 1);
3031 }
3032 }
3033 }
3034
3035 /*----------------------------------------------------------------------------
3036 | tcldom_AppendEscapedJSON
3037 |
3038 \---------------------------------------------------------------------------*/
3039 static
tcldom_AppendEscapedJSON(Tcl_Obj * jstring,Tcl_Channel chan,char * value,int value_length)3040 void tcldom_AppendEscapedJSON (
3041 Tcl_Obj *jstring,
3042 Tcl_Channel chan,
3043 char *value,
3044 int value_length
3045 )
3046 {
3047 char buf[APESC_BUF_SIZE+80], *b, *bLimit, *pc, *pEnd;
3048 int i;
3049 int clen = 0;
3050
3051 b = buf;
3052 bLimit = b + APESC_BUF_SIZE;
3053 pc = pEnd = value;
3054 if (value_length != -1) {
3055 pEnd = pc + value_length;
3056 }
3057 AP('"');
3058 while (
3059 (value_length == -1 && *pc)
3060 || (value_length != -1 && pc != pEnd)
3061 ) {
3062 clen = UTF8_CHAR_LEN(*pc);
3063 if (!clen) {
3064 /* This would be invalid utf-8 encoding. */
3065 clen = 1;
3066 }
3067 if (clen == 1) {
3068 if (*pc == '\\') {
3069 AP('\\'); AP('\\');
3070 } else if (*pc == '"') {
3071 AP('\\'); AP('"');
3072 } else if (*pc == '\b') {
3073 AP('\\'); AP('b');
3074 } else if (*pc == '\f') {
3075 AP('\\'); AP('f');
3076 } else if (*pc == '\n') {
3077 AP('\\'); AP('n');
3078 } else if (*pc == '\r') {
3079 AP('\\'); AP('r');
3080 } else if (*pc == '\t') {
3081 AP('\\'); AP('t');
3082 } else if ((unsigned char)*pc < 0x20) {
3083 AP('\\'); AP('u'); AP('0'); AP('0');
3084 AP('0' + (*pc>>4));
3085 AP("0123456789abcdef"[*pc&0xf]);
3086 } else {
3087 AP(*pc);
3088 }
3089 pc++;
3090 } else {
3091 if ((unsigned char)*pc == 0xC0 && (unsigned char)*(pc+1) == 0x80) {
3092 AP('\\');AP('u');AP('0');AP('0');AP('0');AP('0');
3093 pc++;pc++;
3094 } else {
3095 for (i = 0; i < clen; i++) {
3096 AP(*pc);
3097 pc++;
3098 }
3099 }
3100 }
3101 if (b >= bLimit) {
3102 writeChars(jstring, chan, buf, b - buf);
3103 b = buf;
3104 }
3105 }
3106 AP('"');
3107 writeChars(jstring, chan, buf, b - buf);
3108 }
3109
3110 static
tcldom_childsAsJSON(Tcl_Obj * jstring,domNode * node,Tcl_Channel channel,int indent,int level,int inside)3111 void tcldom_childsAsJSON (
3112 Tcl_Obj *jstring,
3113 domNode *node, /* Must be an ELEMENT_NODE */
3114 Tcl_Channel channel,
3115 int indent,
3116 int level,
3117 int inside
3118 )
3119 {
3120 domNode *child, *nextChild;
3121 int i, effectivParentType = 0;
3122 int first = 1;
3123
3124 child = node->firstChild;
3125 while (child
3126 && child->nodeType != TEXT_NODE
3127 && child->nodeType != ELEMENT_NODE) {
3128 child = child->nextSibling;
3129 }
3130
3131 if (node->info == JSON_ARRAY || node->info == JSON_OBJECT) {
3132 effectivParentType = node->info;
3133 } else if (child == NULL) {
3134 /* Need 'heuristic rule' to decide, what to do. */
3135 switch (inside) {
3136 case JSON_OBJECT:
3137 /* The childs to serialize are the value of an object member. */
3138 /* No content at all. This could be an empty string,
3139 * an empty object or an empty array. We default to
3140 * empty string. */
3141 writeChars(jstring, channel, "\"\"",2);
3142 return;
3143 case JSON_START:
3144 case JSON_ARRAY:
3145 /* The childs, we serialize are the value of an array
3146 * element. The node is a container for either a
3147 * (nested, in case of JSON_ARRAY) array or an object. */
3148 /* Look, if the name of the container gives a hint.*/
3149 if (strcmp (node->nodeName, JSON_ARRAY_CONTAINER)==0) {
3150 effectivParentType = JSON_ARRAY;
3151 break;
3152 }
3153 /* If we here, heuristics didn't helped. We have to
3154 * default to something. Let's say ... */
3155 effectivParentType = JSON_OBJECT;
3156 break;
3157 }
3158 } else {
3159 if (child->nodeType == ELEMENT_NODE) {
3160 /* The first 'relevant' child node is ELEMENT_NODE */
3161 effectivParentType = JSON_OBJECT;
3162 if (inside == JSON_ARRAY) {
3163 /* Though, if we inside of an array and the node name
3164 * of the first 'relevant' child is the array
3165 * container element, we assume an array (with a
3166 * nested array as first value of that array. */
3167 if (strcmp (child->nodeName, JSON_ARRAY_CONTAINER))
3168 effectivParentType = JSON_ARRAY;
3169 }
3170 } else {
3171 /* If we are here, the first 'relevant' child is a
3172 * text node. If there is any other 'relevant' child,
3173 * we assume the value to be an array. Otherwise (only
3174 * single 'relevant' child is a text node), this is
3175 * any of string, true, false null. Child may have a
3176 * type hint. */
3177 nextChild = child->nextSibling;
3178 while (nextChild
3179 && nextChild->nodeType != TEXT_NODE
3180 && nextChild->nodeType != ELEMENT_NODE) {
3181 nextChild = nextChild->nextSibling;
3182 }
3183 if (nextChild) {
3184 effectivParentType = JSON_ARRAY;
3185 } else {
3186 /* Exactly one 'relevant' child node, a text node;
3187 * serialize it as simple token value. */
3188 tcldom_treeAsJSON (jstring, child, channel, indent,
3189 level, JSON_ARRAY);
3190 return;
3191 }
3192 }
3193 }
3194
3195 switch (effectivParentType) {
3196 case JSON_ARRAY:
3197 writeChars(jstring, channel, "[",1);
3198 while (child) {
3199 if (first) {
3200 first = 0;
3201 level++;
3202 } else {
3203 writeChars(jstring, channel, ",", 1);
3204 }
3205 if (indent > -1) {
3206 writeChars(jstring, channel, "\n", 1);
3207 if (first) level++;
3208 for (i = 0; i < level; i++) {
3209 writeChars(jstring, channel, " ", indent);
3210 }
3211 }
3212 tcldom_treeAsJSON (jstring, child, channel, indent,
3213 level, JSON_ARRAY);
3214 child = child->nextSibling;
3215 while (child
3216 && child->nodeType != TEXT_NODE
3217 && child->nodeType != ELEMENT_NODE) {
3218 child = child->nextSibling;
3219 }
3220 }
3221 if (indent > -1 && first == 0) {
3222 writeChars(jstring, channel, "\n", 1);
3223 level--;
3224 for (i = 0; i < level; i++) {
3225 writeChars(jstring, channel, " ", indent);
3226 }
3227 }
3228 writeChars(jstring, channel, "]",1);
3229 break;
3230 case JSON_OBJECT:
3231 writeChars(jstring, channel, "{",1);
3232 while (child) {
3233 if (first) {
3234 first = 0;
3235 level++;
3236 } else {
3237 writeChars(jstring, channel, ",", 1);
3238 }
3239 if (indent > -1) {
3240 writeChars(jstring, channel, "\n", 1);
3241 if (first) level++;
3242 for (i = 0; i < level; i++) {
3243 writeChars(jstring, channel, " ", indent);
3244 }
3245 }
3246 tcldom_treeAsJSON (jstring, child, channel, indent,
3247 level, JSON_OBJECT);
3248 child = child->nextSibling;
3249 /* Inside of a JSON_OBJECT, only element childs make
3250 * semantically sense. */
3251 while (child && child->nodeType != ELEMENT_NODE) {
3252 child = child->nextSibling;
3253 }
3254 }
3255 if (indent > -1 && first == 0) {
3256 writeChars(jstring, channel, "\n", 1);
3257 level--;
3258 for (i = 0; i < level; i++) {
3259 writeChars(jstring, channel, " ", indent);
3260 }
3261 }
3262 writeChars(jstring, channel, "}",1);
3263 break;
3264 default:
3265 break;
3266 }
3267 }
3268
3269
3270 /*----------------------------------------------------------------------------
3271 | tcldom_treeAsJSON
3272 |
3273 \---------------------------------------------------------------------------*/
3274 static
tcldom_treeAsJSON(Tcl_Obj * jstring,domNode * node,Tcl_Channel channel,int indent,int level,int inside)3275 void tcldom_treeAsJSON (
3276 Tcl_Obj *jstring,
3277 domNode *node, /* Must not be NULL */
3278 Tcl_Channel channel,
3279 int indent,
3280 int level,
3281 int inside
3282 )
3283 {
3284 domTextNode *textNode;
3285 int i, seenDP, seenE;
3286 unsigned char c;
3287 char *num;
3288
3289 switch (node->nodeType) {
3290 case TEXT_NODE:
3291 if (inside == JSON_OBJECT) {
3292 /* We're inside a JSON object. A text node can not be
3293 * meaningful interpreted as member of an object. Ignore
3294 * the node */
3295 return;
3296 }
3297 textNode = (domTextNode *) node;
3298 switch (node->info) {
3299 case JSON_NUMBER:
3300 /* Check, if the text value is a JSON number and fall back
3301 * to string token, if not. This is to ensure, the
3302 * serialization is always a valid JSON string. */
3303 if (textNode->valueLength == 0) goto notANumber;
3304 seenDP = 0;
3305 seenE = 0;
3306 i = 0;
3307 num = textNode->nodeValue;
3308 c = num[0];
3309 if (!(c == '-' || (c>='0' && c<='9'))) goto notANumber;
3310 if (c<='0') {
3311 i = (c == '-' ? i+1 : i);
3312 if (i+1 < textNode->valueLength) {
3313 if (num[i] == '0' && num[i+1] >= '0' && num[i+1] <= '9') {
3314 goto notANumber;
3315 }
3316 }
3317 }
3318 i = 1;
3319 for (; i < textNode->valueLength; i++) {
3320 c = num[i];
3321 if (c >= '0' && c <= '9') continue;
3322 if (c == '.') {
3323 if (num[i-1] == '-') goto notANumber;
3324 if (seenDP) goto notANumber;
3325 seenDP = 1;
3326 continue;
3327 }
3328 if (c == 'e' || c == 'E') {
3329 if (num[i-1] < '0') goto notANumber;
3330 if (seenE) goto notANumber;
3331 seenDP = seenE = 1;
3332 c = num[i+1];
3333 if (c == '+' || c == '-') {
3334 i++;
3335 c = num[i+1];
3336 }
3337 if (c < '0' || c > '9') goto notANumber;
3338 continue;
3339 }
3340 break;
3341 }
3342 /* Catches a plain '-' without following digits */
3343 if (num[i-1] < '0') goto notANumber;
3344 /* Catches trailing chars */
3345 if (i < textNode->valueLength) goto notANumber;
3346 writeChars(jstring, channel, textNode->nodeValue,
3347 textNode->valueLength);
3348 break;
3349 notANumber:
3350 tcldom_AppendEscapedJSON (jstring, channel,
3351 textNode->nodeValue,
3352 textNode->valueLength);
3353 break;
3354 case JSON_NULL:
3355 writeChars(jstring, channel, "null",4);
3356 break;
3357 case JSON_TRUE:
3358 writeChars(jstring, channel, "true",4);
3359 break;
3360 case JSON_FALSE:
3361 writeChars(jstring, channel, "false",5);
3362 break;
3363 case JSON_STRING:
3364 /* Fall through */
3365 default:
3366 tcldom_AppendEscapedJSON (jstring, channel,
3367 textNode->nodeValue,
3368 textNode->valueLength);
3369 break;
3370 };
3371 return;
3372 case ELEMENT_NODE:
3373 switch (inside) {
3374 case JSON_OBJECT:
3375 /* Write the member name and recurse to the childs for the
3376 * value. */
3377 tcldom_AppendEscapedJSON (jstring, channel,
3378 node->nodeName, -1);
3379 writeChars (jstring, channel, ":", 1);
3380 tcldom_childsAsJSON (jstring, node, channel, indent,
3381 level, inside);
3382 break;
3383 case JSON_ARRAY:
3384 /* Since we're already inside of an array, the element can
3385 only be interpreted as a container for a nested JSON
3386 object or array. */
3387 tcldom_childsAsJSON (jstring, node, channel, indent,
3388 level, inside);
3389 break;
3390 case JSON_START:
3391 tcldom_childsAsJSON (jstring, node, channel, indent,
3392 level, inside);
3393 break;
3394 }
3395 return;
3396 default:
3397 /* Any other node types (COMMENT_NODE, CDATA_SECTION_NODE,
3398 PROCESSING_INSTRUCTION_NODE) are ignored. */
3399 return;
3400 }
3401 }
3402
3403 /*----------------------------------------------------------------------------
3404 | findBaseURI
3405 |
3406 \---------------------------------------------------------------------------*/
findBaseURI(domNode * node)3407 const char *findBaseURI (
3408 domNode *node
3409 )
3410 {
3411 const char *baseURI = NULL;
3412 Tcl_HashEntry *entryPtr;
3413 domNode *orgNode;
3414
3415 orgNode = node;
3416 do {
3417 if (node->nodeFlags & HAS_BASEURI) {
3418 entryPtr = Tcl_FindHashEntry(node->ownerDocument->baseURIs,
3419 (char*)node);
3420 baseURI = (const char *)Tcl_GetHashValue(entryPtr);
3421 break;
3422 } else {
3423 node = node->parentNode;
3424 }
3425 } while (node);
3426 if (!baseURI) {
3427 node = orgNode->ownerDocument->rootNode;
3428 if (node->nodeFlags & HAS_BASEURI) {
3429 entryPtr = Tcl_FindHashEntry(node->ownerDocument->baseURIs,
3430 (char*)node);
3431 baseURI = (const char *)Tcl_GetHashValue(entryPtr);
3432 }
3433 }
3434 return baseURI;
3435 }
3436
3437 /*----------------------------------------------------------------------------
3438 | serializeAsXML
3439 |
3440 \---------------------------------------------------------------------------*/
serializeAsXML(domNode * node,Tcl_Interp * interp,int objc,Tcl_Obj * const objv[])3441 static int serializeAsXML (
3442 domNode *node,
3443 Tcl_Interp *interp,
3444 int objc,
3445 Tcl_Obj *const objv[]
3446 )
3447 {
3448 char *channelId, prefix[MAX_PREFIX_LEN];
3449 const char *localName;
3450 int indent, mode, bool;
3451 int outputFlags = 0;
3452 int optionIndex, cdataChild;
3453 Tcl_Obj *resultPtr, *encString = NULL;
3454 Tcl_Channel chan = (Tcl_Channel) NULL;
3455 Tcl_HashEntry *h;
3456 Tcl_DString dStr;
3457 int indentAttrs = -1;
3458
3459 static const char *asXMLOptions[] = {
3460 "-indent", "-channel", "-escapeNonASCII", "-doctypeDeclaration",
3461 "-xmlDeclaration", "-encString", "-escapeAllQuot", "-indentAttrs",
3462 "-nogtescape", "-noEmptyElementTag",
3463 NULL
3464 };
3465 enum asXMLOption {
3466 m_indent, m_channel, m_escapeNonASCII, m_doctypeDeclaration,
3467 m_xmlDeclaration, m_encString, m_escapeAllQuot, m_indentAttrs,
3468 m_nogtescape, m_noEmptyElementTag
3469 };
3470
3471 indent = 4;
3472 while (objc > 2) {
3473 if (Tcl_GetIndexFromObj(interp, objv[2], asXMLOptions, "option", 0,
3474 &optionIndex) != TCL_OK) {
3475 goto cleanup;
3476 }
3477 switch ((enum asXMLOption) optionIndex) {
3478
3479 case m_indent:
3480 if (objc < 4) {
3481 SetResult("-indent must have an argument "
3482 "(0..8 or 'no'/'none')");
3483 goto cleanup;
3484 }
3485 if (strcmp("none", Tcl_GetString(objv[3]))==0) {
3486 indent = -1;
3487 }
3488 else if (strcmp("no", Tcl_GetString(objv[3]))==0) {
3489 indent = -1;
3490 }
3491 else if (Tcl_GetIntFromObj(interp, objv[3], &indent) != TCL_OK) {
3492 SetResult( "indent must be an integer (0..8) or 'no'/'none'");
3493 goto cleanup;
3494 }
3495 objc -= 2;
3496 objv += 2;
3497 break;
3498
3499 case m_indentAttrs:
3500 if (objc < 4) {
3501 SetResult("-indentAttrs must have an argument "
3502 "(0..8 or 'no'/'none')");
3503 goto cleanup;
3504 }
3505 if (strcmp("none", Tcl_GetString(objv[3]))==0) {
3506 indentAttrs = -1;
3507 }
3508 else if (strcmp("no", Tcl_GetString(objv[3]))==0) {
3509 indentAttrs = -1;
3510 }
3511 else if (Tcl_GetIntFromObj(interp, objv[3], &indentAttrs) != TCL_OK) {
3512 SetResult( "indentAttrs must be an integer (0..8) or 'no'/'none'");
3513 goto cleanup;
3514 }
3515 if (indentAttrs > 8) indentAttrs = 8;
3516 if (indentAttrs < 0) indentAttrs = 0;
3517 objc -= 2;
3518 objv += 2;
3519 break;
3520
3521 case m_channel:
3522 if (objc < 4) {
3523 SetResult("-channel must have a channeldID as argument");
3524 goto cleanup;
3525 }
3526 channelId = Tcl_GetString(objv[3]);
3527 chan = Tcl_GetChannel(interp, channelId, &mode);
3528 if (chan == (Tcl_Channel) NULL) {
3529 SetResult("-channel must have a channeldID as argument");
3530 goto cleanup;
3531 }
3532 if ((mode & TCL_WRITABLE) == 0) {
3533 Tcl_AppendResult(interp, "channel \"", channelId,
3534 "\" isnt't opened for writing", (char*)NULL);
3535 goto cleanup;
3536 }
3537 objc -= 2;
3538 objv += 2;
3539 break;
3540
3541 case m_escapeNonASCII:
3542 outputFlags |= SERIALIZE_ESCAPE_NON_ASCII;
3543 objc--;
3544 objv++;
3545 break;
3546
3547 case m_doctypeDeclaration:
3548 if (node->nodeType != DOCUMENT_NODE) {
3549 SetResult("-doctypeDeclaration as flag to the method "
3550 "'asXML' is only allowed for domDocCmds");
3551 goto cleanup;
3552 }
3553 if (objc < 4) {
3554 SetResult("-doctypeDeclaration must have a boolean value "
3555 "as argument");
3556 goto cleanup;
3557 }
3558 if (Tcl_GetBooleanFromObj(interp, objv[3], &bool)
3559 != TCL_OK) {
3560 goto cleanup;
3561 }
3562 if (bool) outputFlags |= SERIALIZE_DOCTYPE_DECLARATION;
3563 objc -= 2;
3564 objv += 2;
3565 break;
3566
3567 case m_xmlDeclaration:
3568 if (objc < 4) {
3569 SetResult("-xmlDeclaration must have a boolean value "
3570 "as argument");
3571 goto cleanup;
3572 }
3573 if (Tcl_GetBooleanFromObj(interp, objv[3], &bool)
3574 != TCL_OK) {
3575 goto cleanup;
3576 }
3577 if (bool) outputFlags |= SERIALIZE_XML_DECLARATION;
3578 objc -= 2;
3579 objv += 2;
3580 break;
3581
3582 case m_encString:
3583 if (objc < 4) {
3584 SetResult("-encString must have a string "
3585 "as argument");
3586 goto cleanup;
3587 }
3588 if (encString) {
3589 Tcl_DecrRefCount(encString);
3590 }
3591 encString = objv[3];
3592 Tcl_IncrRefCount(encString);
3593 objc -= 2;
3594 objv += 2;
3595 break;
3596
3597 case m_escapeAllQuot:
3598 outputFlags |= SERIALIZE_ESCAPE_ALL_QUOT;
3599 objc -= 1;
3600 objv += 1;
3601 break;
3602
3603 case m_nogtescape:
3604 outputFlags |= SERIALIZE_NO_GT_ESCAPE;
3605 objc -= 1;
3606 objv += 1;
3607 break;
3608
3609 case m_noEmptyElementTag:
3610 outputFlags |= SERIALIZE_NO_EMPTY_ELEMENT_TAG;
3611 objc -= 1;
3612 objv += 1;
3613 break;
3614 }
3615 }
3616 if (indent > 8) indent = 8;
3617 if (indent < -1) indent = -1;
3618
3619 resultPtr = Tcl_NewStringObj("", 0);
3620 cdataChild = 0;
3621 if (node->nodeType == ELEMENT_NODE
3622 && node->ownerDocument->doctype
3623 && node->ownerDocument->doctype->cdataSectionElements) {
3624 if (node->namespace) {
3625 Tcl_DStringInit (&dStr);
3626 Tcl_DStringAppend (&dStr, domNamespaceURI(node), -1);
3627 Tcl_DStringAppend (&dStr, ":", 1);
3628 domSplitQName (node->nodeName, prefix, &localName);
3629 Tcl_DStringAppend (&dStr, localName, -1);
3630 h = Tcl_FindHashEntry (
3631 node->ownerDocument->doctype->cdataSectionElements,
3632 Tcl_DStringValue (&dStr));
3633 Tcl_DStringFree (&dStr);
3634 } else {
3635 h = Tcl_FindHashEntry (
3636 node->ownerDocument->doctype->cdataSectionElements,
3637 node->nodeName);
3638 }
3639 if (h) {
3640 cdataChild = 1;
3641 }
3642 }
3643 tcldom_treeAsXML(resultPtr, node, indent, 0, 1, chan, encString,
3644 cdataChild, outputFlags, indentAttrs);
3645 Tcl_SetObjResult(interp, resultPtr);
3646 if (encString) {
3647 Tcl_DecrRefCount(encString);
3648 }
3649 return TCL_OK;
3650 cleanup:
3651 if (encString) {
3652 Tcl_DecrRefCount(encString);
3653 }
3654 return TCL_ERROR;
3655 }
3656
3657 /*----------------------------------------------------------------------------
3658 | serializeAsHTML
3659 |
3660 \---------------------------------------------------------------------------*/
serializeAsHTML(domNode * node,Tcl_Interp * interp,int objc,Tcl_Obj * const objv[])3661 static int serializeAsHTML (
3662 domNode *node,
3663 Tcl_Interp *interp,
3664 int objc,
3665 Tcl_Obj *const objv[]
3666 )
3667 {
3668 char *channelId;
3669 int optionIndex, mode, escapeNonASCII = 0, htmlEntities = 0;
3670 int doctypeDeclaration = 0;
3671 Tcl_Obj *resultPtr;
3672 Tcl_Channel chan = (Tcl_Channel) NULL;
3673
3674 static const char *asHTMLOptions[] = {
3675 "-channel", "-escapeNonASCII", "-htmlEntities", "-doctypeDeclaration",
3676 NULL
3677 };
3678 enum asHTMLOption {
3679 m_channel, m_escapeNonASCII, m_htmlEntities, m_doctypeDeclaration
3680 };
3681
3682 if (objc > 8) {
3683 Tcl_WrongNumArgs(interp, 2, objv,
3684 "?-channel <channelId>? ?-escapeNonASCII? "
3685 "?-htmlEntities? ?-doctypeDeclaration <boolean>?");
3686 return TCL_ERROR;
3687 }
3688 while (objc > 2) {
3689 if (Tcl_GetIndexFromObj(interp, objv[2], asHTMLOptions, "option",
3690 0, &optionIndex) != TCL_OK) {
3691 return TCL_ERROR;
3692 }
3693 switch ((enum asHTMLOption) optionIndex) {
3694
3695 case m_channel:
3696 if (objc < 4) {
3697 SetResult("-channel must have a channeldID as argument");
3698 return TCL_ERROR;
3699 }
3700 channelId = Tcl_GetString(objv[3]);
3701 chan = Tcl_GetChannel(interp, channelId, &mode);
3702 if (chan == (Tcl_Channel) NULL) {
3703 SetResult("-channel must have a channeldID as argument");
3704 return TCL_ERROR;
3705 }
3706 if ((mode & TCL_WRITABLE) == 0) {
3707 Tcl_AppendResult(interp, "channel \"", channelId,
3708 "\" wasn't opened for writing", (char*)NULL);
3709 return TCL_ERROR;
3710 }
3711 objc -= 2;
3712 objv += 2;
3713 break;
3714
3715 case m_escapeNonASCII:
3716 escapeNonASCII = 1;
3717 objc--;
3718 objv++;
3719 break;
3720
3721 case m_htmlEntities:
3722 htmlEntities = 1;
3723 objc--;
3724 objv++;
3725 break;
3726
3727 case m_doctypeDeclaration:
3728 if (node->nodeType != DOCUMENT_NODE) {
3729 SetResult("-doctypeDeclaration as flag to the method "
3730 "'asHTML' is only allowed for domDocCmds");
3731 return TCL_ERROR;
3732 }
3733 if (objc < 4) {
3734 SetResult("-doctypeDeclaration must have a boolean value "
3735 "as argument");
3736 return TCL_ERROR;
3737 }
3738 if (Tcl_GetBooleanFromObj(interp, objv[3], &doctypeDeclaration)
3739 != TCL_OK) {
3740 return TCL_ERROR;
3741 }
3742 objc -= 2;
3743 objv += 2;
3744 break;
3745 }
3746 }
3747 resultPtr = Tcl_NewStringObj("", 0);
3748 tcldom_treeAsHTML(resultPtr, node, chan, escapeNonASCII, htmlEntities,
3749 doctypeDeclaration, 0);
3750 Tcl_AppendResult(interp, Tcl_GetString(resultPtr), NULL);
3751 Tcl_DecrRefCount(resultPtr);
3752 return TCL_OK;
3753 }
3754
3755 /*----------------------------------------------------------------------------
3756 | serializeAsJSON
3757 |
3758 \---------------------------------------------------------------------------*/
serializeAsJSON(domNode * node,Tcl_Interp * interp,int objc,Tcl_Obj * const objv[])3759 static int serializeAsJSON (
3760 domNode *node,
3761 Tcl_Interp *interp,
3762 int objc,
3763 Tcl_Obj *const objv[]
3764 )
3765 {
3766 char *channelId;
3767 int optionIndex, mode, indent = -1;
3768 Tcl_Obj *resultPtr;
3769 Tcl_Channel chan = (Tcl_Channel) NULL;
3770
3771 static const char *asJSONOptions[] = {
3772 "-channel", "-indent",
3773 NULL
3774 };
3775 enum asJSONOption {
3776 m_channel, m_indent
3777 };
3778
3779 if (node->nodeType != ELEMENT_NODE) {
3780 SetResult("Not an element node.\n");
3781 return TCL_ERROR;
3782 }
3783
3784 if (objc > 5) {
3785 Tcl_WrongNumArgs(interp, 2, objv,
3786 "?-channel <channelId>? "
3787 "?-indent <none,0..8>?");
3788 return TCL_ERROR;
3789 }
3790 while (objc > 2) {
3791 if (Tcl_GetIndexFromObj(interp, objv[2], asJSONOptions, "option",
3792 0, &optionIndex) != TCL_OK) {
3793 return TCL_ERROR;
3794 }
3795 switch ((enum asJSONOption) optionIndex) {
3796
3797 case m_channel:
3798 if (objc < 4) {
3799 SetResult("-channel must have a channeldID as argument");
3800 return TCL_ERROR;
3801 }
3802 channelId = Tcl_GetString(objv[3]);
3803 chan = Tcl_GetChannel(interp, channelId, &mode);
3804 if (chan == (Tcl_Channel) NULL) {
3805 SetResult("-channel must have a channeldID as argument");
3806 return TCL_ERROR;
3807 }
3808 if ((mode & TCL_WRITABLE) == 0) {
3809 Tcl_AppendResult(interp, "channel \"", channelId,
3810 "\" wasn't opened for writing", (char*)NULL);
3811 return TCL_ERROR;
3812 }
3813 objc -= 2;
3814 objv += 2;
3815 break;
3816
3817 case m_indent:
3818 if (objc < 4) {
3819 SetResult("-indent must have an argument "
3820 "(0..8 or 'no'/'none')");
3821 return TCL_ERROR;
3822 }
3823 if (strcmp("none", Tcl_GetString(objv[3]))==0) {
3824 indent = -1;
3825 }
3826 else if (strcmp("no", Tcl_GetString(objv[3]))==0) {
3827 indent = -1;
3828 }
3829 else if (Tcl_GetIntFromObj(interp, objv[3], &indent) != TCL_OK) {
3830 SetResult( "indent must be an integer (0..8) or 'no'/'none'");
3831 return TCL_ERROR;
3832 } else if (indent < 0 || indent > 8) {
3833 SetResult( "indent must be an integer (0..8) or 'no'/'none'");
3834 return TCL_ERROR;
3835 }
3836
3837 objc -= 2;
3838 objv += 2;
3839 break;
3840 }
3841 }
3842 resultPtr = Tcl_NewStringObj("", 0);
3843 tcldom_treeAsJSON(resultPtr, node, chan, indent, 0, JSON_START);
3844 Tcl_AppendResult(interp, Tcl_GetString(resultPtr), NULL);
3845 Tcl_DecrRefCount(resultPtr);
3846 return TCL_OK;
3847 }
3848
3849 /*----------------------------------------------------------------------------
3850 | cdataSectionElements
3851 |
3852 \---------------------------------------------------------------------------*/
cdataSectionElements(domDocument * doc,Tcl_Interp * interp,int objc,Tcl_Obj * const objv[])3853 static int cdataSectionElements (
3854 domDocument *doc,
3855 Tcl_Interp *interp,
3856 int objc,
3857 Tcl_Obj *const objv[]
3858 )
3859 {
3860 int result, hnew;
3861 Tcl_Obj *resultPtr,*namePtr;
3862 Tcl_HashEntry *h;
3863 Tcl_HashSearch search;
3864
3865 CheckArgs (3,4,0, "<domDoc> cdataSectionElements ?URI:?localname "
3866 "?boolean?");
3867 if (objc == 3) {
3868 if (Tcl_GetString(objv[2])[0] == '*'
3869 && Tcl_GetString(objv[2])[1] == '\0') {
3870 Tcl_ResetResult (interp);
3871 if (doc->doctype && doc->doctype->cdataSectionElements) {
3872 resultPtr = Tcl_GetObjResult (interp);
3873 for (h = Tcl_FirstHashEntry (
3874 doc->doctype->cdataSectionElements, &search);
3875 h != NULL;
3876 h = Tcl_NextHashEntry(&search)) {
3877 namePtr = Tcl_NewStringObj (
3878 Tcl_GetHashKey (doc->doctype->cdataSectionElements,
3879 h), -1);
3880 result = Tcl_ListObjAppendElement (interp, resultPtr,
3881 namePtr);
3882 if (result != TCL_OK) {
3883 Tcl_DecrRefCount(namePtr);
3884 return result;
3885 }
3886 }
3887 }
3888 return TCL_OK;
3889 }
3890 if (!doc->doctype || !doc->doctype->cdataSectionElements) {
3891 SetBooleanResult (0);
3892 } else {
3893 if (Tcl_FindHashEntry (doc->doctype->cdataSectionElements,
3894 Tcl_GetString (objv[2]))) {
3895 SetBooleanResult (1);
3896 } else {
3897 SetBooleanResult (0);
3898 }
3899 }
3900 } else {
3901 if (Tcl_GetBooleanFromObj (interp, objv[3], &result)
3902 != TCL_OK) {
3903 return TCL_ERROR;
3904 }
3905 if (result) {
3906 if (!doc->doctype) {
3907 doc->doctype = (domDocInfo *)MALLOC(sizeof(domDocInfo));
3908 memset(doc->doctype, 0,(sizeof(domDocInfo)));
3909 }
3910 if (!doc->doctype->cdataSectionElements) {
3911 doc->doctype->cdataSectionElements =
3912 (Tcl_HashTable *)MALLOC(sizeof(Tcl_HashTable));
3913 Tcl_InitHashTable (doc->doctype->cdataSectionElements,
3914 TCL_STRING_KEYS);
3915 }
3916 Tcl_CreateHashEntry (doc->doctype->cdataSectionElements,
3917 Tcl_GetString (objv[2]), &hnew);
3918 } else {
3919 if (doc->doctype && doc->doctype->cdataSectionElements) {
3920 h = Tcl_FindHashEntry (doc->doctype->cdataSectionElements,
3921 Tcl_GetString (objv[2]));
3922 if (h) {
3923 Tcl_DeleteHashEntry (h);
3924 if (!doc->doctype->cdataSectionElements->numEntries) {
3925 Tcl_DeleteHashTable (
3926 doc->doctype->cdataSectionElements
3927 );
3928 FREE (doc->doctype->cdataSectionElements);
3929 doc->doctype->cdataSectionElements = NULL;
3930 }
3931 }
3932 }
3933 }
3934 SetBooleanResult(result);
3935 }
3936 return TCL_OK;
3937 }
3938
3939 /*----------------------------------------------------------------------------
3940 | selectNodesNamespaces
3941 |
3942 \---------------------------------------------------------------------------*/
selectNodesNamespaces(domDocument * doc,Tcl_Interp * interp,int objc,Tcl_Obj * const objv[])3943 static int selectNodesNamespaces (
3944 domDocument *doc,
3945 Tcl_Interp *interp,
3946 int objc,
3947 Tcl_Obj *const objv[]
3948 )
3949 {
3950 int len, i, result;
3951 Tcl_Obj *objPtr, *listPtr;
3952
3953 CheckArgs (2,3,2, "?prefixUriList?");
3954 if (objc == 3) {
3955 result = Tcl_ListObjLength (interp, objv[2], &len);
3956 if (result != TCL_OK || (len % 2) != 0) {
3957 SetResult ("The optional argument to the selectNodesNamespaces"
3958 " method must be a 'prefix namespace' pairs list");
3959 return TCL_ERROR;
3960 }
3961 i = 0;
3962 if (doc->prefixNSMappings) {
3963 while (doc->prefixNSMappings[i]) {
3964 FREE (doc->prefixNSMappings[i]);
3965 i++;
3966 }
3967 }
3968 if (i < len + 1) {
3969 if (doc->prefixNSMappings) FREE (doc->prefixNSMappings);
3970 doc->prefixNSMappings = MALLOC (sizeof (char*)*(len+1));
3971 }
3972 for (i = 0; i < len; i++) {
3973 Tcl_ListObjIndex (interp, objv[2], i, &objPtr);
3974 doc->prefixNSMappings[i] = tdomstrdup (Tcl_GetString (objPtr));
3975 }
3976 doc->prefixNSMappings[len] = NULL;
3977 Tcl_SetObjResult (interp, objv[2]);
3978 } else {
3979 listPtr = Tcl_NewListObj (0, NULL);
3980 i = 0;
3981 if (doc->prefixNSMappings) {
3982 while (doc->prefixNSMappings[i]) {
3983 objPtr = Tcl_NewStringObj (doc->prefixNSMappings[i], -1);
3984 Tcl_ListObjAppendElement (interp, listPtr, objPtr);
3985 i++;
3986 }
3987 }
3988 Tcl_SetObjResult (interp, listPtr);
3989 }
3990 return TCL_OK;
3991 }
3992
3993 /*----------------------------------------------------------------------------
3994 | renameNodes
3995 |
3996 \---------------------------------------------------------------------------*/
renameNodes(domDocument * doc,Tcl_Interp * interp,int objc,Tcl_Obj * const objv[])3997 static int renameNodes (
3998 domDocument *doc,
3999 Tcl_Interp *interp,
4000 int objc,
4001 Tcl_Obj *const objv[]
4002 )
4003 {
4004 int len, i, hnew;
4005 Tcl_HashEntry *h;
4006 Tcl_Obj *objPtr;
4007 domNode *node;
4008
4009 CheckArgs (4,4,0, "<domDoc> renameNode nodeList name");
4010 if (Tcl_ListObjLength (interp, objv[2], &len) != TCL_OK) {
4011 SetResult ("The first argument to the renameNode method"
4012 " must be a list of element nodes.");
4013 return TCL_ERROR;
4014 }
4015 h = Tcl_CreateHashEntry(&HASHTAB(doc,tdom_tagNames),
4016 Tcl_GetString(objv[3]), &hnew);
4017 for (i = 0; i < len; i++) {
4018 Tcl_ListObjIndex (interp, objv[2], i, &objPtr);
4019 node = tcldom_getNodeFromObj (interp, objPtr);
4020 if (node == NULL) {
4021 return TCL_ERROR;
4022 }
4023 node->nodeName = (char *)&(h->key);
4024 }
4025 return TCL_OK;
4026 }
4027
4028 /*----------------------------------------------------------------------------
4029 | deleteXPathCache
4030 |
4031 \---------------------------------------------------------------------------*/
deleteXPathCache(domDocument * doc,Tcl_Interp * interp,int objc,Tcl_Obj * const objv[])4032 static int deleteXPathCache (
4033 domDocument *doc,
4034 Tcl_Interp *interp,
4035 int objc,
4036 Tcl_Obj *const objv[]
4037 )
4038 {
4039 Tcl_HashEntry *h;
4040 Tcl_HashSearch search;
4041
4042 CheckArgs (2,3,0, "<domDoc> deleteXPathCache ?xpathQuery?");
4043 if (objc == 3) {
4044 if (!doc->xpathCache) {
4045 return TCL_OK;
4046 }
4047 h = Tcl_FindHashEntry (doc->xpathCache, Tcl_GetString(objv[2]));
4048 if (h) {
4049 xpathFreeAst((ast)Tcl_GetHashValue (h));
4050 Tcl_DeleteHashEntry (h);
4051 }
4052 return TCL_OK;
4053 }
4054 if (!doc->xpathCache) {
4055 return TCL_OK;
4056 }
4057 h = Tcl_FirstHashEntry (doc->xpathCache, &search);
4058 while (h) {
4059 xpathFreeAst((ast)Tcl_GetHashValue (h));
4060 h = Tcl_NextHashEntry (&search);
4061 }
4062 Tcl_DeleteHashTable (doc->xpathCache);
4063 FREE (doc->xpathCache);
4064 doc->xpathCache = NULL;
4065 return TCL_OK;
4066 }
4067
4068
4069 /*----------------------------------------------------------------------------
4070 | applyXSLT
4071 |
4072 \---------------------------------------------------------------------------*/
applyXSLT(domNode * node,Tcl_Interp * interp,void * clientData,int objc,Tcl_Obj * const objv[])4073 static int applyXSLT (
4074 domNode *node,
4075 Tcl_Interp *interp,
4076 void *clientData,
4077 int objc,
4078 Tcl_Obj *const objv[]
4079 )
4080 {
4081 char *usage, **parameters = NULL, *errMsg, *option;
4082 Tcl_Obj *objPtr, *localListPtr = (Tcl_Obj *)NULL;
4083 int i, result, length, optionIndex;
4084 int ignoreUndeclaredParameters = 0;
4085 int maxApplyDepth = MAX_XSLT_APPLY_DEPTH;
4086 domDocument *xsltDoc, *xmlDoc, *resultDoc = NULL;
4087 XsltMsgCBInfo xsltMsgInfo;
4088
4089 static char *method_usage =
4090 "wrong # args: should be \"nodeObj xslt ?-parameters parameterList? "
4091 "?-ignoreUndeclaredParameters? ?-maxApplyDepth int? "
4092 "?-xsltmessagecmd cmd? xsltDocNode ?varname?\"";
4093
4094 static char *cmd_usage =
4095 "wrong # args: should be \"?-parameters parameterList? "
4096 "?-ignoreUndeclaredParameters? ?-maxApplyDepth int? "
4097 "?-xsltmessagecmd cmd? <xmlDocObj> ?objVar?\"";
4098
4099 static const char *xsltOptions[] = {
4100 "-parameters", "-ignoreUndeclaredParameters",
4101 "-maxApplyDepth", "-xsltmessagecmd", NULL
4102 };
4103
4104 enum xsltOption {
4105 m_parameters, m_ignoreUndeclaredParameters, m_maxApplyDepth,
4106 m_xsltmessagecmd
4107 };
4108
4109 xsltMsgInfo.interp = interp;
4110 xsltMsgInfo.msgcmd = NULL;
4111
4112 if (node) usage = method_usage;
4113 else usage = cmd_usage;
4114
4115 while (objc > 1) {
4116 option = Tcl_GetString(objv[0]);
4117 if (option[0] != '-') {
4118 break;
4119 }
4120 if (Tcl_GetIndexFromObj(interp, objv[0], xsltOptions, "option", 0,
4121 &optionIndex) != TCL_OK) {
4122 goto applyXSLTCleanUP;
4123 }
4124
4125 switch ((enum xsltOption) optionIndex) {
4126
4127 case m_parameters:
4128 if (objc < 3) {SetResult(usage); goto applyXSLTCleanUP;}
4129 if (Tcl_ListObjLength(interp, objv[1], &length) != TCL_OK) {
4130 SetResult("ill-formed parameters list: the -parameters "
4131 "option needs a list of parameter name and "
4132 "parameter value pairs");
4133 goto applyXSLTCleanUP;
4134 }
4135 if (length % 2) {
4136 SetResult("parameter value missing: the -parameters "
4137 "option needs a list of parameter name and "
4138 "parameter value pairs");
4139 goto applyXSLTCleanUP;
4140 }
4141 if (parameters) {
4142 SetResult("only one -parameters option allowed");
4143 goto applyXSLTCleanUP;
4144 }
4145 localListPtr = Tcl_DuplicateObj(objv[1]);
4146 Tcl_IncrRefCount(localListPtr);
4147 parameters = (char **)MALLOC(sizeof(char *)*(length+1));
4148 for (i = 0; i < length; i ++) {
4149 Tcl_ListObjIndex(interp, localListPtr, i, &objPtr);
4150 parameters[i] = Tcl_GetString(objPtr);
4151 }
4152 parameters[length] = NULL;
4153 objc -= 2;
4154 objv += 2;
4155 break;
4156
4157 case m_maxApplyDepth:
4158 if (objc < 3) {SetResult(usage); goto applyXSLTCleanUP;}
4159 if (Tcl_GetIntFromObj(interp, objv[1], &maxApplyDepth)
4160 != TCL_OK) {
4161 SetResult("-maxApplyDepth requires a positive integer "
4162 "as argument");
4163 goto applyXSLTCleanUP;
4164 }
4165 if (maxApplyDepth < 1) {
4166 SetResult("-maxApplyDepth requires a positive integer "
4167 "as argument");
4168 goto applyXSLTCleanUP;
4169 }
4170 objc -= 2;
4171 objv += 2;
4172 break;
4173
4174 case m_ignoreUndeclaredParameters:
4175 if (objc < 2) {SetResult(usage); goto applyXSLTCleanUP;}
4176 ignoreUndeclaredParameters = 1;
4177 objc--; objv++;
4178 break;
4179
4180 case m_xsltmessagecmd:
4181 if (objc < 3) {SetResult(usage); goto applyXSLTCleanUP;}
4182 if (xsltMsgInfo.msgcmd) {
4183 Tcl_DecrRefCount(xsltMsgInfo.msgcmd);
4184 }
4185 xsltMsgInfo.msgcmd = objv[1];
4186 Tcl_IncrRefCount(xsltMsgInfo.msgcmd);
4187 objc -= 2;
4188 objv += 2;
4189 break;
4190 }
4191 }
4192 if (objc > 2 || objc < 1) {SetResult(usage); goto applyXSLTCleanUP;}
4193 if (node) {
4194 xsltDoc = tcldom_getDocumentFromName(interp, Tcl_GetString(objv[0]),
4195 &errMsg);
4196 if (xsltDoc == NULL) {
4197 SetResult( errMsg );
4198 goto applyXSLTCleanUP;
4199 }
4200 } else {
4201 xmlDoc = tcldom_getDocumentFromName(interp,Tcl_GetString(objv[0]),
4202 &errMsg);
4203 if (xmlDoc == NULL) {
4204 SetResult( errMsg );
4205 goto applyXSLTCleanUP;
4206 }
4207 node = (domNode *) xmlDoc;
4208 xsltDoc = NULL;
4209 }
4210 result = xsltProcess(xsltDoc, node, clientData, parameters,
4211 ignoreUndeclaredParameters,
4212 maxApplyDepth,
4213 tcldom_xpathFuncCallBack, interp,
4214 tcldom_xsltMsgCB, &xsltMsgInfo,
4215 &errMsg, &resultDoc);
4216
4217 if (result < 0) {
4218 SetResult( errMsg );
4219 FREE(errMsg);
4220 if (objc == 2) {
4221 Tcl_SetVar (interp, Tcl_GetString(objv[1]), "", 0);
4222 }
4223 goto applyXSLTCleanUP;
4224 }
4225 if (parameters) {
4226 Tcl_DecrRefCount(localListPtr);
4227 FREE((char *) parameters);
4228 }
4229 if (xsltMsgInfo.msgcmd) {
4230 Tcl_DecrRefCount(xsltMsgInfo.msgcmd);
4231 }
4232 return tcldom_returnDocumentObj(interp, resultDoc, (objc == 2),
4233 (objc == 2) ? objv[1] : NULL, 1, 0);
4234
4235 applyXSLTCleanUP:
4236 if (localListPtr) {
4237 Tcl_DecrRefCount(localListPtr);
4238 FREE((char *) parameters);
4239 }
4240 if (xsltMsgInfo.msgcmd) {
4241 Tcl_DecrRefCount(xsltMsgInfo.msgcmd);
4242 }
4243 return TCL_ERROR;
4244 }
4245
4246 /*----------------------------------------------------------------------------
4247 | tcldom_XSLTObjCmd
4248 |
4249 \---------------------------------------------------------------------------*/
tcldom_XSLTObjCmd(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * const objv[])4250 static int tcldom_XSLTObjCmd (
4251 ClientData clientData,
4252 Tcl_Interp *interp,
4253 int objc,
4254 Tcl_Obj *const objv[]
4255 )
4256 {
4257 int index;
4258 char *errMsg = NULL;
4259
4260 static const char *options[] = {
4261 "transform", "delete", NULL
4262 };
4263 enum option {
4264 m_transform, m_delete
4265 };
4266
4267
4268 /* Longest possible call currently is:
4269 xsltCmd transform -parameters parameterList \
4270 -ignoreUndeclaredParameters
4271 -xsltmessagecmd cmd <xmlDocObj> objVar */
4272 CheckArgs(2,9,1,"option ?arg ...?");
4273
4274 /* This is not optimal, because we do the
4275 tcldom_getDocumentFromName call here and again in
4276 applyXSLT. This is only transitional, until <domNode xslt ..>
4277 will be deprecated */
4278 if ((tcldom_getDocumentFromName (interp, Tcl_GetString(objv[1]), &errMsg)
4279 != NULL)
4280 || (Tcl_GetString (objv[1])[0] == '-')) {
4281 /* Method obmitted, may default to "transform", try this */
4282 objv++;
4283 objc--;
4284 return applyXSLT(NULL, interp, (void *) clientData, objc, objv);
4285 }
4286
4287 if (Tcl_GetIndexFromObj (interp, objv[1], options, "option", 0, &index)
4288 != TCL_OK) {
4289 return TCL_ERROR;
4290 }
4291 switch ((enum option) index) {
4292 case m_transform:
4293 objv++;objv++;
4294 objc--;objc--;
4295 return applyXSLT(NULL, interp, (void *) clientData, objc, objv);
4296 case m_delete:
4297 if (objc != 2) {
4298 Tcl_WrongNumArgs(interp, 2, objv, "");
4299 return TCL_ERROR;
4300 }
4301 Tcl_DeleteCommand(interp, Tcl_GetString(objv[0]));
4302 }
4303 return TCL_OK;
4304 }
4305
4306 /*----------------------------------------------------------------------------
4307 | convertToXSLTCmd
4308 |
4309 \---------------------------------------------------------------------------*/
convertToXSLTCmd(domDocument * doc,Tcl_Interp * interp,int setVariable,Tcl_Obj * var_name)4310 static int convertToXSLTCmd (
4311 domDocument *doc,
4312 Tcl_Interp *interp,
4313 int setVariable,
4314 Tcl_Obj *var_name
4315 )
4316 {
4317 char *errMsg, *objVar, objCmdName[80];
4318 ClientData *clientData;
4319
4320 doc->nodeFlags |= DONT_FREE;
4321 clientData = (ClientData *) xsltCompileStylesheet(doc,
4322 tcldom_xpathFuncCallBack,
4323 interp, 0, &errMsg);
4324 if (!clientData) {
4325 SetResult(errMsg);
4326 if (setVariable) {
4327 objVar = Tcl_GetString(var_name);
4328 Tcl_UnsetVar(interp, objVar, 0);
4329 Tcl_SetVar (interp, objVar, "", 0);
4330 }
4331 FREE(errMsg);
4332 return TCL_ERROR;
4333 }
4334 DOC_CMD(objCmdName, doc);
4335 Tcl_DeleteCommand( interp, objCmdName );
4336 XSLT_CMD(objCmdName, doc);
4337 Tcl_CreateObjCommand(interp, objCmdName, tcldom_XSLTObjCmd, clientData,
4338 xsltFreeStateWrapper);
4339 if (setVariable) {
4340 objVar = Tcl_GetString(var_name);
4341 Tcl_UnsetVar (interp, objVar, 0);
4342 Tcl_SetVar (interp, objVar, objCmdName, 0);
4343 }
4344 SetResult(objCmdName);
4345 return TCL_OK;
4346 }
4347
4348 /*----------------------------------------------------------------------------
4349 | tcldom_NodeObjCmd
4350 |
4351 \---------------------------------------------------------------------------*/
tcldom_NodeObjCmd(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * const objv[])4352 int tcldom_NodeObjCmd (
4353 ClientData clientData,
4354 Tcl_Interp *interp,
4355 int objc,
4356 Tcl_Obj *const objv[]
4357 )
4358 {
4359 GetTcldomTSD()
4360
4361 domNode *node, *child, *refChild, *oldChild, *refNode;
4362 domNS *ns;
4363 domAttrNode *attrs;
4364 domException exception;
4365 char tmp[200], prefix[MAX_PREFIX_LEN], *method, *nodeName,
4366 *str, *attr_name, *attr_val, *filter;
4367 const char *localName, *uri, *nsStr;
4368 int result, length, methodIndex, i, line, column;
4369 int nsIndex, bool, hnew, legacy, jsonType, fromToken = 0;
4370 Tcl_Obj *namePtr, *resultPtr;
4371 Tcl_Obj *mobjv[MAX_REWRITE_ARGS];
4372 Tcl_CmdInfo cmdInfo;
4373 Tcl_HashEntry *h;
4374
4375 static const char *nodeMethods[] = {
4376 "firstChild", "nextSibling", "getAttribute", "nodeName",
4377 "nodeValue", "nodeType", "attributes", "asList",
4378 "find", "setAttribute", "removeAttribute", "parentNode",
4379 "previousSibling", "lastChild", "appendChild", "removeChild",
4380 "hasChildNodes", "localName", "childNodes", "ownerDocument",
4381 "insertBefore", "replaceChild", "getLine", "getColumn",
4382 "asXML", "appendFromList", "child", "fsibling",
4383 "psibling", "descendant", "ancestor", "text",
4384 "root", "hasAttribute", "cloneNode", "appendXML",
4385 "target", "data", "selectNodes", "namespaceURI",
4386 "getAttributeNS", "setAttributeNS", "hasAttributeNS", "removeAttributeNS",
4387 "asHTML", "prefix", "getBaseURI", "appendFromScript",
4388 "xslt", "toXPath", "delete", "getElementById",
4389 "getElementsByTagName", "getElementsByTagNameNS",
4390 "disableOutputEscaping", "precedes", "asText",
4391 "insertBeforeFromScript", "normalize", "baseURI",
4392 "asJSON", "jsonType", "attributeNames",
4393 #ifdef TCL_THREADS
4394 "readlock", "writelock",
4395 #endif
4396 NULL
4397 };
4398 enum nodeMethod {
4399 m_firstChild, m_nextSibling, m_getAttribute, m_nodeName,
4400 m_nodeValue, m_nodeType, m_attributes, m_asList,
4401 m_find, m_setAttribute, m_removeAttribute, m_parentNode,
4402 m_previousSibling, m_lastChild, m_appendChild, m_removeChild,
4403 m_hasChildNodes, m_localName, m_childNodes, m_ownerDocument,
4404 m_insertBefore, m_replaceChild, m_getLine, m_getColumn,
4405 m_asXML, m_appendFromList, m_child, m_fsibling,
4406 m_psibling, m_descendant, m_ancestor, m_text,
4407 m_root, m_hasAttribute, m_cloneNode, m_appendXML,
4408 m_target, m_data, m_selectNodes, m_namespaceURI,
4409 m_getAttributeNS, m_setAttributeNS, m_hasAttributeNS, m_removeAttributeNS,
4410 m_asHTML, m_prefix, m_getBaseURI, m_appendFromScript,
4411 m_xslt, m_toXPath, m_delete, m_getElementById,
4412 m_getElementsByTagName, m_getElementsByTagNameNS,
4413 m_disableOutputEscaping, m_precedes, m_asText,
4414 m_insertBeforeFromScript, m_normalize, m_baseURI,
4415 m_asJSON, m_jsonType, m_attributeNames
4416 #ifdef TCL_THREADS
4417 ,m_readlock, m_writelock
4418 #endif
4419 };
4420
4421 node = (domNode*) clientData;
4422 if (TSD(domCreateCmdMode) == DOM_CREATECMDMODE_AUTO) {
4423 TSD(dontCreateObjCommands) = 0;
4424 }
4425 if (node == NULL) {
4426 if (objc < 3) {
4427 SetResult(node_usage);
4428 return TCL_ERROR;
4429 }
4430 if (TSD(domCreateCmdMode) == DOM_CREATECMDMODE_AUTO) {
4431 TSD(dontCreateObjCommands) = 1;
4432 }
4433 node = tcldom_getNodeFromObj(interp, objv[1]);
4434 if (node == NULL) {
4435 return TCL_ERROR;
4436 }
4437 fromToken = 1;
4438 objc--;
4439 objv++;
4440 }
4441 if (objc < 2) {
4442 SetResult(node_usage);
4443 return TCL_ERROR;
4444 }
4445 if (Tcl_GetIndexFromObj(NULL, objv[1], nodeMethods, "method", 0,
4446 &methodIndex) != TCL_OK) {
4447
4448 method = Tcl_GetString(objv[1]);
4449 if (*method != '@') {
4450 /*--------------------------------------------------------
4451 | not a getAttribute short cut:
4452 | try to find method implemented as normal Tcl proc
4453 \-------------------------------------------------------*/
4454 result = 0;
4455 if (node->nodeType == ELEMENT_NODE) {
4456 /*----------------------------------------------------
4457 | try to find Tcl level node specific method proc
4458 |
4459 | ::dom::domNode::<nodeName>::<method>
4460 |
4461 \---------------------------------------------------*/
4462 sprintf(tmp, "::dom::domNode::%s::%s", (char*)node->nodeName,
4463 method);
4464 DBG(fprintf(stderr, "testing %s\n", tmp));
4465 result = Tcl_GetCommandInfo(interp, tmp, &cmdInfo);
4466 }
4467 if (!result) {
4468 /*----------------------------------------------------
4469 | try to find Tcl level general method proc
4470 |
4471 | ::dom::domNode::<method>
4472 |
4473 \---------------------------------------------------*/
4474 sprintf(tmp, "::dom::domNode::%s", method);
4475 DBG(fprintf(stderr, "testing %s\n", tmp));
4476 result = Tcl_GetCommandInfo(interp, tmp, &cmdInfo);
4477 }
4478 if (!result) {
4479 SetResult(node_usage);
4480 return TCL_ERROR;
4481 }
4482 if (!cmdInfo.isNativeObjectProc) {
4483 SetResult("can't access Tcl level method!");
4484 return TCL_ERROR;
4485 }
4486 if (objc >= MAX_REWRITE_ARGS) {
4487 SetResult("too many args to call Tcl level method!");
4488 return TCL_ERROR;
4489 }
4490 mobjv[0] = objv[1];
4491 mobjv[1] = objv[0];
4492 for (i=2; i<objc; i++) mobjv[i] = objv[i];
4493 return cmdInfo.objProc(cmdInfo.objClientData, interp, objc, mobjv);
4494 }
4495
4496 /*--------------------------------------------------------
4497 | @<attributeName>: try to look up attribute
4498 \-------------------------------------------------------*/
4499 Tcl_ResetResult(interp);
4500 CheckArgs(2,3,1,"@<attributeName> ?defaultvalue?");
4501 if (node->nodeType != ELEMENT_NODE) {
4502 SetResult("NOT_AN_ELEMENT : there are no attributes");
4503 return TCL_ERROR;
4504 }
4505 attrs = node->firstAttr;
4506 while (attrs && strcmp(attrs->nodeName, &(method[1]))) {
4507 attrs = attrs->nextSibling;
4508 }
4509 if (attrs) {
4510 SetResult(attrs->nodeValue);
4511 } else {
4512 if (objc == 3) {
4513 SetResult(Tcl_GetString(objv[2]));
4514 } else {
4515 Tcl_ResetResult(interp);
4516 Tcl_AppendResult(interp, "Attribute \"", &(method[1]),
4517 "\" not found!", NULL);
4518 return TCL_ERROR;
4519 }
4520 }
4521 return TCL_OK;
4522 }
4523
4524 /*----------------------------------------------------------------------
4525 | node may have been deleted in the meantime by some other
4526 | thread operating on the tree, so check this fact before.
4527 |
4528 \---------------------------------------------------------------------*/
4529
4530 if (node->nodeFlags & IS_DELETED) {
4531 SetResult("node has been deleted");
4532 return TCL_ERROR;
4533 }
4534
4535 /*----------------------------------------------------------------------
4536 | dispatch the node object method
4537 |
4538 \---------------------------------------------------------------------*/
4539 switch ((enum nodeMethod)methodIndex) {
4540
4541 case m_toXPath:
4542 CheckArgs(2,3,2,"?-legacy?");
4543 legacy = 0;
4544 if (objc == 3) {
4545 if (!strcmp(Tcl_GetString(objv[2]), "-legacy")) {
4546 legacy = 1;
4547 } else {
4548 SetResult("unknown option! Options: ?-legacy?");
4549 return TCL_ERROR;
4550 }
4551 }
4552 str = xpathNodeToXPath(node, legacy);
4553 SetResult (str);
4554 FREE (str);
4555 return TCL_OK;
4556
4557 case m_xslt:
4558 CheckArgs(3,9,2, "?-parameters parameterList? "
4559 "?-ignoreUndeclaredParameters? ?-xsltmessagecmd cmd? "
4560 "<xsltDocNode> ?objVar?");
4561 objv += 2; objc -= 2;
4562 return applyXSLT(node, interp, NULL, objc, objv);
4563
4564 case m_selectNodes:
4565 return tcldom_selectNodes (interp, node, --objc, ++objv);
4566
4567 case m_find:
4568 CheckArgs(4,5,2,"attrName attrVal ?nodeObjVar?");
4569 attr_name = Tcl_GetStringFromObj(objv[2], NULL);
4570 attr_val = Tcl_GetStringFromObj(objv[3], &length);
4571 return tcldom_setInterpAndReturnVar
4572 (interp, tcldom_find(node, attr_name, attr_val, length),
4573 (objc == 5), (objc == 5) ? objv[4] : NULL);
4574
4575 case m_child:
4576 CheckArgs(3,6,2,"instance|all ?type? ?attr value?");
4577 return tcldom_xpointerSearch(interp, XP_CHILD, node, objc, objv);
4578
4579 case m_descendant:
4580 CheckArgs(3,6,2,"instance|all ?type? ?attr value?");
4581 return tcldom_xpointerSearch(interp, XP_DESCENDANT,node,objc,objv);
4582
4583 case m_ancestor:
4584 CheckArgs(3,6,2,"instance|all ?type? ?attr value?");
4585 return tcldom_xpointerSearch(interp, XP_ANCESTOR, node,objc,objv);
4586
4587 case m_fsibling:
4588 CheckArgs(3,6,2,"instance|all ?type? ?attr value?");
4589 return tcldom_xpointerSearch(interp, XP_FSIBLING, node,objc,objv);
4590
4591 case m_psibling:
4592 CheckArgs(3,6,2,"instance|all ?type? ?attr value?");
4593 return tcldom_xpointerSearch(interp, XP_PSIBLING, node,objc,objv);
4594
4595 case m_root:
4596 CheckArgs(2,3,2,"?nodeObjVar?");
4597 while (node->parentNode) {
4598 node = node->parentNode;
4599 }
4600 return tcldom_setInterpAndReturnVar(interp, node, (objc == 3),
4601 (objc == 3) ? objv[2] : NULL);
4602
4603 case m_text:
4604 CheckArgs(2,2,2,"");
4605 if (node->nodeType != ELEMENT_NODE) {
4606 SetResult("NOT_AN_ELEMENT");
4607 return TCL_ERROR;
4608 }
4609 Tcl_ResetResult(interp);
4610 child = node->firstChild;
4611 while (child) {
4612 if ((child->nodeType == TEXT_NODE) ||
4613 (child->nodeType == CDATA_SECTION_NODE)) {
4614 Tcl_AppendToObj(Tcl_GetObjResult(interp),
4615 ((domTextNode*)child)->nodeValue,
4616 ((domTextNode*)child)->valueLength);
4617 }
4618 child = child->nextSibling;
4619 }
4620 return TCL_OK;
4621
4622 case m_attributes:
4623 CheckArgs(2,3,2,"?nameFilter?");
4624 if (node->nodeType != ELEMENT_NODE) {
4625 SetResult("");
4626 return TCL_OK;
4627 }
4628 filter = NULL;
4629 if (objc == 3) {
4630 filter = Tcl_GetString(objv[2]);
4631 }
4632 Tcl_ResetResult(interp);
4633 resultPtr = Tcl_GetObjResult(interp);
4634
4635 attrs = node->firstAttr;
4636 while (attrs != NULL) {
4637 if (!filter || Tcl_StringMatch((char*)attrs->nodeName, filter)) {
4638 if (attrs->namespace == 0) {
4639 namePtr = Tcl_NewStringObj((char*)attrs->nodeName, -1);
4640 } else {
4641 domSplitQName((char*)attrs->nodeName, prefix,
4642 &localName);
4643 mobjv[0] = Tcl_NewStringObj((char*)localName, -1);
4644 mobjv[1] = Tcl_NewStringObj(
4645 domNamespacePrefix((domNode*)attrs), -1
4646 );
4647 mobjv[2] = Tcl_NewStringObj(
4648 domNamespaceURI((domNode*)attrs), -1
4649 );
4650 namePtr = Tcl_NewListObj(3, mobjv);
4651 }
4652 result = Tcl_ListObjAppendElement(interp, resultPtr,
4653 namePtr);
4654 if (result != TCL_OK) {
4655 Tcl_DecrRefCount(namePtr);
4656 return result;
4657 }
4658 }
4659 attrs = attrs->nextSibling;
4660 }
4661 break;
4662
4663 case m_attributeNames:
4664 CheckArgs(2,3,2,"?nameFilter?");
4665 if (node->nodeType != ELEMENT_NODE) {
4666 SetResult("");
4667 return TCL_OK;
4668 }
4669 filter = NULL;
4670 if (objc == 3) {
4671 filter = Tcl_GetString(objv[2]);
4672 }
4673 resultPtr = Tcl_GetObjResult(interp);
4674
4675 attrs = node->firstAttr;
4676 while (attrs != NULL) {
4677 if (!filter || Tcl_StringMatch((char*)attrs->nodeName, filter)) {
4678 namePtr = Tcl_NewStringObj((char*)attrs->nodeName, -1);
4679 result = Tcl_ListObjAppendElement(interp, resultPtr,
4680 namePtr);
4681 if (result != TCL_OK) {
4682 Tcl_DecrRefCount(namePtr);
4683 return result;
4684 }
4685 }
4686 attrs = attrs->nextSibling;
4687 }
4688 break;
4689
4690 case m_asList:
4691 CheckArgs(2,2,2,"");
4692 Tcl_SetObjResult(interp, tcldom_treeAsTclList(interp, node));
4693 break;
4694
4695 case m_asXML:
4696 Tcl_ResetResult(interp);
4697 if (serializeAsXML(node, interp, objc, objv) != TCL_OK) {
4698 return TCL_ERROR;
4699 }
4700 break;
4701
4702 case m_asHTML:
4703 Tcl_ResetResult(interp);
4704 if (serializeAsHTML(node, interp, objc, objv) != TCL_OK) {
4705 return TCL_ERROR;
4706 }
4707 break;
4708
4709 case m_asJSON:
4710 if (serializeAsJSON(node, interp, objc, objv) != TCL_OK) {
4711 return TCL_ERROR;
4712 }
4713 break;
4714
4715 case m_getAttribute:
4716 CheckArgs(3,4,2,"attrName ?defaultValue?");
4717 if (node->nodeType != ELEMENT_NODE) {
4718 SetResult("NOT_AN_ELEMENT : there are no attributes");
4719 return TCL_ERROR;
4720 }
4721 attr_name = Tcl_GetString(objv[2]);
4722 attrs = node->firstAttr;
4723 while(attrs && strcmp(attrs->nodeName, attr_name)) {
4724 attrs = attrs->nextSibling;
4725 }
4726 if (attrs) {
4727 SetResult(attrs->nodeValue);
4728 return TCL_OK;
4729 }
4730 if (objc == 4) {
4731 SetResult(Tcl_GetString(objv[3]));
4732 return TCL_OK;
4733 } else {
4734 Tcl_ResetResult(interp);
4735 Tcl_AppendResult(interp, "Attribute \"", attr_name,
4736 "\" not found!", NULL);
4737 return TCL_ERROR;
4738 }
4739 break;
4740
4741 case m_getAttributeNS:
4742 CheckArgs(4,4,2,"uri localName");
4743 if (node->nodeType != ELEMENT_NODE) {
4744 SetResult("NOT_AN_ELEMENT : there are no attributes");
4745 return TCL_ERROR;
4746 }
4747 uri = Tcl_GetString(objv[2]);
4748 localName = Tcl_GetString(objv[3]);
4749 attrs = domGetAttributeNodeNS(node, uri, localName);
4750 if (attrs) {
4751 SetResult(attrs->nodeValue);
4752 return TCL_OK;
4753 }
4754 sprintf(tmp,"attribute with localName %80.80s not found!",localName);
4755 SetResult(tmp);
4756 return TCL_ERROR;
4757
4758 case m_setAttribute:
4759 if (node->nodeType != ELEMENT_NODE) {
4760 SetResult("NOT_AN_ELEMENT : there are no attributes");
4761 return TCL_ERROR;
4762 }
4763 if ((objc < 4) || ((objc % 2)!=0)) {
4764 SetResult("attrName value pairs expected");
4765 return TCL_ERROR;
4766 }
4767 for ( i = 2; i < objc; ) {
4768 attr_name = Tcl_GetString(objv[i++]);
4769 CheckName (interp, attr_name, "attribute", 0);
4770 attr_val = Tcl_GetString(objv[i++]);
4771 CheckText (interp, attr_val, "attribute");
4772 domSetAttribute(node, attr_name, attr_val);
4773 }
4774 return tcldom_setInterpAndReturnVar(interp, node, 0, NULL);
4775
4776 case m_setAttributeNS:
4777 if (node->nodeType != ELEMENT_NODE) {
4778 SetResult("NOT_AN_ELEMENT : there are no attributes");
4779 return TCL_ERROR;
4780 }
4781 if ((objc < 5) || (((objc - 2) % 3) != 0)) {
4782 SetResult("uri attrName value triples expected");
4783 return TCL_ERROR;
4784 }
4785 for (i = 2; i < objc;) {
4786 uri = Tcl_GetString(objv[i++]);
4787 attr_name = Tcl_GetString(objv[i++]);
4788 CheckName (interp, attr_name, "full qualified attribute", 1);
4789 attr_val = Tcl_GetString(objv[i++]);
4790 CheckText (interp, attr_val, "attribute");
4791 attrs = domSetAttributeNS(node, attr_name, attr_val, uri, 0);
4792 if (!attrs) {
4793 if (uri[0]) {
4794 SetResult("An attribute in a namespace "
4795 "must have a prefix");
4796 } else {
4797 SetResult("For all prefixed attributes with prefixes "
4798 "other than 'xml' or 'xmlns' "
4799 "you have to provide a namespace URI");
4800 }
4801 return TCL_ERROR;
4802 }
4803 }
4804 return tcldom_setInterpAndReturnVar(interp, node, 0, NULL);
4805
4806 case m_hasAttribute:
4807 CheckArgs(3,3,2,"attrName");
4808 if (node->nodeType != ELEMENT_NODE) {
4809 SetResult("NOT_AN_ELEMENT : there are no attributes");
4810 return TCL_ERROR;
4811 }
4812 attr_name = Tcl_GetString(objv[2]);
4813 attrs = node->firstAttr;
4814 while (attrs && strcmp(attrs->nodeName, attr_name)) {
4815 attrs = attrs->nextSibling;
4816 }
4817 if (attrs) {
4818 SetResult("1");
4819 return TCL_OK;
4820 }
4821 SetResult("0");
4822 return TCL_OK;
4823
4824 case m_hasAttributeNS:
4825 CheckArgs(4,4,2,"uri localName");
4826 if (node->nodeType != ELEMENT_NODE) {
4827 SetResult("NOT_AN_ELEMENT : there are no attributes");
4828 return TCL_ERROR;
4829 }
4830 uri = Tcl_GetString(objv[2]);
4831 localName = Tcl_GetString(objv[3]);
4832 attrs = node->firstAttr;
4833 while (attrs) {
4834 domSplitQName(attrs->nodeName, prefix, &nsStr);
4835 if (!strcmp(localName,nsStr)) {
4836 ns = domGetNamespaceByIndex(node->ownerDocument,
4837 attrs->namespace);
4838 if (ns && !strcmp(ns->uri, uri)) {
4839 SetResult("1");
4840 return TCL_OK;
4841 }
4842 }
4843 attrs = attrs->nextSibling;
4844 }
4845 SetResult("0");
4846 return TCL_OK;
4847
4848 case m_removeAttribute:
4849 CheckArgs(3,3,2,"attrName");
4850 if (node->nodeType != ELEMENT_NODE) {
4851 SetResult("NOT_AN_ELEMENT : there are no attributes");
4852 return TCL_ERROR;
4853 }
4854 attr_name = Tcl_GetString(objv[2]);
4855 result = domRemoveAttribute(node, attr_name);
4856 if (result) {
4857 SetResult("can't remove attribute '");
4858 AppendResult(attr_name);
4859 AppendResult("'");
4860 return TCL_ERROR;
4861 }
4862 return tcldom_setInterpAndReturnVar(interp, node, 0, NULL);
4863
4864 case m_removeAttributeNS:
4865 CheckArgs(4,4,2,"uri attrName");
4866 if (node->nodeType != ELEMENT_NODE) {
4867 SetResult("NOT_AN_ELEMENT : there are no attributes");
4868 return TCL_ERROR;
4869 }
4870 uri = Tcl_GetString(objv[2]);
4871 localName = Tcl_GetString(objv[3]);
4872 result = domRemoveAttributeNS(node, uri, localName);
4873 if (result < 0) {
4874 SetResult("can't remove attribute with localName '");
4875 AppendResult(localName);
4876 AppendResult("'");
4877 return TCL_ERROR;
4878 }
4879 return tcldom_setInterpAndReturnVar(interp, node, 0, NULL);
4880
4881 case m_nextSibling:
4882 CheckArgs(2,3,2,"?nodeObjVar?");
4883 return tcldom_setInterpAndReturnVar(interp, node->nextSibling,
4884 (objc == 3),
4885 (objc == 3) ? objv[2] : NULL);
4886 case m_previousSibling:
4887 CheckArgs(2,3,2,"?nodeObjVar?");
4888 return tcldom_setInterpAndReturnVar(interp, node->previousSibling,
4889 (objc == 3),
4890 (objc == 3) ? objv[2] : NULL);
4891 case m_firstChild:
4892 CheckArgs(2,3,2,"?nodeObjVar?");
4893 if (node->nodeType == ELEMENT_NODE) {
4894 return tcldom_setInterpAndReturnVar(interp, node->firstChild,
4895 (objc == 3),
4896 (objc == 3) ? objv[2] : NULL);
4897 }
4898 return tcldom_setInterpAndReturnVar(interp, NULL, (objc == 3),
4899 (objc == 3) ? objv[2] : NULL);
4900 case m_lastChild:
4901 CheckArgs(2,3,2,"?nodeObjVar?");
4902 if (node->nodeType == ELEMENT_NODE) {
4903 return tcldom_setInterpAndReturnVar(interp, node->lastChild,
4904 (objc == 3),
4905 (objc == 3) ? objv[2] : NULL);
4906 }
4907 return tcldom_setInterpAndReturnVar(interp, NULL, (objc == 3),
4908 (objc == 3) ? objv[2] : NULL);
4909 case m_parentNode:
4910 CheckArgs(2,3,2,"?nodeObjVar?");
4911 return tcldom_setInterpAndReturnVar(interp, node->parentNode, (objc == 3),
4912 (objc == 3) ? objv[2] : NULL);
4913 case m_appendFromList:
4914 CheckArgs(3,3,2,"list");
4915 return tcldom_appendFromTclList(interp, node, objv[2]);
4916
4917 case m_appendFromScript:
4918 CheckArgs(3,3,2,"script");
4919 if (nodecmd_appendFromScript(interp, node, objv[2]) != TCL_OK) {
4920 return TCL_ERROR;
4921 }
4922 return tcldom_setInterpAndReturnVar(interp, node, 0, NULL);
4923
4924 case m_insertBeforeFromScript:
4925 CheckArgs(4,4,2, "script refChild");
4926 if (objv[3]->typePtr == &tdomNodeType) {
4927 refChild = objv[3]->internalRep.otherValuePtr;
4928 } else {
4929 nodeName = Tcl_GetString (objv[3]);
4930 if (nodeName[0] == '\0') {
4931 refChild = NULL;
4932 } else {
4933 refChild = tcldom_getNodeFromObj (interp, objv[3]);
4934 if (refChild == NULL) {
4935 return TCL_ERROR;
4936 }
4937 }
4938 }
4939 if (nodecmd_insertBeforeFromScript(interp, node, objv[2], refChild)
4940 != TCL_OK) {
4941 return TCL_ERROR;
4942 }
4943 return tcldom_setInterpAndReturnVar (interp, node, 0, NULL);
4944
4945 case m_appendXML:
4946 CheckArgs(3,3,2,"xmlString");
4947 return tcldom_appendXML(interp, node, objv[2]);
4948
4949 case m_appendChild:
4950 CheckArgs(3,3,2,"nodeToAppend");
4951 child = tcldom_getNodeFromObj(interp, objv[2]);
4952 if (child == NULL) {
4953 return TCL_ERROR;
4954 }
4955 exception = domAppendChild (node, child);
4956 if (exception != OK) {
4957 SetResult(domException2String(exception));
4958 return TCL_ERROR;
4959 }
4960 return tcldom_setInterpAndReturnVar(interp, child, 0, NULL);
4961
4962 case m_cloneNode:
4963 CheckArgs(2,3,2,"?-deep?");
4964 if (objc == 3) {
4965 if (!strcmp(Tcl_GetString(objv[2]), "-deep")) {
4966 return tcldom_setInterpAndReturnVar(interp, domCloneNode(node, 1),
4967 0, NULL);
4968 }
4969 SetResult("unknown option! Options: ?-deep? ");
4970 return TCL_ERROR;
4971 }
4972 return tcldom_setInterpAndReturnVar(interp, domCloneNode(node, 0), 0, NULL);
4973
4974 case m_removeChild:
4975 CheckArgs(3,3,2,"childToRemove");
4976 child = tcldom_getNodeFromObj(interp, objv[2]);
4977 if (child == NULL) {
4978 return TCL_ERROR;
4979 }
4980 exception = domRemoveChild (node, child);
4981 if (exception != OK) {
4982 SetResult (domException2String (exception));
4983 return TCL_ERROR;
4984 }
4985 return tcldom_setInterpAndReturnVar(interp, child, 0, NULL);
4986
4987 case m_insertBefore:
4988 CheckArgs(4,4,2,"childToInsert refChild");
4989 child = tcldom_getNodeFromObj(interp, objv[2]);
4990 if (child == NULL) {
4991 return TCL_ERROR;
4992 }
4993
4994 if (objv[3]->typePtr == &tdomNodeType) {
4995 refChild = objv[3]->internalRep.otherValuePtr;
4996 } else {
4997 nodeName = Tcl_GetString (objv[3]);
4998 if (nodeName[0] == '\0') {
4999 refChild = NULL;
5000 } else {
5001 refChild = tcldom_getNodeFromObj (interp, objv[3]);
5002 if (refChild == NULL) {
5003 return TCL_ERROR;
5004 }
5005 }
5006 }
5007 exception = domInsertBefore(node, child, refChild);
5008 if (exception != OK) {
5009 SetResult(domException2String(exception));
5010 return TCL_ERROR;
5011 }
5012 return tcldom_setInterpAndReturnVar(interp, child, 0, NULL);
5013
5014 case m_replaceChild:
5015 CheckArgs(4,4,2,"new old");
5016 child = tcldom_getNodeFromObj(interp, objv[2]);
5017 if (child == NULL) {
5018 return TCL_ERROR;
5019 }
5020 oldChild = tcldom_getNodeFromObj(interp, objv[3]);
5021 if (oldChild == NULL) {
5022 return TCL_ERROR;
5023 }
5024 exception = domReplaceChild(node, child, oldChild);
5025 if (exception != OK) {
5026 SetResult(domException2String(exception));
5027 return TCL_ERROR;
5028 }
5029 return tcldom_setInterpAndReturnVar(interp, oldChild, 0, NULL);
5030
5031 case m_hasChildNodes:
5032 CheckArgs(2,2,2,"");
5033 if (node->nodeType == ELEMENT_NODE) {
5034 SetIntResult(node->firstChild ? 1 : 0);
5035 } else {
5036 SetIntResult(0);
5037 }
5038 break;
5039
5040 case m_childNodes:
5041 CheckArgs(2,2,2,"");
5042 resultPtr = Tcl_GetObjResult(interp);
5043 if (node->nodeType == ELEMENT_NODE) {
5044 child = node->firstChild;
5045 while (child != NULL) {
5046 namePtr = tcldom_returnNodeObj(interp, child);
5047 result = Tcl_ListObjAppendElement(interp, resultPtr,
5048 namePtr);
5049 if (result != TCL_OK) {
5050 Tcl_DecrRefCount(namePtr);
5051 return result;
5052 }
5053 child = child->nextSibling;
5054 }
5055 }
5056 break;
5057
5058 case m_getElementsByTagName:
5059 CheckArgs(3,3,2,"elementName");
5060 if (node->nodeType != ELEMENT_NODE) {
5061 SetResult("Node must be an element node.");
5062 return TCL_ERROR;
5063 }
5064 Tcl_ResetResult(interp);
5065 return tcldom_getElementsByTagName(interp, Tcl_GetString(objv[2]),
5066 node->firstChild, -1, NULL);
5067
5068 case m_getElementsByTagNameNS:
5069 CheckArgs(4,4,2,"uri localname");
5070 if (node->nodeType != ELEMENT_NODE) {
5071 SetResult("Node must be an element node.");
5072 return TCL_ERROR;
5073 }
5074 uri = Tcl_GetString(objv[2]);
5075 str = Tcl_GetString(objv[3]);
5076 nsIndex = -1;
5077 if (uri[0] == '*' && uri[1] == '\0') {
5078 nsIndex = -3;
5079 } else if (uri[0] == '\0') {
5080 /* all elements not in a namespace */
5081 nsIndex = -4;
5082 } else {
5083 for (i = 0; i <= node->ownerDocument->nsptr; i++) {
5084 if (strcmp (node->ownerDocument->namespaces[i]->uri,
5085 uri)==0) {
5086 if (nsIndex != -1) {
5087 /* OK, this is one of the 'degenerated' (though
5088 legal) documents, which bind the same URI
5089 to different prefixes. */
5090 nsIndex = -2;
5091 break;
5092 }
5093 nsIndex = node->ownerDocument->namespaces[i]->index;
5094 }
5095 }
5096 }
5097 if (nsIndex == -1) {
5098 /* There isn't such a namespace declared in this document.
5099 Since getElementsByTagNameNS doesn't raise an exception
5100 short cut: return empty result */
5101 Tcl_ResetResult(interp);
5102 return TCL_OK;
5103 }
5104 return tcldom_getElementsByTagName(interp, str, node->firstChild,
5105 nsIndex, uri);
5106
5107 case m_getElementById:
5108 CheckArgs(3,3,2,"id");
5109 if (node->ownerDocument->ids) {
5110 str = Tcl_GetString(objv[2]);
5111 h = Tcl_FindHashEntry(node->ownerDocument->ids, str);
5112 if (h) {
5113 domNode *node = Tcl_GetHashValue(h);
5114 return tcldom_setInterpAndReturnVar(interp, node, 0, NULL);
5115 }
5116 }
5117 SetResult("");
5118 return TCL_OK;
5119
5120 case m_nodeName:
5121 CheckArgs(2,2,2,"");
5122 if (node->nodeType == ELEMENT_NODE) {
5123 SetResult((char*)node->nodeName);
5124 } else
5125 if (node->nodeType == TEXT_NODE) {
5126 SetResult("#text");
5127 } else
5128 if (node->nodeType == PROCESSING_INSTRUCTION_NODE) {
5129 domProcessingInstructionNode *dpn;
5130 dpn = (domProcessingInstructionNode *)node;
5131 Tcl_SetStringObj(Tcl_GetObjResult(interp),
5132 dpn->targetValue, dpn->targetLength);
5133 } else
5134 if (node->nodeType == COMMENT_NODE) {
5135 SetResult("#comment");
5136 } else
5137 if (node->nodeType == CDATA_SECTION_NODE) {
5138 SetResult("#cdata-section");
5139 } else {
5140 SetResult("");
5141 }
5142 break;
5143
5144 case m_nodeValue:
5145 CheckArgs(2,3,2,"?newValue?");
5146 if (node->nodeType == ELEMENT_NODE) {
5147 Tcl_SetStringObj(Tcl_GetObjResult(interp), "", 0);
5148 } else if (node->nodeType == PROCESSING_INSTRUCTION_NODE) {
5149 domProcessingInstructionNode *dpn;
5150 dpn = (domProcessingInstructionNode *)node;
5151 Tcl_SetStringObj(Tcl_GetObjResult(interp),
5152 dpn->dataValue, dpn->dataLength);
5153 } else {
5154 domTextNode *dtn;
5155 dtn = (domTextNode*)node;
5156 Tcl_SetStringObj(Tcl_GetObjResult(interp),
5157 dtn->nodeValue, dtn->valueLength);
5158 }
5159 if (objc == 3) {
5160 str = Tcl_GetStringFromObj(objv[2], &length);
5161 switch (node->nodeType) {
5162 case TEXT_NODE: CheckText (interp, str, "text"); break;
5163 case COMMENT_NODE: CheckComment (interp, str); break;
5164 case CDATA_SECTION_NODE: CheckCDATA (interp, str); break;
5165 default: break; /* Do nothing */
5166 }
5167 exception = domSetNodeValue(node, str, length);
5168 if (exception != OK) {
5169 SetResult(domException2String(exception));
5170 return TCL_ERROR;
5171 }
5172 }
5173 break;
5174
5175 case m_nodeType:
5176 CheckArgs(2,2,2,"");
5177 switch (node->nodeType) {
5178 case ELEMENT_NODE:
5179 SetResult("ELEMENT_NODE");
5180 break;
5181 case ATTRIBUTE_NODE:
5182 SetResult("ATTRIBUTE_NODE");
5183 break;
5184 case TEXT_NODE:
5185 SetResult("TEXT_NODE");
5186 break;
5187 case CDATA_SECTION_NODE:
5188 SetResult("CDATA_SECTION_NODE");
5189 break;
5190 case COMMENT_NODE:
5191 SetResult("COMMENT_NODE");
5192 break;
5193 case PROCESSING_INSTRUCTION_NODE:
5194 SetResult("PROCESSING_INSTRUCTION_NODE");
5195 break;
5196 default:
5197 SetResult("unknown nodeType!");
5198 return TCL_ERROR;
5199 }
5200 break;
5201
5202 case m_prefix:
5203 CheckArgs(2,2,2,"");
5204 nsStr = domNamespacePrefix(node);
5205 if (nsStr) {
5206 SetResult(nsStr);
5207 } else {
5208 SetResult("");
5209 }
5210 return TCL_OK;
5211
5212 case m_namespaceURI:
5213 CheckArgs(2,2,2,"");
5214 nsStr = domNamespaceURI(node);
5215 if (nsStr) {
5216 SetResult(nsStr);
5217 } else {
5218 SetResult("");
5219 }
5220 return TCL_OK;
5221
5222 case m_localName:
5223 CheckArgs(2,2,2,"");
5224 if (node->nodeType == ELEMENT_NODE) {
5225 if (node->namespace != 0) {
5226 SetResult(domGetLocalName((char*)node->nodeName));
5227 break;
5228 }
5229 }
5230 SetResult("");
5231 break;
5232
5233 case m_ownerDocument:
5234 CheckArgs(2,3,2,"?docObjVar?");
5235 return tcldom_returnDocumentObj(interp, node->ownerDocument,
5236 (objc == 3),
5237 (objc == 3) ? objv[2] : NULL, 0,
5238 1);
5239 case m_target:
5240 CheckArgs(2,2,2,"");
5241 if (node->nodeType != PROCESSING_INSTRUCTION_NODE) {
5242 SetResult("not a PROCESSING_INSTRUCTION_NODE!");
5243 return TCL_ERROR;
5244 } else {
5245 domProcessingInstructionNode *dpn;
5246 dpn = (domProcessingInstructionNode *)node;
5247 Tcl_SetStringObj(Tcl_GetObjResult(interp),
5248 dpn->targetValue, dpn->targetLength);
5249 }
5250 break;
5251
5252 case m_delete:
5253 CheckArgs(2,2,2,"");
5254 domDeleteNode(node, tcldom_deleteNode, interp);
5255 if (fromToken && (objv[0]->typePtr == &tdomNodeType)) {
5256 if (objv[0]->bytes) ckfree (objv[0]->bytes);
5257 objv[0]->typePtr = NULL;
5258 objv[0]->bytes = ckalloc((unsigned char) 1);
5259 objv[0]->bytes[0] = '\0';
5260 objv[0]->length = 0;
5261 }
5262 break;
5263
5264 case m_data:
5265 CheckArgs(2,2,2,"");
5266 if (node->nodeType == PROCESSING_INSTRUCTION_NODE) {
5267 domProcessingInstructionNode *dpn;
5268 dpn = (domProcessingInstructionNode*)node;
5269 Tcl_SetStringObj(Tcl_GetObjResult(interp),
5270 dpn->dataValue, dpn->dataLength);
5271 } else
5272 if ( node->nodeType == TEXT_NODE
5273 || node->nodeType == CDATA_SECTION_NODE
5274 || node->nodeType == COMMENT_NODE) {
5275 domTextNode *dtn;
5276 dtn = (domTextNode*)node;
5277 Tcl_SetStringObj(Tcl_GetObjResult(interp),
5278 dtn->nodeValue, dtn->valueLength);
5279 } else {
5280 SetResult("not a "
5281 "TEXT_NODE / "
5282 "CDATA_SECTION_NODE / "
5283 "COMMENT_NODE / "
5284 "PROCESSING_INSTRUCTION_NODE !");
5285 return TCL_ERROR;
5286 }
5287 break;
5288
5289 case m_getLine:
5290 CheckArgs(2,2,2,"");
5291 if (domGetLineColumn(node, &line, &column) < 0) {
5292 SetResult("no line/column information available!");
5293 return TCL_ERROR;
5294 }
5295 SetIntResult(line);
5296 break;
5297
5298 case m_getColumn:
5299 CheckArgs(2,2,2,"");
5300 if (domGetLineColumn (node, &line, &column) < 0) {
5301 SetResult("no line/column information available!");
5302 return TCL_ERROR;
5303 }
5304 SetIntResult(column);
5305 break;
5306
5307 case m_getBaseURI:
5308 CheckArgs(2,2,2,"");
5309 /* fall thru */
5310
5311 case m_baseURI:
5312 CheckArgs(2,3,2,"?URI?");
5313 if (objc == 3) {
5314 h = Tcl_CreateHashEntry (node->ownerDocument->baseURIs,
5315 (char *) node, &hnew);
5316 if (!hnew) {
5317 FREE (Tcl_GetHashValue (h));
5318 }
5319 Tcl_SetHashValue (h, tdomstrdup (Tcl_GetString (objv[2])));
5320 node->nodeFlags |= HAS_BASEURI;
5321 SetResult (Tcl_GetString (objv[2]));
5322 } else {
5323 nsStr = findBaseURI(node);
5324 if (!nsStr) {
5325 SetResult("");
5326 } else {
5327 SetResult(nsStr);
5328 }
5329 }
5330 break;
5331
5332 case m_disableOutputEscaping:
5333 CheckArgs(2,3,2,"?boolean?");
5334 if (node->nodeType != TEXT_NODE) {
5335 SetResult("not a TEXT_NODE!");
5336 return TCL_ERROR;
5337 }
5338 SetIntResult(
5339 (((node->nodeFlags & DISABLE_OUTPUT_ESCAPING) == 0) ? 0 : 1));
5340 if (objc == 3) {
5341 if (Tcl_GetBooleanFromObj(interp, objv[2], &bool) != TCL_OK) {
5342 return TCL_ERROR;
5343 }
5344 if (bool) {
5345 node->nodeFlags |= DISABLE_OUTPUT_ESCAPING;
5346 } else {
5347 node->nodeFlags &= (~DISABLE_OUTPUT_ESCAPING);
5348 }
5349 }
5350 break;
5351
5352 case m_precedes:
5353 CheckArgs(3,3,2, "node");
5354 refNode = tcldom_getNodeFromObj(interp, objv[2]);
5355 if (refNode == NULL) {
5356 return TCL_ERROR;
5357 }
5358 if (node->ownerDocument != refNode->ownerDocument) {
5359 SetResult("Cannot compare the relative order of nodes "
5360 "out of different documents.");
5361 return TCL_ERROR;
5362 }
5363 if (((node->parentNode == NULL)
5364 && (node != node->ownerDocument->documentElement)
5365 && (node != node->ownerDocument->rootNode))
5366 ||
5367 ((refNode->parentNode == NULL)
5368 && (refNode != refNode->ownerDocument->documentElement)
5369 && (refNode != refNode->ownerDocument->rootNode))) {
5370 SetResult("Cannot compare the relative order of a node "
5371 "with a node out of the fragment list.");
5372 return TCL_ERROR;
5373 }
5374 SetBooleanResult (domPrecedes (node, refNode));
5375 break;
5376
5377 case m_asText:
5378 CheckArgs (2,2,2, "");
5379 str = xpathGetStringValue(node, &length);
5380 Tcl_SetStringObj(Tcl_GetObjResult(interp), str, length);
5381 FREE (str);
5382 return TCL_OK;
5383
5384 case m_normalize:
5385 CheckArgs (2,3,2, "?-forXPath?");
5386 bool = 0;
5387 if (objc == 3) {
5388 if (strcmp (Tcl_GetString(objv[2]), "-forXPath") == 0) {
5389 bool = 1;
5390 } else {
5391 SetResult("unknown option! Options: ?-forXPath?");
5392 return TCL_ERROR;
5393 }
5394 }
5395 domNormalize (node, bool, tcldom_deleteNode, interp);
5396 return TCL_OK;
5397
5398 case m_jsonType:
5399 CheckArgs (2,3,2, "?jsonType?");
5400 if (node->nodeType != ELEMENT_NODE
5401 && node->nodeType != TEXT_NODE) {
5402 SetResult("Only element and text nodes may have a JSON type.");
5403 return TCL_ERROR;
5404 }
5405 if (objc == 3) {
5406 if (Tcl_GetIndexFromObj (interp, objv[2], jsonTypes,
5407 "jsonType", 0, &jsonType)
5408 != TCL_OK) {
5409 return TCL_ERROR;
5410 }
5411 if (node->nodeType == ELEMENT_NODE) {
5412 if (jsonType > 2) {
5413 SetResult("For an element node the jsonType argument "
5414 "must be one out of this list: ARRAY OBJECT NONE.");
5415 return TCL_ERROR;
5416 }
5417 } else {
5418 /* Text nodes */
5419 if (jsonType < 3 && jsonType > 0) {
5420 SetResult("For a text node the jsonType argument must be "
5421 "one out of this list: TRUE FALSE NULL NUMBER "
5422 "STRING NONE");
5423 return TCL_ERROR;
5424 }
5425 }
5426 node->info = jsonType;
5427 SetIntResult(jsonType);
5428 return TCL_OK;
5429 }
5430 if (node->info < 0 || node->info > 7) {
5431 SetResult(jsonTypes[0]);
5432 } else {
5433 SetResult(jsonTypes[node->info]);
5434 }
5435 return TCL_OK;
5436
5437 TDomThreaded(
5438 case m_writelock:
5439 CheckArgs(3,3,2,"script");
5440 return tcldom_EvalLocked(interp, (Tcl_Obj**)objv,
5441 node->ownerDocument, LOCK_WRITE);
5442 case m_readlock:
5443 CheckArgs(3,3,2,"script");
5444 return tcldom_EvalLocked(interp, (Tcl_Obj**)objv,
5445 node->ownerDocument, LOCK_READ);
5446 )
5447 }
5448 return TCL_OK;}
5449
5450
5451
5452 /*----------------------------------------------------------------------------
5453 | tcldom_DocObjCmd
5454 |
5455 \---------------------------------------------------------------------------*/
tcldom_DocObjCmd(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * const objv[])5456 int tcldom_DocObjCmd (
5457 ClientData clientData,
5458 Tcl_Interp *interp,
5459 int objc,
5460 Tcl_Obj *const objv[]
5461 )
5462 {
5463 GetTcldomTSD()
5464
5465 domDeleteInfo * dinfo;
5466 domDocument * doc;
5467 char * method, *tag, *data, *target, *uri, tmp[100];
5468 char * str, *docName, *errMsg;
5469 int methodIndex, result, data_length, target_length, i;
5470 int nsIndex, forXPath, bool, setDocumentElement = 0;
5471 int restoreDomCreateCmdMode = 0;
5472 domNode * n;
5473 Tcl_CmdInfo cmdInfo;
5474 Tcl_Obj * mobjv[MAX_REWRITE_ARGS];
5475
5476 static const char *docMethods[] = {
5477 "documentElement", "getElementsByTagName", "delete",
5478 "createElement", "createCDATASection", "createTextNode",
5479 "createComment", "createProcessingInstruction",
5480 "createElementNS", "getDefaultOutputMethod", "asXML",
5481 "asHTML", "getElementsByTagNameNS", "xslt",
5482 "publicId", "systemId", "internalSubset",
5483 "toXSLTcmd", "asText", "normalize",
5484 "indent", "omit-xml-declaration", "encoding",
5485 "standalone", "mediaType", "nodeType",
5486 "cdataSectionElements",
5487 "selectNodesNamespaces",
5488 "renameNode", "deleteXPathCache",
5489 /* The following methods will be dispatched to tcldom_NodeObjCmd */
5490 "getElementById", "firstChild", "lastChild",
5491 "appendChild", "removeChild", "hasChildNodes",
5492 "childNodes", "ownerDocument", "insertBefore",
5493 "replaceChild", "appendFromList", "appendXML",
5494 "selectNodes", "baseURI", "appendFromScript",
5495 "insertBeforeFromScript", "asJSON",
5496 "jsonType",
5497 #ifdef TCL_THREADS
5498 "readlock", "writelock", "renumber",
5499 #endif
5500 NULL
5501 };
5502 enum docMethod {
5503 m_documentElement, m_getElementsByTagName, m_delete,
5504 m_createElement, m_createCDATASection, m_createTextNode,
5505 m_createComment, m_createProcessingInstruction,
5506 m_createElementNS, m_getdefaultoutputmethod, m_asXML,
5507 m_asHTML, m_getElementsByTagNameNS, m_xslt,
5508 m_publicId, m_systemId, m_internalSubset,
5509 m_toXSLTcmd, m_asText, m_normalize,
5510 m_indent, m_omitXMLDeclaration, m_encoding,
5511 m_standalone, m_mediaType, m_nodeType,
5512 m_cdataSectionElements,
5513 m_selectNodesNamespaces,
5514 m_renameNode, m_deleteXPathCache,
5515 /* The following methods will be dispatched to tcldom_NodeObjCmd */
5516 m_getElementById, m_firstChild, m_lastChild,
5517 m_appendChild, m_removeChild, m_hasChildNodes,
5518 m_childNodes, m_ownerDocument, m_insertBefore,
5519 m_replaceChild, m_appendFromList, m_appendXML,
5520 m_selectNodes, m_baseURI, m_appendFromScript,
5521 m_insertBeforeFromScript, m_asJSON,
5522 m_jsonType
5523 #ifdef TCL_THREADS
5524 ,m_readlock, m_writelock, m_renumber
5525 #endif
5526 };
5527
5528 dinfo = (domDeleteInfo*)clientData;
5529 if (TSD(domCreateCmdMode) == DOM_CREATECMDMODE_AUTO) {
5530 TSD(dontCreateObjCommands) = 0;
5531 }
5532 if (dinfo == NULL) {
5533 if (objc < 3) {
5534 SetResult(doc_usage);
5535 return TCL_ERROR;
5536 }
5537 if (TSD(domCreateCmdMode) == DOM_CREATECMDMODE_AUTO) {
5538 TSD(dontCreateObjCommands) = 1;
5539 }
5540 docName = Tcl_GetString(objv[1]);
5541 doc = tcldom_getDocumentFromName(interp, docName, &errMsg);
5542 if (doc == NULL) {
5543 SetResult(errMsg);
5544 return TCL_ERROR;
5545 }
5546 objc--;
5547 objv++;
5548 } else {
5549 doc = dinfo->document;
5550 }
5551
5552 if (objc < 2) {
5553 SetResult(doc_usage);
5554 return TCL_ERROR;
5555 }
5556 method = Tcl_GetString(objv[1]);
5557 if (Tcl_GetIndexFromObj(NULL, objv[1], docMethods, "method", 0,
5558 &methodIndex) != TCL_OK)
5559 {
5560 /*--------------------------------------------------------
5561 | try to find method implemented as normal Tcl proc
5562 \-------------------------------------------------------*/
5563 sprintf(tmp, "::dom::domDoc::%s", method);
5564 DBG(fprintf(stderr, "testing %s\n", tmp));
5565 result = Tcl_GetCommandInfo(interp, tmp, &cmdInfo);
5566 if (!result) {
5567 SetResult(doc_usage);
5568 return TCL_ERROR;
5569 }
5570 if (!cmdInfo.isNativeObjectProc) {
5571 SetResult( "can't access Tcl level method!");
5572 return TCL_ERROR;
5573 }
5574 if (objc >= MAX_REWRITE_ARGS) {
5575 SetResult("too many args to call Tcl level method!");
5576 return TCL_ERROR;
5577 }
5578 mobjv[0] = objv[1];
5579 mobjv[1] = objv[0];
5580 for (i = 2; i < objc; i++) {
5581 mobjv[i] = objv[i];
5582 }
5583 return cmdInfo.objProc(cmdInfo.objClientData, interp, objc, mobjv);
5584 }
5585
5586 CheckArgs (2,10,1,doc_usage);
5587 Tcl_ResetResult (interp);
5588
5589 /*----------------------------------------------------------------------
5590 | dispatch the doc object method
5591 |
5592 \---------------------------------------------------------------------*/
5593
5594 switch ((enum docMethod) methodIndex ) {
5595
5596 case m_documentElement:
5597 CheckArgs(2,3,2,"");
5598 return tcldom_setInterpAndReturnVar(interp, doc->documentElement,
5599 (objc == 3),
5600 (objc == 3) ? objv[2] : NULL);
5601 case m_getElementsByTagName:
5602 CheckArgs(3,3,2,"elementName");
5603 return tcldom_getElementsByTagName(interp, Tcl_GetString(objv[2]),
5604 doc->documentElement, -1, NULL);
5605 case m_getElementsByTagNameNS:
5606 CheckArgs(4,4,2,"uri localname");
5607 uri = Tcl_GetString(objv[2]);
5608 str = Tcl_GetString(objv[3]);
5609 nsIndex = -1;
5610 if (uri[0] == '*' && uri[1] == '\0') {
5611 nsIndex = -3;
5612 } else if (uri[0] == '\0') {
5613 /* all elements not in a namespace i.e. */
5614 nsIndex = -4;
5615 } else {
5616 for (i = 0; i <= doc->nsptr; i++) {
5617 if (strcmp(doc->namespaces[i]->uri, uri)==0) {
5618 if (nsIndex != -1) {
5619 /* OK, this is one of the 'degenerated' (though
5620 legal) documents, which bind the same URI
5621 to different prefixes. */
5622 nsIndex = -2;
5623 break;
5624 }
5625 nsIndex = doc->namespaces[i]->index;
5626 }
5627 }
5628 }
5629 if (nsIndex == -1) {
5630 /* There isn't such a namespace declared in this document.
5631 Since getElementsByTagNameNS doesn't raise an exception
5632 short cut: return empty result */
5633 return TCL_OK;
5634 }
5635 return tcldom_getElementsByTagName(interp, str,
5636 doc->documentElement, nsIndex,
5637 uri);
5638 case m_createElement:
5639 CheckArgs(3,4,2,"elementName ?newObjVar?");
5640 tag = Tcl_GetString(objv[2]);
5641 CheckName (interp, tag, "tag", 0);
5642 n = domNewElementNode(doc, tag);
5643 return tcldom_setInterpAndReturnVar(interp, n, (objc == 4),
5644 (objc == 4) ? objv[3] : NULL);
5645
5646 case m_createElementNS:
5647 CheckArgs(4,5,2,"elementName uri ?newObjVar?");
5648 uri = Tcl_GetString(objv[2]);
5649 tag = Tcl_GetString(objv[3]);
5650 CheckName (interp, tag, "full qualified tag", 1);
5651 n = domNewElementNodeNS(doc, tag, uri);
5652 if (n == NULL) {
5653 SetResult("Missing URI in Namespace declaration");
5654 return TCL_ERROR;
5655 }
5656 return tcldom_setInterpAndReturnVar(interp, n, (objc == 5),
5657 (objc == 5) ? objv[4] : NULL);
5658
5659 case m_createTextNode:
5660 CheckArgs(3,4,2,"data ?newObjVar?");
5661 data = Tcl_GetStringFromObj(objv[2], &data_length);
5662 CheckText (interp, data, "text");
5663 n = (domNode*)domNewTextNode(doc, data, data_length, TEXT_NODE);
5664 return tcldom_setInterpAndReturnVar(interp, n, (objc == 4),
5665 (objc == 4) ? objv[3] : NULL);
5666
5667 case m_createCDATASection:
5668 CheckArgs(3,4,2,"data ?newObjVar?");
5669 data = Tcl_GetStringFromObj(objv[2], &data_length);
5670 CheckCDATA (interp, data);
5671 n = (domNode*)domNewTextNode(doc, data, data_length,
5672 CDATA_SECTION_NODE);
5673 return tcldom_setInterpAndReturnVar(interp, n, (objc == 4),
5674 (objc == 4) ? objv[3] : NULL);
5675
5676 case m_createComment:
5677 CheckArgs(3,4,2,"data ?newObjVar?");
5678 data = Tcl_GetStringFromObj(objv[2], &data_length);
5679 CheckComment(interp, data);
5680 n = (domNode*)domNewTextNode(doc, data, data_length, COMMENT_NODE);
5681 return tcldom_setInterpAndReturnVar(interp, n, (objc == 4),
5682 (objc == 4) ? objv[3] : NULL);
5683
5684 case m_createProcessingInstruction:
5685 CheckArgs(4,5,2,"target data ?newObjVar?");
5686 target = Tcl_GetStringFromObj(objv[2], &target_length);
5687 CheckPIName (interp, target);
5688 data = Tcl_GetStringFromObj(objv[3], &data_length);
5689 CheckPIValue (interp, data);
5690 n = (domNode*)domNewProcessingInstructionNode(doc, target,
5691 target_length, data,
5692 data_length);
5693 return tcldom_setInterpAndReturnVar(interp, n, (objc == 5),
5694 (objc == 5) ? objv[4] : NULL);
5695
5696 case m_delete:
5697 CheckArgs(2,2,2,"");
5698 if (clientData != NULL || doc->nodeFlags & DOCUMENT_CMD) {
5699 Tcl_DeleteCommand(interp, Tcl_GetString (objv[0]));
5700 } else {
5701 tcldom_deleteDoc(interp, doc);
5702 }
5703 SetResult("");
5704 return TCL_OK;
5705
5706 case m_getdefaultoutputmethod:
5707 CheckArgs(2,2,2,"");
5708 if (doc->doctype && doc->doctype->method) {
5709 SetResult (doc->doctype->method);
5710 } else {
5711 SetResult("xml");
5712 }
5713 return TCL_OK;
5714
5715 case m_asXML:
5716 if (serializeAsXML((domNode*)doc, interp, objc, objv) != TCL_OK) {
5717 return TCL_ERROR;
5718 }
5719 return TCL_OK;
5720
5721 case m_asHTML:
5722 if (serializeAsHTML((domNode*)doc, interp, objc, objv)
5723 != TCL_OK) {
5724 return TCL_ERROR;
5725 }
5726 return TCL_OK;
5727
5728 case m_xslt:
5729 CheckArgs(3,9,2, "?-parameters parameterList? "
5730 "?-ignoreUndeclaredParameters? "
5731 "?-xsltmessagecmd cmd? <xsltDocNode> ?objVar?");
5732 objv += 2; objc -= 2;
5733 return applyXSLT((domNode *) doc, interp, NULL, objc, objv);
5734
5735
5736 case m_toXSLTcmd:
5737 CheckArgs(2,3,2, "?objVar?");
5738 return convertToXSLTCmd(doc, interp, (objc == 3),
5739 (objc == 3) ? objv[2] : NULL);
5740
5741 case m_publicId:
5742 CheckArgs(2,3,2, "?publicID?");
5743 if (doc->doctype && doc->doctype->publicId) {
5744 SetResult(doc->doctype->publicId);
5745 } else {
5746 SetResult("");
5747 }
5748 if (objc == 3) {
5749 if (!doc->doctype) {
5750 doc->doctype = (domDocInfo *)MALLOC(sizeof(domDocInfo));
5751 memset(doc->doctype, 0,(sizeof(domDocInfo)));
5752 } else if (doc->doctype->publicId) {
5753 FREE(doc->doctype->publicId);
5754 }
5755 doc->doctype->publicId = tdomstrdup(Tcl_GetString(objv[2]));
5756 }
5757 return TCL_OK;
5758
5759 case m_systemId:
5760 CheckArgs(2,3,2, "?systemID?");
5761 if (doc->doctype && doc->doctype->systemId) {
5762 SetResult(doc->doctype->systemId);
5763 } else {
5764 SetResult("");
5765 }
5766 if (objc == 3) {
5767 if (!doc->doctype) {
5768 doc->doctype = (domDocInfo *)MALLOC(sizeof(domDocInfo));
5769 memset(doc->doctype, 0,(sizeof(domDocInfo)));
5770 } else if (doc->doctype->systemId) {
5771 FREE(doc->doctype->systemId);
5772 }
5773 doc->doctype->systemId =
5774 tdomstrdup(Tcl_GetString(objv[2]));
5775 }
5776 return TCL_OK;
5777
5778 case m_internalSubset:
5779 CheckArgs(2,3,2, "?internalSubset?");
5780 if (doc->doctype && doc->doctype->internalSubset) {
5781 SetResult(doc->doctype->internalSubset);
5782 } else {
5783 SetResult("");
5784 }
5785 if (objc == 3) {
5786 if (!doc->doctype) {
5787 doc->doctype = (domDocInfo *)MALLOC(sizeof(domDocInfo));
5788 memset(doc->doctype, 0,(sizeof(domDocInfo)));
5789 } else if (doc->doctype->systemId) {
5790 FREE(doc->doctype->systemId);
5791 }
5792 doc->doctype->internalSubset =
5793 tdomstrdup(Tcl_GetString(objv[2]));
5794 }
5795 return TCL_OK;
5796
5797 case m_indent:
5798 CheckArgs(2,3,2, "?boolean?");
5799 if (doc->nodeFlags & OUTPUT_DEFAULT_INDENT) {
5800 SetBooleanResult (1);
5801 } else {
5802 SetBooleanResult(0);
5803 }
5804 if (objc == 3) {
5805 if (Tcl_GetBooleanFromObj (interp, objv[2], &bool) != TCL_OK) {
5806 return TCL_ERROR;
5807 }
5808 if (bool) {
5809 doc->nodeFlags |= OUTPUT_DEFAULT_INDENT;
5810 } else {
5811 doc->nodeFlags &= ~OUTPUT_DEFAULT_INDENT;
5812 }
5813 }
5814 return TCL_OK;
5815
5816 case m_omitXMLDeclaration:
5817 CheckArgs(2,3,2, "?boolean?");
5818 if (doc->doctype) {
5819 SetBooleanResult (doc->doctype->omitXMLDeclaration);
5820 } else {
5821 SetBooleanResult (1);
5822 }
5823 if (objc == 3) {
5824 if (!doc->doctype) {
5825 doc->doctype = (domDocInfo *)MALLOC(sizeof(domDocInfo));
5826 memset(doc->doctype, 0,(sizeof(domDocInfo)));
5827 }
5828 if (Tcl_GetBooleanFromObj (
5829 interp, objv[2], &(doc->doctype->omitXMLDeclaration)
5830 ) != TCL_OK) {
5831 return TCL_ERROR;
5832 }
5833 }
5834 return TCL_OK;
5835
5836 case m_encoding:
5837 CheckArgs(2,3,2, "?value?");
5838 if (doc->doctype && doc->doctype->encoding) {
5839 SetResult (doc->doctype->encoding);
5840 } else {
5841 SetResult ("");
5842 }
5843 if (objc == 3) {
5844 if (!doc->doctype) {
5845 doc->doctype = (domDocInfo *)MALLOC(sizeof(domDocInfo));
5846 memset(doc->doctype, 0,(sizeof(domDocInfo)));
5847 } else {
5848 if (doc->doctype->encoding) FREE (doc->doctype->encoding);
5849 }
5850 doc->doctype->encoding = tdomstrdup (Tcl_GetString (objv[2]));
5851 }
5852 return TCL_OK;
5853
5854 case m_standalone:
5855 CheckArgs(2,3,2, "?boolean?");
5856 if (doc->doctype) {
5857 SetBooleanResult (doc->doctype->standalone);
5858 } else {
5859 SetBooleanResult (0);
5860 }
5861 if (objc == 3) {
5862 if (!doc->doctype) {
5863 doc->doctype = (domDocInfo *)MALLOC(sizeof(domDocInfo));
5864 memset(doc->doctype, 0,(sizeof(domDocInfo)));
5865 }
5866 if (Tcl_GetBooleanFromObj (
5867 interp, objv[2], &(doc->doctype->standalone)
5868 ) != TCL_OK) {
5869 return TCL_ERROR;
5870 }
5871 }
5872 return TCL_OK;
5873
5874 case m_mediaType:
5875 CheckArgs(2,3,2, "?value?");
5876 if (doc->doctype && doc->doctype->mediaType) {
5877 SetResult (doc->doctype->mediaType);
5878 } else {
5879 SetResult ("");
5880 }
5881 if (objc == 3) {
5882 if (!doc->doctype) {
5883 doc->doctype = (domDocInfo *)MALLOC(sizeof(domDocInfo));
5884 memset(doc->doctype, 0,(sizeof(domDocInfo)));
5885 } else {
5886 if (doc->doctype->mediaType) FREE(doc->doctype->mediaType);
5887 }
5888 doc->doctype->mediaType = tdomstrdup (Tcl_GetString (objv[2]));
5889 }
5890 return TCL_OK;
5891
5892 case m_asText:
5893 CheckArgs (2,2,2,"");
5894 data = xpathGetStringValue (doc->rootNode, &data_length);
5895 Tcl_SetStringObj (Tcl_GetObjResult (interp), data, data_length);
5896 FREE (data);
5897 return TCL_OK;
5898
5899 case m_normalize:
5900 CheckArgs (2,3,2, "?-forXPath?");
5901 forXPath = 0;
5902 if (objc == 3) {
5903 if (strcmp (Tcl_GetString (objv[2]), "-forXPath") == 0) {
5904 forXPath = 1;
5905 } else {
5906 SetResult("unknown option! Options: ?-forXPath?");
5907 return TCL_ERROR;
5908 }
5909 }
5910 domNormalize(doc->rootNode, forXPath, tcldom_deleteNode, interp);
5911 return TCL_OK;
5912
5913 case m_nodeType:
5914 CheckArgs (2,2,2, "");
5915 SetResult("DOCUMENT_NODE");
5916 return TCL_OK;
5917
5918 case m_cdataSectionElements:
5919 return cdataSectionElements (doc, interp, objc, objv);
5920
5921 case m_selectNodesNamespaces:
5922 return selectNodesNamespaces (doc, interp, objc, objv);
5923
5924 case m_renameNode:
5925 return renameNodes (doc, interp, objc, objv);
5926
5927 case m_deleteXPathCache:
5928 return deleteXPathCache (doc, interp, objc, objv);
5929
5930 case m_appendChild:
5931 case m_removeChild:
5932 case m_insertBefore:
5933 case m_replaceChild:
5934 case m_appendFromList:
5935 case m_appendXML:
5936 case m_appendFromScript:
5937 case m_insertBeforeFromScript:
5938 setDocumentElement = 1;
5939 /* Fall throuh */
5940 case m_firstChild:
5941 case m_lastChild:
5942 case m_hasChildNodes:
5943 case m_childNodes:
5944 case m_ownerDocument:
5945 case m_selectNodes:
5946 case m_baseURI:
5947 case m_asJSON:
5948 case m_jsonType:
5949 case m_getElementById:
5950 /* We dispatch the method call to tcldom_NodeObjCmd */
5951 if (TSD(domCreateCmdMode) == DOM_CREATECMDMODE_AUTO) {
5952 if (dinfo == NULL) {
5953 /* tcldom_DocObjCmd was called with a doc token.
5954 Since the domCreateCmdMode is 'automatic'
5955 and we call tcldom_DocObjCmd with the root node
5956 as 'clientData', we temporarily set domCreateCmdMode
5957 to 'token', to get token results from that call
5958 and later to set it back. */
5959 TSD(domCreateCmdMode) = DOM_CREATECMDMODE_TOKENS;
5960 restoreDomCreateCmdMode = 1;
5961 }
5962 }
5963 if (tcldom_NodeObjCmd (doc->rootNode, interp, objc, objv) !=
5964 TCL_OK) {
5965 if (restoreDomCreateCmdMode) {
5966 TSD(domCreateCmdMode) = DOM_CREATECMDMODE_AUTO;
5967 TSD(dontCreateObjCommands) = 0;
5968 }
5969 return TCL_ERROR;
5970 }
5971 if (setDocumentElement) {
5972 /* The method call may have altered the documentElement. */
5973 /* There may be even no node anymore */
5974 domSetDocumentElement (doc);
5975 }
5976 if (restoreDomCreateCmdMode) {
5977 TSD(domCreateCmdMode) = DOM_CREATECMDMODE_AUTO;
5978 TSD(dontCreateObjCommands) = 0;
5979 }
5980 return TCL_OK;
5981
5982 TDomThreaded(
5983 case m_writelock:
5984 CheckArgs(3,3,2,"script");
5985 return tcldom_EvalLocked(interp, (Tcl_Obj**)objv, doc, LOCK_WRITE);
5986
5987 case m_readlock:
5988 CheckArgs(3,3,2,"script");
5989 return tcldom_EvalLocked(interp, (Tcl_Obj**)objv, doc, LOCK_READ);
5990
5991 case m_renumber:
5992 CheckArgs(2,2,2,"");
5993 if (doc->nodeFlags & NEEDS_RENUMBERING) {
5994 domRenumberTree (doc->rootNode);
5995 doc->nodeFlags &= ~NEEDS_RENUMBERING;
5996 }
5997 return TCL_OK;
5998 )
5999 }
6000
6001 SetResult(doc_usage);
6002 return TCL_ERROR;
6003 }
6004
6005
6006 /*----------------------------------------------------------------------------
6007 | tcldom_createDocument
6008 |
6009 \---------------------------------------------------------------------------*/
6010 static
tcldom_createDocument(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * const objv[])6011 int tcldom_createDocument (
6012 ClientData clientData,
6013 Tcl_Interp *interp,
6014 int objc,
6015 Tcl_Obj * const objv[]
6016 )
6017 {
6018 int setVariable = 0;
6019 domDocument *doc;
6020 Tcl_Obj *newObjName = NULL;
6021
6022 GetTcldomTSD()
6023
6024 CheckArgs(2,3,1,"docElemName ?newObjVar?");
6025
6026 if (objc == 3) {
6027 newObjName = objv[2];
6028 setVariable = 1;
6029 }
6030
6031 CheckName(interp, Tcl_GetString(objv[1]), "root element", 0);
6032 doc = domCreateDocument(NULL, Tcl_GetString(objv[1]));
6033 return tcldom_returnDocumentObj(interp, doc, setVariable, newObjName, 1,
6034 0);
6035 }
6036
6037 /*----------------------------------------------------------------------------
6038 | tcldom_createDocumentNode
6039 |
6040 \---------------------------------------------------------------------------*/
6041 static
tcldom_createDocumentNode(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * const objv[])6042 int tcldom_createDocumentNode (
6043 ClientData clientData,
6044 Tcl_Interp *interp,
6045 int objc,
6046 Tcl_Obj * const objv[]
6047 )
6048 {
6049 int setVariable = 0, jsonType = 0, index;
6050 domDocument *doc;
6051 Tcl_Obj *newObjName = NULL;
6052
6053 static const char *options[] = {"-jsonType", NULL};
6054
6055 CheckArgs(1,4,1,"?-jsonType jsonType? ?newObjVar?");
6056
6057 if (objc == 2) {
6058 newObjName = objv[1];
6059 setVariable = 1;
6060 }
6061 if (objc > 2) {
6062 if (Tcl_GetIndexFromObj(interp, objv[1], options, "option",
6063 0, &index) != TCL_OK) {
6064 return TCL_ERROR;
6065 }
6066 Tcl_ResetResult(interp);
6067 if (Tcl_GetIndexFromObj(interp, objv[2], jsonTypes, "jsonType",
6068 0, &jsonType) != TCL_OK) {
6069 return TCL_ERROR;
6070 }
6071 if (objc == 4) {
6072 newObjName = objv[3];
6073 setVariable = 1;
6074 }
6075 }
6076
6077 doc = domCreateDoc(NULL, 0);
6078 doc->rootNode->info = jsonType;
6079
6080 return tcldom_returnDocumentObj(interp, doc, setVariable, newObjName, 1,
6081 0);
6082 }
6083
6084 /*----------------------------------------------------------------------------
6085 | tcldom_createDocumentNS
6086 |
6087 \---------------------------------------------------------------------------*/
6088 static
tcldom_createDocumentNS(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * const objv[])6089 int tcldom_createDocumentNS (
6090 ClientData clientData,
6091 Tcl_Interp *interp,
6092 int objc,
6093 Tcl_Obj * const objv[]
6094 )
6095 {
6096 int setVariable = 0, len;
6097 char *uri;
6098 domDocument *doc;
6099 Tcl_Obj *newObjName = NULL;
6100
6101 GetTcldomTSD()
6102
6103 CheckArgs(3,4,1,"uri docElemName ?newObjVar?");
6104
6105 if (objc == 4) {
6106 newObjName = objv[3];
6107 setVariable = 1;
6108 }
6109
6110 CheckName(interp, Tcl_GetString(objv[2]), "root element", 1);
6111 uri = Tcl_GetStringFromObj (objv[1], &len);
6112 if (len == 0) {
6113 if (!TSD(dontCheckName)) {
6114 if (!domIsNCNAME (Tcl_GetString(objv[2]))) {
6115 SetResult ("Missing URI in Namespace declaration");
6116 return TCL_ERROR;
6117 }
6118 }
6119 doc = domCreateDocument (NULL, Tcl_GetString(objv[2]));
6120 } else {
6121 doc = domCreateDocument (uri, Tcl_GetString(objv[2]));
6122 }
6123 return tcldom_returnDocumentObj (interp, doc, setVariable, newObjName, 1,
6124 0);
6125 }
6126
6127 /*----------------------------------------------------------------------------
6128 | tcldom_parse
6129 |
6130 \---------------------------------------------------------------------------*/
6131 static
tcldom_parse(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * const objv[])6132 int tcldom_parse (
6133 ClientData clientData,
6134 Tcl_Interp *interp,
6135 int objc,
6136 Tcl_Obj * const objv[]
6137 )
6138 {
6139 GetTcldomTSD()
6140
6141 char *xml_string, *option, *errStr, *channelId, *baseURI = NULL;
6142 char *jsonRoot = NULL;
6143 Tcl_Obj *extResolver = NULL;
6144 Tcl_Obj *feedbackCmd = NULL;
6145 const char *interpResult;
6146 int optionIndex, value, xml_string_len, mode;
6147 int jsonmaxnesting = JSON_MAX_NESTING;
6148 int ignoreWhiteSpaces = 1;
6149 int takeJSONParser = 0;
6150 int takeSimpleParser = 0;
6151 int takeHTMLParser = 0;
6152 int takeGUMBOParser = 0;
6153 int setVariable = 0;
6154 int ignorexmlns = 0;
6155 int feedbackAfter = 0;
6156 int useForeignDTD = 0;
6157 int paramEntityParsing = (int)XML_PARAM_ENTITY_PARSING_ALWAYS;
6158 int keepCDATA = 0;
6159 int status = 0;
6160 domDocument *doc;
6161 Tcl_Obj *newObjName = NULL;
6162 XML_Parser parser;
6163 Tcl_Channel chan = (Tcl_Channel) NULL;
6164 Tcl_CmdInfo cmdInfo;
6165
6166 static const char *parseOptions[] = {
6167 "-keepEmpties", "-simple", "-html",
6168 "-feedbackAfter", "-channel", "-baseurl",
6169 "-externalentitycommand", "-useForeignDTD", "-paramentityparsing",
6170 "-feedbackcmd", "-json", "-jsonroot",
6171 #ifdef TDOM_HAVE_GUMBO
6172 "-html5",
6173 #endif
6174 "-jsonmaxnesting", "-ignorexmlns", "--",
6175 "-keepCDATA", NULL
6176 };
6177 enum parseOption {
6178 o_keepEmpties, o_simple, o_html,
6179 o_feedbackAfter, o_channel, o_baseurl,
6180 o_externalentitycommand, o_useForeignDTD, o_paramentityparsing,
6181 o_feedbackcmd, o_json, o_jsonroot,
6182 #ifdef TDOM_HAVE_GUMBO
6183 o_htmlfive,
6184 #endif
6185 o_jsonmaxnesting, o_ignorexmlns, o_LAST,
6186 o_keepCDATA
6187 };
6188
6189 static const char *paramEntityParsingValues[] = {
6190 "always",
6191 "never",
6192 "notstandalone",
6193 (char *) NULL
6194 };
6195 enum paramEntityParsingValue {
6196 EXPAT_PARAMENTITYPARSINGALWAYS,
6197 EXPAT_PARAMENTITYPARSINGNEVER,
6198 EXPAT_PARAMENTITYPARSINGNOTSTANDALONE
6199 };
6200
6201 while (objc > 1) {
6202 option = Tcl_GetString(objv[1]);
6203 if (option[0] != '-') {
6204 break;
6205 }
6206 if (Tcl_GetIndexFromObj(interp, objv[1], parseOptions, "option", 0,
6207 &optionIndex) != TCL_OK) {
6208 return TCL_ERROR;
6209 }
6210
6211 switch ((enum parseOption) optionIndex) {
6212
6213 case o_keepEmpties:
6214 ignoreWhiteSpaces = 0;
6215 objv++; objc--; continue;
6216
6217 case o_json:
6218 if (takeGUMBOParser || takeHTMLParser) {
6219 SetResult("The options -html, -html5 and -json are "
6220 "mutually exclusive.");
6221 return TCL_ERROR;
6222 }
6223 takeJSONParser = 1;
6224 objv++; objc--; continue;
6225
6226 case o_jsonroot:
6227 objv++; objc--;
6228 if (objc > 1) {
6229 jsonRoot = Tcl_GetString(objv[1]);
6230 } else {
6231 SetResult("The \"dom parse\" option \"-jsonroot\" "
6232 "expects the document element name of the "
6233 "DOM tree to create as argument.");
6234 return TCL_ERROR;
6235 }
6236 if (!domIsNAME(jsonRoot)) {
6237 SetResult("-jsonroot value: not a valid element name");
6238 return TCL_ERROR;
6239 }
6240 objv++; objc--; continue;
6241
6242 case o_simple:
6243 takeSimpleParser = 1;
6244 objv++; objc--; continue;
6245
6246 case o_html:
6247 if (takeGUMBOParser || takeJSONParser) {
6248 SetResult("The options -html, -html5 and -json are "
6249 "mutually exclusive.");
6250 return TCL_ERROR;
6251 }
6252 takeSimpleParser = 1;
6253 takeHTMLParser = 1;
6254 objv++; objc--; continue;
6255
6256 #ifdef TDOM_HAVE_GUMBO
6257 case o_htmlfive:
6258 if (takeHTMLParser || takeJSONParser) {
6259 SetResult("The options -html, -html5 and -json are "
6260 "mutually exclusive.");
6261 return TCL_ERROR;
6262 }
6263 takeGUMBOParser = 1;
6264 objv++; objc--; continue;
6265 #endif
6266
6267 case o_feedbackAfter:
6268 objv++; objc--;
6269 if (objc > 1) {
6270 if (Tcl_GetIntFromObj(interp, objv[1], &feedbackAfter)
6271 != TCL_OK) {
6272 SetResult("-feedbackAfter must have an integer argument");
6273 return TCL_ERROR;
6274 }
6275 } else {
6276 SetResult("The \"dom parse\" option \"-feedbackAfter\" requires"
6277 " a positive integer as argument.");
6278 return TCL_ERROR;
6279 }
6280 if (feedbackAfter <= 0) {
6281 SetResult("The \"dom parse\" option \"-feedbackAfter\" requires"
6282 " a positive integer as argument.");
6283 return TCL_ERROR;
6284 }
6285 objv++; objc--;
6286 continue;
6287
6288 case o_channel:
6289 objv++; objc--;
6290 if (objc > 1) {
6291 channelId = Tcl_GetString(objv[1]);
6292 } else {
6293 SetResult("The \"dom parse\" option \"-channel\" "
6294 "requires a Tcl channel as argument.");
6295 return TCL_ERROR;
6296 }
6297 chan = Tcl_GetChannel(interp, channelId, &mode);
6298 if (chan == (Tcl_Channel) NULL) {
6299 return TCL_ERROR;
6300 }
6301 if ((mode & TCL_READABLE) == 0) {
6302 Tcl_AppendResult(interp, "channel \"", channelId,
6303 "\" wasn't opened for reading", (char *) NULL);
6304 return TCL_ERROR;
6305 }
6306 objv++; objc--;
6307 continue;
6308
6309 case o_baseurl:
6310 objv++; objc--;
6311 if (objc > 1) {
6312 baseURI = Tcl_GetString(objv[1]);
6313 } else {
6314 SetResult("The \"dom parse\" option \"-baseurl\" "
6315 "requires the base URL of the document "
6316 "to parse as argument.");
6317 return TCL_ERROR;
6318 }
6319 objv++; objc--;
6320 continue;
6321
6322 case o_externalentitycommand:
6323 objv++; objc--;
6324 if (objc > 1) {
6325 extResolver = objv[1];
6326 } else {
6327 SetResult("The \"dom parse\" option \"-externalentitycommand\" "
6328 "requires a script as argument.");
6329 return TCL_ERROR;
6330 }
6331 objv++; objc--;
6332 continue;
6333
6334 case o_useForeignDTD:
6335 objv++; objc--;
6336 if (objc > 1) {
6337 if (Tcl_GetBooleanFromObj(interp, objv[1], &useForeignDTD)
6338 != TCL_OK) {
6339 return TCL_ERROR;
6340 }
6341 } else {
6342 SetResult(dom_usage);
6343 return TCL_ERROR;
6344 }
6345 objv++; objc--;
6346 continue;
6347
6348 case o_paramentityparsing:
6349 if (objc > 2) {
6350 if (Tcl_GetIndexFromObj(interp, objv[2],
6351 paramEntityParsingValues, "value", 0,
6352 &value) != TCL_OK) {
6353 return TCL_ERROR;
6354 }
6355 switch ((enum paramEntityParsingValue) value) {
6356 case EXPAT_PARAMENTITYPARSINGALWAYS:
6357 paramEntityParsing = (int) XML_PARAM_ENTITY_PARSING_ALWAYS;
6358 break;
6359 case EXPAT_PARAMENTITYPARSINGNEVER:
6360 paramEntityParsing = (int) XML_PARAM_ENTITY_PARSING_NEVER;
6361 break;
6362 case EXPAT_PARAMENTITYPARSINGNOTSTANDALONE:
6363 paramEntityParsing =
6364 (int) XML_PARAM_ENTITY_PARSING_UNLESS_STANDALONE;
6365 break;
6366 }
6367 } else {
6368 SetResult("-paramEntityParsing requires 'always', 'never' "
6369 "or 'notstandalone' as argument");
6370 return TCL_ERROR;
6371 }
6372 objv++; objc--;
6373 objv++; objc--;
6374 continue;
6375
6376 case o_feedbackcmd:
6377 objv++; objc--;
6378 if (objc > 1) {
6379 feedbackCmd = objv[1];
6380 } else {
6381 SetResult("The \"dom parse\" option \"-feedbackcmd\" "
6382 "requires a script as argument.");
6383 return TCL_ERROR;
6384 }
6385 objv++; objc--;
6386 continue;
6387
6388 case o_ignorexmlns:
6389 ignorexmlns = 1;
6390 objv++; objc--; continue;
6391
6392 case o_jsonmaxnesting:
6393 objv++; objc--;
6394 if (objc < 2) {
6395 SetResult("The \"dom parse\" option \"-jsonmaxnesting\" "
6396 "requires an integer as argument.");
6397 return TCL_ERROR;
6398 }
6399 if (Tcl_GetIntFromObj(interp, objv[1], &jsonmaxnesting)
6400 != TCL_OK) {
6401 SetResult("-jsonmaxnesting must have an integer argument");
6402 return TCL_ERROR;
6403 }
6404 if (jsonmaxnesting < 0) {
6405 SetResult("The value of -jsonmaxnesting cannot be negativ");
6406 return TCL_ERROR;
6407 }
6408 objv++; objc--; continue;
6409
6410 case o_LAST:
6411 objv++; objc--; break;
6412
6413 case o_keepCDATA:
6414 keepCDATA = 1;
6415 objv++; objc--; break;
6416
6417 }
6418 if ((enum parseOption) optionIndex == o_LAST) break;
6419 }
6420
6421 if (feedbackAfter && !feedbackCmd) {
6422 if (!Tcl_GetCommandInfo(interp, "::dom::domParseFeedback",
6423 &cmdInfo)) {
6424 SetResult("If -feedbackAfter is used, "
6425 "-feedbackcmd must also be used.");
6426 return TCL_ERROR;
6427 }
6428 }
6429 if (chan == NULL) {
6430 if (objc < 2) {
6431 SetResult(dom_usage);
6432 return TCL_ERROR;
6433 }
6434 xml_string = Tcl_GetStringFromObj( objv[1], &xml_string_len);
6435 if (objc == 3) {
6436 newObjName = objv[2];
6437 setVariable = 1;
6438 }
6439 } else {
6440 if (objc > 2) {
6441 SetResult(dom_usage);
6442 return TCL_ERROR;
6443 }
6444 xml_string = NULL;
6445 xml_string_len = 0;
6446 if (takeSimpleParser || takeHTMLParser || takeJSONParser
6447 #ifdef TDOM_HAVE_GUMBO
6448 || takeGUMBOParser
6449 #endif
6450 ) {
6451 Tcl_AppendResult(interp, "simple, JSON or HTML parser(s) "
6452 " don't support channel reading", NULL);
6453 return TCL_ERROR;
6454 }
6455 if (objc == 2) {
6456 newObjName = objv[1];
6457 setVariable = 1;
6458 }
6459 }
6460
6461 #ifdef TDOM_HAVE_GUMBO
6462 if (takeGUMBOParser) {
6463 doc = HTML_GumboParseDocument(xml_string, ignoreWhiteSpaces,
6464 ignorexmlns);
6465 return tcldom_returnDocumentObj (interp, doc, setVariable, newObjName,
6466 1, 0);
6467 }
6468 #endif
6469
6470 if (takeJSONParser) {
6471 char s[50];
6472 int byteIndex, i;
6473
6474 errStr = NULL;
6475
6476 doc = JSON_Parse (xml_string, jsonRoot, jsonmaxnesting, &errStr,
6477 &byteIndex);
6478 if (doc) {
6479 return tcldom_returnDocumentObj (interp, doc, setVariable,
6480 newObjName, 1, 0);
6481 } else {
6482 Tcl_ResetResult(interp);
6483 sprintf(s, "%d", byteIndex);
6484 Tcl_AppendResult(interp, "error \"", errStr, "\" at position ",
6485 s, NULL);
6486 Tcl_AppendResult(interp, "\n\"", NULL);
6487 s[1] = '\0';
6488 for (i=-20; i < 40; i++) {
6489 if (byteIndex+i>=0) {
6490 if (xml_string[byteIndex+i]) {
6491 s[0] = xml_string[byteIndex+i];
6492 Tcl_AppendResult(interp, s, NULL);
6493 if (i==0) {
6494 Tcl_AppendResult(interp, " <--Error-- ", NULL);
6495 }
6496 } else {
6497 break;
6498 }
6499 }
6500 }
6501 Tcl_AppendResult(interp, "\"",NULL);
6502 return TCL_ERROR;
6503 }
6504 }
6505
6506 if (takeSimpleParser) {
6507 char s[50];
6508 int byteIndex, i;
6509
6510 errStr = NULL;
6511
6512 if (takeHTMLParser) {
6513 doc = HTML_SimpleParseDocument(xml_string, ignoreWhiteSpaces,
6514 &byteIndex, &errStr);
6515 } else {
6516 doc = XML_SimpleParseDocument(xml_string, ignoreWhiteSpaces,
6517 keepCDATA,
6518 baseURI, extResolver,
6519 &byteIndex, &errStr);
6520 }
6521 if (errStr != NULL) {
6522 domFreeDocument (doc, NULL, interp);
6523
6524 Tcl_ResetResult(interp);
6525 sprintf(s, "%d", byteIndex);
6526 Tcl_AppendResult(interp, "error \"", errStr, "\" at position ",
6527 s, NULL);
6528 if (byteIndex != -1) {
6529 Tcl_AppendResult(interp, "\n\"", NULL);
6530 s[1] = '\0';
6531 for (i=-80; i < 80; i++) {
6532 if ((byteIndex+i)>=0) {
6533 if (xml_string[byteIndex+i]) {
6534 s[0] = xml_string[byteIndex+i];
6535 Tcl_AppendResult(interp, s, NULL);
6536 if (i==0) {
6537 Tcl_AppendResult(interp, " <--Error-- ", NULL);
6538 }
6539 } else {
6540 break;
6541 }
6542 }
6543 }
6544 Tcl_AppendResult(interp, "\"",NULL);
6545 }
6546 if (takeHTMLParser) {
6547 FREE(errStr);
6548 }
6549 return TCL_ERROR;
6550 }
6551 return tcldom_returnDocumentObj (interp, doc, setVariable, newObjName,
6552 1, 0);
6553 }
6554
6555 #ifdef TDOM_NO_EXPAT
6556 Tcl_AppendResult(interp, "tDOM was compiled without Expat!", NULL);
6557 return TCL_ERROR;
6558 #else
6559 parser = XML_ParserCreate_MM(NULL, MEM_SUITE, NULL);
6560 Tcl_ResetResult(interp);
6561
6562 doc = domReadDocument(parser, xml_string,
6563 xml_string_len,
6564 ignoreWhiteSpaces,
6565 keepCDATA,
6566 TSD(storeLineColumn),
6567 ignorexmlns,
6568 feedbackAfter,
6569 feedbackCmd,
6570 chan,
6571 baseURI,
6572 extResolver,
6573 useForeignDTD,
6574 paramEntityParsing,
6575 interp,
6576 &status);
6577 if (doc == NULL) {
6578 char s[50];
6579 long byteIndex, i;
6580
6581 switch (status) {
6582 case TCL_BREAK:
6583 /* Abort of parsing by the application */
6584 Tcl_ResetResult(interp);
6585 XML_ParserFree(parser);
6586 return TCL_OK;
6587 default:
6588 interpResult = Tcl_GetStringResult(interp);
6589 sprintf(s, "%ld", XML_GetCurrentLineNumber(parser));
6590 if (interpResult[0] == '\0') {
6591 /* If the interp result isn't empty, then there was an error
6592 in an enternal entity and the interp result has already the
6593 error msg. If we don't got a document, but interp result is
6594 empty, the error occurred in the main document and we
6595 build the error msg as follows. */
6596 Tcl_AppendResult(interp, "error \"",
6597 XML_ErrorString(XML_GetErrorCode(parser)),
6598 "\" at line ", s, " character ", NULL);
6599 sprintf(s, "%ld", XML_GetCurrentColumnNumber(parser));
6600 Tcl_AppendResult(interp, s, NULL);
6601 byteIndex = XML_GetCurrentByteIndex(parser);
6602 if ((byteIndex != -1) && (chan == NULL)) {
6603 Tcl_AppendResult(interp, "\n\"", NULL);
6604 s[1] = '\0';
6605 for (i=-20; i < 40; i++) {
6606 if ((byteIndex+i)>=0) {
6607 if (xml_string[byteIndex+i]) {
6608 s[0] = xml_string[byteIndex+i];
6609 Tcl_AppendResult(interp, s, NULL);
6610 if (i==0) {
6611 Tcl_AppendResult(interp, " <--Error-- ", NULL);
6612 }
6613 } else {
6614 break;
6615 }
6616 }
6617 }
6618 Tcl_AppendResult(interp, "\"",NULL);
6619 }
6620 } else {
6621 if (status == TCL_OK) {
6622 /* For Tcl errors (in -externalentitycommand or
6623 * feedback callback) we leave the error msg in
6624 * the interpreter alone. If there wasn't a Tcl
6625 * error, there was a parsing error. Because the
6626 * interp has already an error msg, that parsing
6627 * error was in an external entity. Therefore, we
6628 * just add the place of the referencing entity in
6629 * the mail document.*/
6630 Tcl_AppendResult(interp, ", referenced at line ", s, NULL);
6631 sprintf(s, "%ld", XML_GetCurrentColumnNumber(parser));
6632 Tcl_AppendResult(interp, " character ", s, NULL);
6633 }
6634 }
6635 XML_ParserFree(parser);
6636 return TCL_ERROR;
6637 }
6638 }
6639 XML_ParserFree(parser);
6640
6641 return tcldom_returnDocumentObj (interp, doc, setVariable, newObjName, 1,
6642 0);
6643 #endif
6644
6645 }
6646
6647 /*----------------------------------------------------------------------------
6648 | tcldom_featureinfo
6649 |
6650 \---------------------------------------------------------------------------*/
6651 static
tcldom_featureinfo(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * const objv[])6652 int tcldom_featureinfo (
6653 ClientData clientData,
6654 Tcl_Interp *interp,
6655 int objc,
6656 Tcl_Obj * const objv[]
6657 )
6658 {
6659 int featureIndex, result;
6660
6661 static const char *features[] = {
6662 "expatversion", "expatmajorversion", "expatminorversion",
6663 "expatmicroversion", "dtd", "ns",
6664 "unknown", "tdomalloc", "lessns",
6665 "html5", "jsonmaxnesting", "versionhash",
6666 "pullparser", "TCL_UTF_MAX", NULL
6667 };
6668 enum feature {
6669 o_expatversion, o_expatmajorversion, o_expatminorversion,
6670 o_expatmicroversion, o_dtd, o_ns,
6671 o_unknown, o_tdomalloc, o_lessns,
6672 o_html5, o_jsonmaxnesting, o_versionhash,
6673 o_pullparser, o_TCL_UTF_MAX,
6674 };
6675
6676 if (Tcl_GetIndexFromObj(interp, objv[1], features, "feature", 0,
6677 &featureIndex) != TCL_OK) {
6678 return TCL_ERROR;
6679 }
6680
6681 switch ((enum feature) featureIndex) {
6682 case o_expatversion:
6683 SetResult(XML_ExpatVersion());
6684 break;
6685 case o_expatmajorversion:
6686 SetIntResult(XML_MAJOR_VERSION);
6687 break;
6688 case o_expatminorversion:
6689 SetIntResult(XML_MINOR_VERSION);
6690 break;
6691 case o_expatmicroversion:
6692 SetIntResult(XML_MICRO_VERSION);
6693 break;
6694 case o_dtd:
6695 #ifdef XML_DTD
6696 result = 1;
6697 #else
6698 result = 0;
6699 #endif
6700 SetBooleanResult(result);
6701 break;
6702 case o_ns:
6703 #ifdef XML_NS
6704 result = 1;
6705 #else
6706 result = 0;
6707 #endif
6708 SetBooleanResult(result);
6709 break;
6710 case o_unknown:
6711 #ifdef TDOM_NO_UNKNOWN_CMD
6712 result = 0;
6713 #else
6714 result = 1;
6715 #endif
6716 SetBooleanResult(result);
6717 break;
6718 case o_tdomalloc:
6719 #ifdef USE_NORMAL_ALLOCATOR
6720 result = 0;
6721 #else
6722 result = 1;
6723 #endif
6724 SetBooleanResult(result);
6725 break;
6726 case o_lessns:
6727 #ifdef TDOM_LESS_NS
6728 result = 1;
6729 #else
6730 result = 0;
6731 #endif
6732 SetBooleanResult(result);
6733 break;
6734 case o_html5:
6735 #ifdef TDOM_HAVE_GUMBO
6736 result = 1;
6737 #else
6738 result = 0;
6739 #endif
6740 SetBooleanResult(result);
6741 break;
6742 case o_jsonmaxnesting:
6743 SetIntResult(JSON_MAX_NESTING);
6744 break;
6745
6746 case o_versionhash:
6747 SetResult(FOSSIL_HASH);
6748 break;
6749 case o_pullparser:
6750 #ifndef TDOM_NO_PULL
6751 result = 1;
6752 #else
6753 result = 0;
6754 #endif
6755 SetBooleanResult(result);
6756 break;
6757 case o_TCL_UTF_MAX:
6758 SetIntResult(TCL_UTF_MAX);
6759 break;
6760 }
6761 return TCL_OK;
6762 }
6763
6764 /*----------------------------------------------------------------------------
6765 | tcldom_DomObjCmd
6766 |
6767 \---------------------------------------------------------------------------*/
tcldom_DomObjCmd(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * const objv[])6768 int tcldom_DomObjCmd (
6769 ClientData clientData,
6770 Tcl_Interp * interp,
6771 int objc,
6772 Tcl_Obj * const objv[]
6773 )
6774 {
6775 GetTcldomTSD()
6776
6777 char * method, tmp[300];
6778 int methodIndex, result, i, bool;
6779 Tcl_CmdInfo cmdInfo;
6780 Tcl_Obj * mobjv[MAX_REWRITE_ARGS];
6781
6782 static const char *domMethods[] = {
6783 "createDocument", "createDocumentNS", "createNodeCmd",
6784 "parse", "setStoreLineColumn",
6785 "isCharData", "isName", "isPIName",
6786 "isQName", "isComment", "isCDATA",
6787 "isPIValue", "isNCName", "createDocumentNode",
6788 "setNameCheck", "setTextCheck", "setObjectCommands",
6789 "featureinfo", "isBMPCharData",
6790 #ifdef TCL_THREADS
6791 "attachDocument", "detachDocument",
6792 #endif
6793 NULL
6794 };
6795 enum domMethod {
6796 m_createDocument, m_createDocumentNS, m_createNodeCmd,
6797 m_parse, m_setStoreLineColumn,
6798 m_isCharData, m_isName, m_isPIName,
6799 m_isQName, m_isComment, m_isCDATA,
6800 m_isPIValue, m_isNCName, m_createDocumentNode,
6801 m_setNameCheck, m_setTextCheck, m_setObjectCommands,
6802 m_featureinfo, m_isBMPCharData
6803 #ifdef TCL_THREADS
6804 ,m_attachDocument, m_detachDocument
6805 #endif
6806 };
6807
6808 static const char *nodeModeValues[] = {
6809 "automatic", "command", "token", NULL
6810 };
6811 enum nodeModeValue {
6812 v_automatic, v_command, v_token
6813 };
6814
6815 if (objc < 2) {
6816 SetResult(dom_usage);
6817 return TCL_ERROR;
6818 }
6819 if (TSD(domCreateCmdMode) == DOM_CREATECMDMODE_AUTO) {
6820 TSD(dontCreateObjCommands) = 0;
6821 }
6822 method = Tcl_GetString(objv[1]);
6823 if (Tcl_GetIndexFromObj(NULL, objv[1], domMethods, "method", 0,
6824 &methodIndex) != TCL_OK) {
6825 /*--------------------------------------------------------
6826 | try to find method implemented as normal Tcl proc
6827 \-------------------------------------------------------*/
6828 if ((strlen(method)-1) >= 270) {
6829 SetResult("method name too long!");
6830 return TCL_ERROR;
6831 }
6832 sprintf(tmp, "::dom::DOMImplementation::%s", method);
6833 DBG(fprintf(stderr, "testing %s\n", tmp));
6834 result = Tcl_GetCommandInfo(interp, tmp, &cmdInfo);
6835 if (!result) {
6836 SetResult(dom_usage);
6837 return TCL_ERROR;
6838 }
6839 if (!cmdInfo.isNativeObjectProc) {
6840 SetResult("can't access Tcl level method!");
6841 return TCL_ERROR;
6842 }
6843 if (objc >= MAX_REWRITE_ARGS) {
6844 SetResult("too many args to call Tcl level method!");
6845 return TCL_ERROR;
6846 }
6847 mobjv[0] = objv[1];
6848 mobjv[1] = objv[0];
6849 for (i=2; i<objc; i++) mobjv[i] = objv[i];
6850 return cmdInfo.objProc(cmdInfo.objClientData, interp, objc, mobjv);
6851 }
6852 CheckArgs(2,12,1,dom_usage);
6853 switch ((enum domMethod) methodIndex) {
6854
6855 case m_createDocument:
6856 return tcldom_createDocument(clientData, interp, --objc, objv+1);
6857
6858 case m_createDocumentNS:
6859 return tcldom_createDocumentNS(clientData, interp, --objc, objv+1);
6860
6861 case m_createDocumentNode:
6862 return tcldom_createDocumentNode (clientData, interp, --objc,
6863 objv+1);
6864 case m_createNodeCmd:
6865 return nodecmd_createNodeCmd(interp, --objc, objv+1,
6866 !TSD(dontCheckName),
6867 !TSD(dontCheckCharData));
6868 case m_parse:
6869 return tcldom_parse(clientData, interp, --objc, objv+1);
6870
6871 #ifdef TCL_THREADS
6872 case m_attachDocument:
6873 {
6874 char *cmdName, *errMsg;
6875 domDocument *doc;
6876 if (objc < 3) {
6877 SetResult(dom_usage);
6878 return TCL_ERROR;
6879 }
6880 cmdName = Tcl_GetString(objv[2]);
6881 doc = tcldom_getDocumentFromName(interp, cmdName, &errMsg);
6882 if (doc == NULL) {
6883 SetResult(errMsg);
6884 return TCL_ERROR;
6885 }
6886 return tcldom_returnDocumentObj(interp, doc, (objc == 4),
6887 (objc==4) ? objv[3] : NULL,
6888 1, 0);
6889 }
6890 break;
6891 case m_detachDocument:
6892 {
6893 char objCmdName[80], *cmdName, *errMsg;
6894 Tcl_CmdInfo cmdInfo;
6895 domDocument *doc;
6896 if (objc < 3) {
6897 SetResult(dom_usage);
6898 return TCL_ERROR;
6899 }
6900 cmdName = Tcl_GetString(objv[2]);
6901 doc = tcldom_getDocumentFromName(interp, cmdName, &errMsg);
6902 if (doc == NULL) {
6903 SetResult(errMsg);
6904 return TCL_ERROR;
6905 }
6906 DOC_CMD(objCmdName, doc);
6907 if (Tcl_GetCommandInfo(interp, objCmdName, &cmdInfo)) {
6908 Tcl_DeleteCommand(interp, objCmdName);
6909 } else {
6910 tcldom_deleteDoc(interp, doc);
6911 }
6912 SetResult("");
6913 return TCL_OK;
6914 }
6915 break;
6916 #endif
6917
6918 case m_setStoreLineColumn:
6919 if (objc == 3) {
6920 if (Tcl_GetBooleanFromObj(interp, objv[2], &bool) != TCL_OK) {
6921 return TCL_ERROR;
6922 }
6923 TSD(storeLineColumn) = bool;
6924 }
6925 SetBooleanResult(TSD(storeLineColumn));
6926 return TCL_OK;
6927
6928 case m_setNameCheck:
6929 if (objc == 3) {
6930 if (Tcl_GetBooleanFromObj(interp, objv[2], &bool) != TCL_OK) {
6931 return TCL_ERROR;
6932 }
6933 TSD(dontCheckName) = !bool;
6934 }
6935 SetBooleanResult(!TSD(dontCheckName));
6936 return TCL_OK;
6937
6938 case m_setTextCheck:
6939 if (objc == 3) {
6940 if (Tcl_GetBooleanFromObj(interp, objv[2], &bool) != TCL_OK) {
6941 return TCL_ERROR;
6942 }
6943 TSD(dontCheckCharData) = !bool;
6944 }
6945 SetBooleanResult(!TSD(dontCheckCharData));
6946 return TCL_OK;
6947
6948 case m_setObjectCommands:
6949 if (objc == 3) {
6950 if (Tcl_GetIndexFromObj (interp, objv[2], nodeModeValues,
6951 "mode value", 0, &i) != TCL_OK) {
6952 return TCL_ERROR;
6953 }
6954 switch ((enum nodeModeValue) i) {
6955 case v_automatic:
6956 TSD(domCreateCmdMode) = DOM_CREATECMDMODE_AUTO;
6957 TSD(dontCreateObjCommands) = 0;
6958 break;
6959 case v_command:
6960 TSD(domCreateCmdMode) = DOM_CREATECMDMODE_CMDS;
6961 TSD(dontCreateObjCommands) = 0;
6962 break;
6963 case v_token:
6964 TSD(domCreateCmdMode) = DOM_CREATECMDMODE_TOKENS;
6965 TSD(dontCreateObjCommands) = 1;
6966 break;
6967 }
6968 }
6969 switch (TSD(domCreateCmdMode)) {
6970 case DOM_CREATECMDMODE_AUTO:
6971 SetResult("automatic");
6972 break;
6973 case DOM_CREATECMDMODE_CMDS:
6974 SetResult("command");
6975 break;
6976 case DOM_CREATECMDMODE_TOKENS:
6977 SetResult("token");
6978 break;
6979 default:
6980 domPanic("Impossible node creation mode.");
6981 }
6982 return TCL_OK;
6983
6984 case m_isCharData:
6985 CheckArgs(3,3,2,"string");
6986 SetBooleanResult(domIsChar(Tcl_GetString(objv[2])));
6987 return TCL_OK;
6988
6989 case m_isName:
6990 CheckArgs(3,3,2,"string");
6991 SetBooleanResult(domIsNAME(Tcl_GetString(objv[2])));
6992 return TCL_OK;
6993
6994 case m_isPIName:
6995 CheckArgs(3,3,2,"string");
6996 SetBooleanResult(domIsPINAME(Tcl_GetString(objv[2])));
6997 return TCL_OK;
6998
6999 case m_isQName:
7000 CheckArgs(3,3,2,"string");
7001 SetBooleanResult(domIsQNAME(Tcl_GetString(objv[2])));
7002 return TCL_OK;
7003
7004 case m_isComment:
7005 CheckArgs(3,3,2,"string");
7006 SetBooleanResult(domIsComment(Tcl_GetString(objv[2])));
7007 return TCL_OK;
7008
7009 case m_isCDATA:
7010 CheckArgs(3,3,2,"string");
7011 SetBooleanResult(domIsCDATA(Tcl_GetString(objv[2])));
7012 return TCL_OK;
7013
7014 case m_isPIValue:
7015 CheckArgs(3,3,2,"string");
7016 SetBooleanResult(domIsPIValue(Tcl_GetString(objv[2])));
7017 return TCL_OK;
7018
7019 case m_isNCName:
7020 CheckArgs(3,3,2,"string");
7021 SetBooleanResult(domIsNCNAME(Tcl_GetString(objv[2])));
7022 return TCL_OK;
7023
7024 case m_featureinfo:
7025 CheckArgs(3,3,2,"feature")
7026 return tcldom_featureinfo(clientData, interp, --objc, objv+1);
7027
7028 case m_isBMPCharData:
7029 CheckArgs(3,3,2,"string");
7030 SetBooleanResult(domIsBMPChar(Tcl_GetString(objv[2])));
7031 return TCL_OK;
7032
7033 }
7034 SetResult( dom_usage);
7035 return TCL_ERROR;
7036 }
7037
7038 #ifdef TCL_THREADS
7039
7040 /*----------------------------------------------------------------------------
7041 | tcldom_EvalLocked
7042 |
7043 \---------------------------------------------------------------------------*/
7044
7045 static
tcldom_EvalLocked(Tcl_Interp * interp,Tcl_Obj ** objv,domDocument * doc,int flag)7046 int tcldom_EvalLocked (
7047 Tcl_Interp * interp,
7048 Tcl_Obj ** objv,
7049 domDocument * doc,
7050 int flag
7051 )
7052 {
7053 int ret;
7054 domlock *dl = doc->lock;
7055
7056 domLocksLock(dl, flag);
7057
7058 Tcl_AllowExceptions(interp);
7059 ret = Tcl_EvalObjEx(interp, objv[2], 0);
7060 if (ret == TCL_ERROR) {
7061 char msg[64 + TCL_INTEGER_SPACE];
7062 sprintf(msg, "\n (\"%s %s\" body line %d)", Tcl_GetString(objv[0]),
7063 Tcl_GetString(objv[1]), Tcl_GetErrorLine(interp));
7064 Tcl_AddErrorInfo(interp, msg);
7065 }
7066
7067 domLocksUnlock(dl);
7068
7069 return (ret == TCL_BREAK) ? TCL_OK : ret;
7070 }
7071
7072 /*----------------------------------------------------------------------------
7073 | tcldom_RegisterDocShared
7074 |
7075 \---------------------------------------------------------------------------*/
7076
7077 static
tcldom_RegisterDocShared(domDocument * doc)7078 int tcldom_RegisterDocShared (
7079 domDocument * doc
7080 )
7081 {
7082 Tcl_HashEntry *entryPtr;
7083 int newEntry = 0;
7084 #ifdef DEBUG
7085 int refCount;
7086 #endif
7087
7088 Tcl_MutexLock(&tableMutex);
7089 #ifdef DEBUG
7090 refCount = ++doc->refCount;
7091 #else
7092 ++doc->refCount;
7093 #endif
7094 entryPtr = Tcl_CreateHashEntry(&sharedDocs, (char*)doc, &newEntry);
7095 if (newEntry) {
7096 Tcl_SetHashValue(entryPtr, (ClientData)doc);
7097 }
7098 Tcl_MutexUnlock(&tableMutex);
7099
7100 DBG(fprintf(stderr, "--> tcldom_RegisterDocShared: doc %p %s "
7101 "shared table now with refcount of %d\n", doc,
7102 newEntry ? "entered into" : "already in", refCount));
7103 return 0;
7104 }
7105
7106 /*----------------------------------------------------------------------------
7107 | tcldom_UnregisterDocShared
7108 |
7109 \---------------------------------------------------------------------------*/
7110
7111 static
tcldom_UnregisterDocShared(Tcl_Interp * interp,domDocument * doc)7112 int tcldom_UnregisterDocShared (
7113 Tcl_Interp * interp,
7114 domDocument * doc
7115 )
7116 {
7117 int deleted;
7118
7119 Tcl_MutexLock(&tableMutex);
7120 if (doc->refCount > 1) {
7121 tcldom_deleteNode(doc->rootNode, interp);
7122 domFreeNode(doc->rootNode, tcldom_deleteNode, interp, 1);
7123 doc->refCount--;
7124 deleted = 0;
7125 } else {
7126 if (tcldomInitialized) {
7127 Tcl_HashEntry *entryPtr = Tcl_FindHashEntry(&sharedDocs, (char*)doc);
7128 if (entryPtr) {
7129 Tcl_DeleteHashEntry(entryPtr);
7130 deleted = 1;
7131 } else {
7132 deleted = 0;
7133 }
7134 } else {
7135 deleted = 0;
7136 }
7137 }
7138 Tcl_MutexUnlock(&tableMutex);
7139
7140 DBG(fprintf(stderr, "--> tcldom_UnregisterDocShared: doc %p %s "
7141 "shared table\n", doc, deleted ? "deleted from" : "left in"));
7142
7143 return deleted;
7144 }
7145
7146 /*----------------------------------------------------------------------------
7147 | tcldom_CheckDocShared
7148 |
7149 \---------------------------------------------------------------------------*/
7150
7151 static
tcldom_CheckDocShared(domDocument * doc)7152 int tcldom_CheckDocShared (
7153 domDocument * doc
7154 )
7155 {
7156 Tcl_HashEntry *entryPtr;
7157 domDocument *tabDoc = NULL;
7158 int found = 0;
7159
7160 Tcl_MutexLock(&tableMutex);
7161 if (tcldomInitialized) {
7162 entryPtr = Tcl_FindHashEntry(&sharedDocs, (char*)doc);
7163 if (entryPtr == NULL) {
7164 found = 0;
7165 } else {
7166 tabDoc = (domDocument*)Tcl_GetHashValue(entryPtr);
7167 found = tabDoc ? 1 : 0;
7168 }
7169 }
7170 Tcl_MutexUnlock(&tableMutex);
7171
7172 if (found && doc != tabDoc) {
7173 Tcl_Panic("document mismatch; doc=%p, in table=%p\n", (void *)doc,
7174 (void *)tabDoc);
7175 }
7176
7177 return found;
7178 }
7179
7180 #endif /* TCL_THREADS */
7181
7182 #ifndef TDOM_NO_UNKNOWN_CMD
7183
7184 /*----------------------------------------------------------------------------
7185 | tcldom_unknownCmd
7186 |
7187 \---------------------------------------------------------------------------*/
tcldom_unknownCmd(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * const objv[])7188 int tcldom_unknownCmd (
7189 ClientData clientData,
7190 Tcl_Interp * interp,
7191 int objc,
7192 Tcl_Obj * const objv[]
7193 )
7194 {
7195 int len, i, rc, openedParen, count, args;
7196 char *cmd, *dot, *paren, *arg[MAX_REWRITE_ARGS], *object, *method;
7197 Tcl_DString callString;
7198 Tcl_CmdInfo cmdInfo;
7199 Tcl_Obj *vector[2+MAX_REWRITE_ARGS];
7200 Tcl_Obj **objvCall;
7201
7202
7203 cmd = Tcl_GetStringFromObj(objv[1], &len);
7204
7205 DBG(fprintf(stderr, "tcldom_unknownCmd: cmd=-%s- \n", cmd));
7206
7207 dot = strchr(cmd,'.');
7208 if ((dot != NULL) && (dot != cmd)) {
7209
7210 object = cmd;
7211 cmd = dot+1;
7212 *dot = '\0';
7213 dot = strchr(cmd,'.');
7214
7215 while (dot != NULL) {
7216
7217 method = cmd;
7218 paren = strchr(cmd,'(');
7219 args = 0;
7220 if (paren && (paren < dot)) {
7221 *paren = '\0';
7222 paren++;
7223 arg[args] = paren;
7224 openedParen = 1;
7225 while (*paren) {
7226 if (*paren == '\\') {
7227 (void) Tcl_Backslash(paren, &count);
7228 paren += count;
7229 } else if (*paren == ')') {
7230 openedParen--;
7231 if (openedParen==0) {
7232 *paren = '\0';
7233 args++;
7234 break;
7235 }
7236 } else if (*paren == '(') {
7237 openedParen++;
7238 paren++;
7239 } else if (*paren == ',') {
7240 *paren = '\0';
7241 arg[++args] = paren+1;
7242 if (args >= MAX_REWRITE_ARGS) {
7243 SetResult( "too many args");
7244 return TCL_ERROR;
7245 }
7246 paren++;
7247 } else {
7248 paren++;
7249 }
7250 }
7251 if (openedParen!=0) {
7252 SetResult( "mismatched (");
7253 return TCL_ERROR;
7254 }
7255 }
7256 cmd = dot+1;
7257 *dot = '\0';
7258
7259 DBG(fprintf(stderr, "method=-%s- \n", method);
7260 fprintf(stderr, "rest=-%s- \n", cmd);
7261 for(i=0; i<args; i++) {
7262 fprintf(stderr, "args %d =-%s- \n", i, arg[i]);
7263 }
7264 )
7265
7266 /*---------------------------------------------------------
7267 | intermediate call
7268 \--------------------------------------------------------*/
7269 rc = Tcl_GetCommandInfo(interp, object, &cmdInfo);
7270 if (rc && cmdInfo.isNativeObjectProc) {
7271 vector[0] = Tcl_NewStringObj(object, -1);
7272 vector[1] = Tcl_NewStringObj(method, -1);
7273 for(i=0; i<args; i++) {
7274 vector[2+i] = Tcl_NewStringObj(arg[i], -1);
7275 }
7276 rc = cmdInfo.objProc(cmdInfo.objClientData, interp, 2+args,
7277 vector);
7278 if (rc != TCL_OK) {
7279 return rc;
7280 }
7281 for(i=args+1; i >= 0; i--) {
7282 Tcl_DecrRefCount(vector[i]);
7283 }
7284 } else {
7285 Tcl_DStringInit(&callString);
7286 Tcl_DStringAppendElement(&callString, object);
7287 Tcl_DStringAppendElement(&callString, method);
7288 for(i=0; i<args; i++) {
7289 Tcl_DStringAppendElement(&callString, arg[i] );
7290 }
7291 rc = Tcl_Eval(interp, Tcl_DStringValue(&callString));
7292 Tcl_DStringFree(&callString);
7293 if (rc != TCL_OK) {
7294 return rc;
7295 }
7296 }
7297 /* get the new object returned from above call */
7298 object = Tcl_GetStringResult(interp);
7299 dot = strchr(cmd,'.');
7300 }
7301
7302 method = cmd;
7303 paren = strchr(cmd,'(');
7304 args = 0;
7305 if (paren) {
7306 *paren = '\0';
7307 paren++;
7308 arg[args] = paren;
7309 openedParen = 1;
7310 while (*paren) {
7311 if (*paren == '\\') {
7312 (void) Tcl_Backslash(paren, &count);
7313 paren += count;
7314 } else if (*paren == ')') {
7315 openedParen--;
7316 if (openedParen==0) {
7317 *paren = '\0';
7318 args++;
7319 break;
7320 }
7321 } else if (*paren == '(') {
7322 openedParen++;
7323 paren++;
7324 } else if (*paren == ',') {
7325 *paren = '\0';
7326 arg[++args] = paren+1;
7327 if (args >= MAX_REWRITE_ARGS) {
7328 SetResult( "too many args");
7329 return TCL_ERROR;
7330 }
7331 paren++;
7332 } else {
7333 paren++;
7334 }
7335 }
7336 if (openedParen!=0) {
7337 SetResult( "mismatched (");
7338 return TCL_ERROR;
7339 }
7340 }
7341 DBG(fprintf(stderr, "method=-%s- \n", method);
7342 fprintf(stderr, "rest=-%s- \n", cmd);
7343 for(i=0; i<args; i++) {
7344 fprintf(stderr, "args %d =-%s- \n", i, arg[i]);
7345 }
7346 )
7347
7348 /*----------------------------------------------------------------
7349 | final call
7350 \---------------------------------------------------------------*/
7351 rc = Tcl_GetCommandInfo(interp, object, &cmdInfo);
7352 if (rc && cmdInfo.isNativeObjectProc) {
7353
7354 objvCall = (Tcl_Obj**)MALLOC(sizeof(Tcl_Obj*) * (objc+args));
7355
7356 objvCall[0] = Tcl_NewStringObj(object, -1);
7357 objvCall[1] = Tcl_NewStringObj(method, -1);
7358 for(i=0; i<args; i++) {
7359 objvCall[2+i] = Tcl_NewStringObj(arg[i], -1);
7360 }
7361 for (i=2; i<objc; i++) {
7362 objvCall[i+args] = objv[i];
7363 }
7364 rc = cmdInfo.objProc(cmdInfo.objClientData, interp, objc + args,
7365 objvCall);
7366 for(i=objc+args-1; i >= 0; i--) {
7367 Tcl_DecrRefCount(objvCall[i]);
7368 }
7369 FREE((void*)objvCall);
7370
7371 } else {
7372 Tcl_DStringInit(&callString);
7373 Tcl_DStringAppendElement(&callString, object);
7374 Tcl_DStringAppendElement(&callString, method);
7375 for(i=2; i<objc; i++) {
7376 Tcl_DStringAppendElement(&callString, Tcl_GetString(objv[i]));
7377 }
7378 rc = Tcl_Eval(interp, Tcl_DStringValue(&callString));
7379 Tcl_DStringFree(&callString);
7380 }
7381 return rc;
7382
7383 } else {
7384
7385 /*----------------------------------------------------------------
7386 | call the original unknown function
7387 |
7388 \---------------------------------------------------------------*/
7389 Tcl_DStringInit(&callString);
7390 Tcl_DStringAppendElement(&callString, "unknown_tdom");
7391 for(i=1; i<objc; i++) {
7392 Tcl_DStringAppendElement(&callString, Tcl_GetString(objv[i]));
7393 }
7394 rc = Tcl_Eval(interp, Tcl_DStringValue(&callString));
7395 Tcl_DStringFree(&callString);
7396 return rc;
7397 }
7398 }
7399
7400 #endif
7401