1 /**
2 The purpose of this file is to provide the C-level facilities
3 to create, modify and manage internal XML DOM nodes at the S
4 language level. We want to be able to use the interface defined
5 by xmlOutputDOM() and xmlOutputBuffer() but with an implementation
6 that returns a tree that is built to be used with the libxml
7 data structures. So the intent is to incrementally add nodes
8 to the tree in memory and then pass this to libxml to add it to
9 another tree or write it to a file, etc.
10
11 The essential public/high-level functionality provided by the the S-leve interface
12 for building trees consists of:
13
14 1) addTag
15 2) closeTag
16 3) addComment
17 4) value
18
19 addNode
20
21 a) getOpenTag
22 b) reset
23 */
24
25 #include "RSCommon.h"
26 #include "RS_XML.h"
27
28
29 #ifdef FROM_GNOME_XML_DIR
30 #include <gnome-xml/parserInternals.h>
31 #include <gnome-xml/xmlmemory.h>
32 #else
33 #include <libxml/parserInternals.h>
34 #include <libxml/xmlmemory.h>
35 #include <libxml/HTMLtree.h>
36 #endif
37
38
39 #define R_USE_XML_ENCODING 1
40 #include "Utils.h" /* R_createXMLNodeRef, Encoding macros. */
41
42 #include "NodeGC.h"
43
44 #ifdef USE_OLD_ROOT_CHILD_NAMES
45 # define XML_ROOT(n) (n)->childs
46 #else
47 # define XML_ROOT(n) (n)->xmlRootNode
48 #endif
49
50 void incrementDocRef(xmlDocPtr doc);
51 int getNodeCount(xmlNodePtr node);
52 void incrementDocRefBy(xmlDocPtr doc, int num);
53
54 void RS_XML_recursive_unsetListDoc(xmlNodePtr list);
55
56
57 /**
58 Create a libxml comment node and return it as an S object
59 referencing this value.
60 */
61
62 USER_OBJECT_
R_xmlNewComment(USER_OBJECT_ str,USER_OBJECT_ sdoc,USER_OBJECT_ manageMemory)63 R_xmlNewComment(USER_OBJECT_ str, USER_OBJECT_ sdoc, USER_OBJECT_ manageMemory)
64 {
65 xmlNodePtr node;
66 xmlDocPtr doc = NULL;
67 xmlChar *txt;
68
69 if(GET_LENGTH(sdoc))
70 doc = (xmlDocPtr) R_ExternalPtrAddr(sdoc);
71
72 txt = CHAR_TO_XMLCHAR(CHAR_DEREF(STRING_ELT(str, 0)));
73 node = doc ? xmlNewDocComment(doc, txt) : xmlNewComment(txt);
74
75 return(R_createXMLNodeRef(node, manageMemory));
76 }
77
78 USER_OBJECT_
R_newXMLTextNode(USER_OBJECT_ value,USER_OBJECT_ sdoc,SEXP manageMemory)79 R_newXMLTextNode(USER_OBJECT_ value, USER_OBJECT_ sdoc, SEXP manageMemory)
80 {
81 xmlNodePtr node;
82 xmlDocPtr doc = NULL;
83 xmlChar *txt;
84
85 if(GET_LENGTH(sdoc))
86 doc = (xmlDocPtr) R_ExternalPtrAddr(sdoc);
87
88 txt = CHAR_TO_XMLCHAR(CHAR_DEREF(STRING_ELT(value, 0)));
89 if(doc)
90 node = xmlNewDocTextLen(doc, txt, (int)strlen(XMLCHAR_TO_CHAR(txt)));
91 else
92 node = xmlNewText(txt);
93
94 return(R_createXMLNodeRef(node, manageMemory));
95 }
96
97 USER_OBJECT_
R_newXMLCDataNode(USER_OBJECT_ sdoc,USER_OBJECT_ value,USER_OBJECT_ manageMemory)98 R_newXMLCDataNode(USER_OBJECT_ sdoc, USER_OBJECT_ value, USER_OBJECT_ manageMemory)
99 {
100 xmlDocPtr doc = NULL;
101 xmlNodePtr node;
102 const char *tmp;
103
104 if(GET_LENGTH(sdoc))
105 doc = (xmlDocPtr) R_ExternalPtrAddr(sdoc);
106
107 tmp = CHAR_DEREF(STRING_ELT(value,0));
108
109 node = xmlNewCDataBlock(doc, CHAR_TO_XMLCHAR(tmp), (int)strlen(tmp));
110
111 return(R_createXMLNodeRef(node, manageMemory));
112 }
113
114
115 USER_OBJECT_
R_newXMLPINode(USER_OBJECT_ sdoc,USER_OBJECT_ name,USER_OBJECT_ content,USER_OBJECT_ manageMemory)116 R_newXMLPINode(USER_OBJECT_ sdoc, USER_OBJECT_ name, USER_OBJECT_ content, USER_OBJECT_ manageMemory)
117 {
118 xmlNodePtr node;
119
120 node = xmlNewPI(CHAR_TO_XMLCHAR(CHAR_DEREF(STRING_ELT(name, 0))), CHAR_TO_XMLCHAR(CHAR_DEREF(STRING_ELT(content, 0))));
121 return( R_createXMLNodeRef(node, manageMemory) );
122 }
123
124
125 USER_OBJECT_
R_newXMLNode(USER_OBJECT_ name,USER_OBJECT_ attrs,USER_OBJECT_ nameSpace,USER_OBJECT_ sdoc,USER_OBJECT_ nameSpaceDefinitions,USER_OBJECT_ manageMemory)126 R_newXMLNode(USER_OBJECT_ name, USER_OBJECT_ attrs, USER_OBJECT_ nameSpace, USER_OBJECT_ sdoc,
127 USER_OBJECT_ nameSpaceDefinitions, USER_OBJECT_ manageMemory)
128 {
129 xmlDocPtr doc = NULL;
130 xmlNsPtr ns = NULL;
131 xmlNodePtr node;
132
133 if(GET_LENGTH(sdoc)) {
134 doc = (xmlDocPtr) R_ExternalPtrAddr(sdoc);
135
136 if(doc->type != XML_DOCUMENT_NODE && doc->type != XML_HTML_DOCUMENT_NODE)
137 doc = doc->doc;
138 }
139
140
141 if(GET_LENGTH(nameSpace) > 0) {
142 /* Need the default namespace and then also any other */
143 CHAR_DEREF(STRING_ELT(nameSpace, 0));
144 }
145
146 node = xmlNewDocNode(doc, ns, CHAR_TO_XMLCHAR(CHAR_DEREF(STRING_ELT(name, 0))), NULL);
147
148 if(doc && XML_ROOT(doc) == NULL) {
149 XML_ROOT(doc) = node;
150 }
151
152 return( R_createXMLNodeRef(node, manageMemory) );
153 }
154
155 USER_OBJECT_
RS_XML_getNextSibling(USER_OBJECT_ s_node,USER_OBJECT_ s_prev,USER_OBJECT_ manageMemory)156 RS_XML_getNextSibling(USER_OBJECT_ s_node, USER_OBJECT_ s_prev, USER_OBJECT_ manageMemory)
157 {
158 xmlNodePtr node = (xmlNodePtr) R_ExternalPtrAddr(s_node), ptr;
159
160 ptr = LOGICAL(s_prev)[0] ? node->next : node->prev;
161
162 return(ptr ? R_createXMLNodeRef(ptr, manageMemory) : NULL_USER_OBJECT);
163 }
164
165
166 /*
167 Add attributes to an existing node.
168 At present, doesn't check for duplicates.
169 Can do this in C or in R, but need to remove existing values,
170 and ensure that namespace considerations are handled properly.
171 */
172 USER_OBJECT_
RS_XML_addNodeAttributes(USER_OBJECT_ s_node,USER_OBJECT_ attrs)173 RS_XML_addNodeAttributes(USER_OBJECT_ s_node, USER_OBJECT_ attrs)
174 {
175 int i, n;
176 USER_OBJECT_ attr_names;
177 xmlNodePtr node = (xmlNodePtr) R_ExternalPtrAddr(s_node);
178
179 n = GET_LENGTH(attrs);
180 attr_names = GET_NAMES(attrs);
181 for(i = 0; i < n; i++) {
182 xmlSetProp(node, CHAR_TO_XMLCHAR(CHAR_DEREF(STRING_ELT(attr_names, i))), CHAR_TO_XMLCHAR(CHAR_DEREF(STRING_ELT(attrs, i))));
183 }
184
185 return(ScalarInteger(n));
186 }
187
188 USER_OBJECT_
RS_XML_setNodeName(USER_OBJECT_ s_node,USER_OBJECT_ s_name)189 RS_XML_setNodeName(USER_OBJECT_ s_node, USER_OBJECT_ s_name)
190 {
191 xmlNodePtr node = (xmlNodePtr) R_ExternalPtrAddr(s_node);
192 xmlChar *name = CHAR_TO_XMLCHAR(CHAR_DEREF(STRING_ELT(s_name, 0)));
193 xmlNodeSetName(node, name);
194
195 return(NULL_USER_OBJECT);
196 }
197
198
199 #if 0
200 int
201 removeNodeNamespace(xmlNodePtr node, xmlNsPtr p)
202 {
203 if(!p)
204 return(0);
205
206 if(!node->prev)
207 node->ns = p->next;
208 else
209 p->v->next = p->next;
210
211 return(1);
212 }
213 #endif
214
215 int
removeNodeNamespaceByName(xmlNodePtr node,const char * const id)216 removeNodeNamespaceByName(xmlNodePtr node, const char * const id)
217 {
218 xmlNsPtr p, prev;
219
220 if(!node->nsDef)
221 return(0);
222 prev = node->nsDef;
223 p = node->nsDef;
224 if(!(id[0] && !p->prefix) || (p->prefix && strcmp((const char *)p->prefix, id) == 0)) {
225 /*XXX Free or not */
226 if(node->ns == p)
227 node->ns = NULL;
228 node->nsDef = p->next;
229 return(1);
230 }
231
232 while(1) {
233 if((!id[0] && !p->prefix) || (p->prefix && strcmp((const char *)p->prefix, id) == 0)) {
234 prev->next = p->next;
235 if(node->ns == p)
236 node->ns = NULL;
237 return(1);
238 }
239 prev = p;
240 p = p->next;
241 }
242
243 return(0);
244 }
245
246 SEXP
R_replaceDummyNS(USER_OBJECT_ s_node,USER_OBJECT_ newNS,USER_OBJECT_ prefix)247 R_replaceDummyNS(USER_OBJECT_ s_node, USER_OBJECT_ newNS, USER_OBJECT_ prefix)
248 {
249 xmlNodePtr node;
250 if(TYPEOF(s_node) != EXTPTRSXP) {
251 Rf_error("non external pointer passed to R_replaceDummyNS");
252 }
253
254 node = (xmlNodePtr) R_ExternalPtrAddr(s_node);
255 removeNodeNamespaceByName(node, CHAR(STRING_ELT(prefix, 0)));
256
257 return(R_xmlSetNs(s_node, newNS, ScalarLogical(0)));
258 // return(newNS);
259 }
260
261
262 SEXP
RS_XML_removeAllNodeNamespaces(SEXP s_node)263 RS_XML_removeAllNodeNamespaces(SEXP s_node)
264 {
265 xmlNodePtr node = (xmlNodePtr) R_ExternalPtrAddr(s_node);
266 xmlNsPtr p, tmp;
267 int n = 0;
268
269 if(!node)
270 return(ScalarLogical(FALSE));
271
272 p = node->nsDef;
273 while(p) {
274 if(node->ns == p) {
275 node->ns = NULL;
276 }
277 tmp = p;
278 p = p->next;
279 if(0 && tmp->type)
280 xmlFreeNs(tmp);
281 n++;
282 }
283 node->nsDef = NULL;
284
285 return(ScalarInteger(n));
286 }
287
288 SEXP
RS_XML_removeNodeNamespaces(SEXP s_node,SEXP r_ns)289 RS_XML_removeNodeNamespaces(SEXP s_node, SEXP r_ns)
290 {
291 int i, n;
292 xmlNodePtr node = (xmlNodePtr) R_ExternalPtrAddr(s_node);
293 SEXP el, ans;
294 const char *prefix;
295 // xmlNsPtr p;
296 // int t = TYPEOF(r_ns);
297 n = Rf_length(r_ns);
298 PROTECT(ans = allocVector(LGLSXP, n));
299
300 for(i = 0; i < n; i++) {
301 el = VECTOR_ELT(r_ns, i);
302 if(TYPEOF(el) == STRSXP) {
303 prefix = CHAR(STRING_ELT(el, 0));
304 LOGICAL(ans)[i] = removeNodeNamespaceByName(node, prefix);
305 } else if(TYPEOF(el) == EXTPTRSXP) {
306 xmlNsPtr p = (xmlNsPtr) R_ExternalPtrAddr(el);
307 LOGICAL(ans)[i] = removeNodeNamespaceByName(node, (const char *)p->prefix);
308 }
309 }
310
311 UNPROTECT(1);
312 return(ans);
313 }
314
315
316 /*
317 attrs is a vector whose names identify
318 */
319 USER_OBJECT_
RS_XML_removeNodeAttributes(USER_OBJECT_ s_node,USER_OBJECT_ attrs,USER_OBJECT_ asNamespace)320 RS_XML_removeNodeAttributes(USER_OBJECT_ s_node, USER_OBJECT_ attrs, USER_OBJECT_ asNamespace)
321 {
322 int i, n;
323 USER_OBJECT_ attr_names, ans;
324 xmlNodePtr node = (xmlNodePtr) R_ExternalPtrAddr(s_node);
325
326 n = GET_LENGTH(attrs);
327 PROTECT(ans = NEW_LOGICAL(n));
328
329 attr_names = GET_NAMES(attrs);
330 for(i = 0; i < n; i++) {
331 if(TYPEOF(attrs) == INTSXP) {
332 int which = INTEGER(attrs)[i] - i - 1;
333 xmlAttrPtr p;
334 int j = 0;
335
336 p = node->properties;
337 while(j < which && p) {
338 p = p->next;
339 j++;
340 }
341 xmlUnsetNsProp(node, p->ns, p->name);
342 /*
343 if(p)
344 xmlFree(p);
345 */
346 } else if(LOGICAL(asNamespace)[0]) {
347 xmlNsPtr ns = NULL;
348 xmlChar *id;
349 id = CHAR_TO_XMLCHAR(CHAR_DEREF(STRING_ELT(attr_names, i)));
350 ns = (xmlNsPtr) R_ExternalPtrAddr(VECTOR_ELT(attrs, i));
351 if(id[0])
352 INTEGER(ans)[i] = xmlUnsetNsProp(node, ns, id);
353 } else
354 INTEGER(ans)[i] = xmlUnsetProp(node, CHAR_TO_XMLCHAR(CHAR_DEREF(STRING_ELT(attrs, i))));
355
356 }
357 UNPROTECT(1);
358
359 return(ans);
360 }
361
362 #define GET_R_XML_NODE_PTR(x) (xmlNodePtr) R_ExternalPtrAddr(s_node);
363
364
365 USER_OBJECT_
RS_XML_getNsList(USER_OBJECT_ s_node,USER_OBJECT_ asRef)366 RS_XML_getNsList(USER_OBJECT_ s_node, USER_OBJECT_ asRef)
367 {
368 xmlNodePtr node = GET_R_XML_NODE_PTR(s_node);
369 xmlNsPtr *els, el;
370 int n = 0, i;
371 USER_OBJECT_ ans, names;
372 DECL_ENCODING_FROM_NODE(node)
373
374 els = xmlGetNsList(node->doc, node);
375 if(!els)
376 return(NULL_USER_OBJECT);
377
378 el = *els;
379 while(el) {
380 n++;
381 el = el->next;
382 }
383 el = *els;
384
385 if(LOGICAL(asRef)[0]) {
386 PROTECT(ans = NEW_LIST(n));
387 PROTECT(names = NEW_CHARACTER(n));
388 for(i = 0; i < n ; i++, el = el->next) {
389 if(el->prefix)
390 SET_STRING_ELT(names, i, ENC_COPY_TO_USER_STRING(XMLCHAR_TO_CHAR(el->prefix)));
391 SET_VECTOR_ELT(ans, i, R_createXMLNsRef(el));
392 }
393 } else {
394
395 PROTECT(ans = NEW_CHARACTER(n));
396 PROTECT(names = NEW_CHARACTER(n));
397 for(i = 0; i < n ; i++, el = el->next) {
398 if(el->prefix)
399 SET_STRING_ELT(names, i, ENC_COPY_TO_USER_STRING(XMLCHAR_TO_CHAR(el->prefix)));
400 if(el->href)
401 SET_STRING_ELT(ans, i, ENC_COPY_TO_USER_STRING(XMLCHAR_TO_CHAR(el->href)));
402 }
403 }
404
405 SET_NAMES(ans, names);
406 UNPROTECT(2);
407 return(ans);
408 }
409
410 SEXP
R_removeInternalNode(SEXP r_node,SEXP r_free)411 R_removeInternalNode(SEXP r_node, SEXP r_free)
412 {
413 xmlNodePtr node;
414 int n = GET_LENGTH(r_node), i;
415
416 for(i = 0; i < n; i++) {
417 SEXP el = VECTOR_ELT(r_node, i);
418 if(TYPEOF(el) != EXTPTRSXP) {
419 Rf_error("removeInternalNode needs ans external pointer object");
420 }
421
422 node = (xmlNodePtr) R_ExternalPtrAddr(el);
423 if(!node) {
424 Rf_warning("removeInternalNode ignoring a NULL external pointer object");
425 }
426 xmlUnlinkNode(node);
427
428 if(LOGICAL(r_free)[i])
429 xmlFreeNode(node);
430 }
431
432 return(NULL_USER_OBJECT);
433 }
434
435 SEXP
RS_XML_setRootNode(USER_OBJECT_ r_doc,USER_OBJECT_ r_node)436 RS_XML_setRootNode(USER_OBJECT_ r_doc, USER_OBJECT_ r_node)
437 {
438 xmlDocPtr doc;
439 xmlNodePtr node;
440
441 doc = (xmlDocPtr) R_ExternalPtrAddr(r_doc);
442 node = (xmlNodePtr) R_ExternalPtrAddr(r_node);
443
444 /* Set the reference counting information. */
445 //if(!node->doc)
446 // node->doc = doc;
447 xmlDocSetRootElement(doc, node);
448
449 return(ScalarLogical(TRUE));
450 }
451
452 SEXP
R_isNodeChildOfAt(SEXP rkid,SEXP rnode,SEXP rat)453 R_isNodeChildOfAt(SEXP rkid, SEXP rnode, SEXP rat)
454 {
455 int i=0, at;
456 xmlNodePtr kid, node, ptr;
457 node = (xmlNodePtr) R_ExternalPtrAddr(rnode);
458 kid = (xmlNodePtr) R_ExternalPtrAddr(rkid);
459
460 if(!node || !kid || !kid->parent)
461 return(ScalarLogical(FALSE));
462
463 at = INTEGER(rat)[0] - 1;
464 ptr = node->children;
465 while(i < at && ptr) {
466 ptr = ptr->next;
467 i++;
468 }
469 return(ScalarLogical(ptr == kid));
470 }
471
472
473 /**
474 Add the internal XML node represented by the S object @node
475 as a child of the XML node represented by the S object @parent.
476 */
477 USER_OBJECT_
R_insertXMLNode(USER_OBJECT_ node,USER_OBJECT_ parent,USER_OBJECT_ at,USER_OBJECT_ shallow)478 R_insertXMLNode(USER_OBJECT_ node, USER_OBJECT_ parent, USER_OBJECT_ at, USER_OBJECT_ shallow)
479 {
480 // check is currently set but unused.
481 xmlNodePtr n, p, /*check,*/ tmp = NULL;
482
483 if(TYPEOF(parent) != EXTPTRSXP) {
484 Rf_error("R_insertXMLNode expects XMLInternalNode objects for the parent node");
485 }
486
487 if(IS_LIST(node)) {
488 int i;
489 for(i = 0; i < GET_LENGTH(node); i++)
490 R_insertXMLNode(VECTOR_ELT(node, i), parent, R_NilValue/*XXX*/, shallow);
491
492 return(NULL_USER_OBJECT);
493 }
494
495
496 if(TYPEOF(node) == STRSXP) {
497 int i;
498 p = (xmlNodePtr) R_ExternalPtrAddr(parent);
499 for(i = 0; i < GET_LENGTH(node); i++) {
500 n = xmlNewText((const xmlChar *)CHAR(STRING_ELT(node, i)));
501 xmlAddChild(p, n);
502 }
503 return(NULL_USER_OBJECT);
504 }
505
506 if(TYPEOF(node) != EXTPTRSXP) {
507 Rf_error("R_insertXMLNode expects XMLInternalNode objects");
508 }
509
510 p = (xmlNodePtr) R_ExternalPtrAddr(parent);
511 n = (xmlNodePtr) R_ExternalPtrAddr(node);
512
513 if(!p || !n) {
514 Rf_error("either the parent or child node is NULL");
515 }
516
517 #if 0
518 if(0 && n->parent == p || n->parent) {
519 /*XX Need to decrement the reference count if there is a document. */
520 xmlUnlinkNode(n);
521 }
522 #endif
523
524 /* Make certain the nodes belong to this document if they already belong to another by copying. */
525 if(n->doc && n->doc != p->doc) {
526 n = xmlDocCopyNode(n, p->doc, 1);
527 } else if(!n->doc && LOGICAL(shallow)[0]) {
528 /* XXX This is intended to avoid setting all the nodes to this document and then having to undo that
529 later on.*/
530 n->doc = p->doc;
531 }
532
533
534
535 switch(p->type) {
536 case XML_ELEMENT_NODE:
537 /* Need to be careful that if n is a text node, it could be
538 * absorbed into its nearest sibling and then freed. So we
539 take a copy of the text node*/
540 if(n->type == XML_TEXT_NODE) {
541 tmp = xmlNewText(n->content);
542 /* tmp = xmlCopyNode(n, 1); */
543 } else {
544 tmp = n;
545
546 if(n->_private) {
547 #ifdef R_XML_DEBUG
548 fprintf(stderr, "insertXMLNode: %p to %p, incrementing document (%p) %d\n", n, p, p->doc, *(int *) n->_private);
549 #endif
550 if(p->doc)
551 incrementDocRefBy(p->doc, getNodeCount(n));
552 }
553 }
554 /* check = */ xmlAddChild(p, tmp);
555
556 #if 0
557 /* XXXX */
558 if(n->type == XML_TEXT_NODE && check != tmp)
559 xmlFreeNode(tmp);
560 #endif
561 break;
562 case XML_DOCUMENT_NODE:
563 case XML_HTML_DOCUMENT_NODE:
564 /*check = */ xmlAddChild(p, n);
565 incrementDocRef((xmlDocPtr) p);
566 break;
567 case XML_PI_NODE:
568 xmlAddSibling(p, n);
569 break;
570 default:
571 {
572 Rf_warning("ignoring request to add child (types parent: %d, child %d)",
573 p->type, n->type);
574 }
575 break;
576 }
577
578 #if 0
579 /* This is where we handle the case where n being a text node may
580 * have been freed by xmlAddChild. */
581 if(check != n) {
582 fprintf(stderr, "xmlAddChild() may have freed the node\n");fflush(stderr);
583 R_ClearExternalPtr(node);
584 }
585 #endif
586
587
588 /* ??? internal_incrementNodeRefCount(n); */
589
590 return(NULL_USER_OBJECT);
591 }
592
593 USER_OBJECT_
RS_XML_xmlAddSiblingAt(USER_OBJECT_ r_to,USER_OBJECT_ r_node,USER_OBJECT_ r_after,USER_OBJECT_ manageMemory)594 RS_XML_xmlAddSiblingAt(USER_OBJECT_ r_to, USER_OBJECT_ r_node, USER_OBJECT_ r_after, USER_OBJECT_ manageMemory)
595 {
596 xmlNodePtr p, n, ans;
597
598 xmlNodePtr (*f)(xmlNodePtr, xmlNodePtr);
599
600 if(TYPEOF(r_to) != EXTPTRSXP) {
601 Rf_error("RS_XML_xmlAddSiblingAt expects XMLInternalNode objects for the parent node");
602 }
603
604 if(TYPEOF(r_node) != EXTPTRSXP) {
605 Rf_error("RS_XML_xmlAddSiblingAt expects XMLInternalNode objects for the node to add");
606 }
607
608 p = (xmlNodePtr) R_ExternalPtrAddr(r_to);
609 n = (xmlNodePtr) R_ExternalPtrAddr(r_node);
610
611 if(!p || !n) {
612 Rf_error("either the parent or child node is NULL");
613 }
614
615 f = LOGICAL(r_after)[0] ? xmlAddNextSibling : xmlAddPrevSibling ;
616 ans = f(p, n);
617
618 /* If adding to the root node and inserting a node before the
619 * current first child, update the document.*/
620 if(p->doc && p->doc->children == p && n->next == p)
621 p->doc->children = n;
622
623 incrementDocRefBy(p->doc, getNodeCount(n));
624 return(R_createXMLNodeRef(ans, manageMemory));
625 }
626
627 USER_OBJECT_
RS_XML_replaceXMLNode(USER_OBJECT_ r_old,USER_OBJECT_ r_new,USER_OBJECT_ manageMemory)628 RS_XML_replaceXMLNode(USER_OBJECT_ r_old, USER_OBJECT_ r_new, USER_OBJECT_ manageMemory)
629 {
630 xmlNodePtr Old, New, ans;
631
632 if(TYPEOF(r_old) != EXTPTRSXP && TYPEOF(r_new) != EXTPTRSXP) {
633 Rf_error("R_replaceXMLNode expects XMLInternalNode objects");
634 }
635 Old = (xmlNodePtr) R_ExternalPtrAddr(r_old);
636 New = (xmlNodePtr) R_ExternalPtrAddr(r_new);
637
638 if(!Old) {
639 Rf_error("NULL value for XML node to replace");
640 }
641
642 ans = xmlReplaceNode(Old, New);
643 return(R_createXMLNodeRef(ans, manageMemory));
644 }
645
646
647 /*
648 a = newXMLNode("a", newXMLNode("b", newXMLNode("c", 3)), newXMLNode("d", "text"))
649 removeChildren(a, 2)
650 */
651 USER_OBJECT_
RS_XML_removeChildren(USER_OBJECT_ s_node,USER_OBJECT_ kids,USER_OBJECT_ freeNode)652 RS_XML_removeChildren(USER_OBJECT_ s_node, USER_OBJECT_ kids, USER_OBJECT_ freeNode)
653 {
654 int i, n;
655 USER_OBJECT_ ans;
656 xmlNodePtr node = NULL, tmp;
657 if(GET_LENGTH(s_node)) {
658 node = (xmlNodePtr) R_ExternalPtrAddr(s_node);
659
660 if(!node) {
661 Rf_error("Empty XMLInternalNode");
662 }
663 }
664
665 n = GET_LENGTH(kids);
666 PROTECT(ans = NEW_LOGICAL(n));
667 for(i = 0; i < n; i++) {
668 tmp = (xmlNodePtr) R_ExternalPtrAddr(VECTOR_ELT(kids, i));
669 if(!tmp)
670 continue;
671 if(node && tmp->parent != node) {
672 Rf_error("trying to remove a child node from a different parent node");
673 }
674
675 xmlUnlinkNode(tmp);
676 if(LOGICAL(freeNode)[0])
677 xmlFreeNode(tmp);
678 LOGICAL(ans)[i] = TRUE;
679 }
680 UNPROTECT(1);
681
682 return(ans);
683 }
684
685 USER_OBJECT_
R_xmlRootNode(USER_OBJECT_ sdoc,USER_OBJECT_ skipDtd,USER_OBJECT_ manageMemory)686 R_xmlRootNode(USER_OBJECT_ sdoc, USER_OBJECT_ skipDtd, USER_OBJECT_ manageMemory)
687 {
688 xmlDocPtr doc = (xmlDocPtr) R_ExternalPtrAddr(sdoc);
689 xmlNodePtr node = NULL;
690
691 if(doc)
692 node = doc->children;
693
694 if(!node) {
695 Rf_warning("empty XML document");
696 return(NULL_USER_OBJECT);
697 }
698
699 if(LOGICAL(skipDtd)[0]) {
700 while(node && node->type != XML_ELEMENT_NODE /* (node->type == XML_DTD_NODE || node->type == XML_COMMENT_NODE) */) {
701 node = node->next;
702 }
703 }
704
705 if(node == NULL)
706 return(NULL_USER_OBJECT);
707
708
709 return(R_createXMLNodeRef(node, manageMemory));
710 }
711
712
713 /**
714 Create an S object representing a newly created internal
715 XML document object.
716 */
717
718 int R_numXMLDocs = 0;
719 int R_numXMLDocsFreed = 0;
720
721 USER_OBJECT_
R_newXMLDoc(USER_OBJECT_ dtd,USER_OBJECT_ namespaces,USER_OBJECT_ isHTML)722 R_newXMLDoc(USER_OBJECT_ dtd, USER_OBJECT_ namespaces, USER_OBJECT_ isHTML)
723 {
724 xmlDocPtr doc;
725 if(LOGICAL(isHTML)[0]) {
726 const char *d = (TYPEOF(dtd) == STRSXP && Rf_length(dtd)) ?
727 CHAR_DEREF(STRING_ELT(dtd, 0)) : NULL;
728 if(d[0] == '5')
729 doc = htmlNewDoc((const xmlChar *)"", NULL);
730 else
731 doc = htmlNewDocNoDtD(d && d[0] ? CHAR_TO_XMLCHAR(d) : NULL, NULL);
732
733 } else
734 doc = xmlNewDoc(CHAR_TO_XMLCHAR("1.0"));
735
736 R_numXMLDocs++;
737
738 return(R_createXMLDocRef(doc));
739 }
740
741
742
743
744 USER_OBJECT_
R_newXMLDtd(USER_OBJECT_ sdoc,USER_OBJECT_ sdtdName,USER_OBJECT_ sexternalID,USER_OBJECT_ ssysID,USER_OBJECT_ manageMemory)745 R_newXMLDtd(USER_OBJECT_ sdoc, USER_OBJECT_ sdtdName, USER_OBJECT_ sexternalID, USER_OBJECT_ ssysID, USER_OBJECT_ manageMemory)
746 {
747
748 xmlDocPtr doc = NULL;
749 xmlChar *dtdName = NULL;
750 xmlChar *externalID = NULL;
751 xmlChar *sysID = NULL;
752 xmlDtdPtr node;
753
754 #define GET_STR_VAL(x) \
755 if(GET_LENGTH(s##x) > 0) { \
756 x = CHAR_TO_XMLCHAR(CHAR_DEREF(STRING_ELT(s##x, 0))); \
757 if(!x[0]) \
758 x = NULL; \
759 }
760
761 GET_STR_VAL(dtdName)
762 GET_STR_VAL(externalID)
763 GET_STR_VAL(sysID)
764
765 if(sdoc != NULL_USER_OBJECT && TYPEOF(sdoc) == EXTPTRSXP)
766 doc = (xmlDocPtr) R_ExternalPtrAddr(sdoc);
767
768 node = xmlNewDtd(doc, dtdName, externalID, sysID);
769
770
771 /* should we do this???
772 xmlAddChild((xmlNodePtr) doc, (xmlNodePtr) DTD);
773 */
774 return(R_createXMLNodeRef((xmlNodePtr) node, manageMemory));
775 }
776
777
778 /*
779
780 */
781 USER_OBJECT_
R_xmlSetNs(USER_OBJECT_ s_node,USER_OBJECT_ s_ns,USER_OBJECT_ append)782 R_xmlSetNs(USER_OBJECT_ s_node, USER_OBJECT_ s_ns, USER_OBJECT_ append)
783 {
784 xmlNodePtr node = (xmlNodePtr) R_ExternalPtrAddr(s_node);
785 xmlNsPtr ns = NULL;
786 if(s_ns != NULL_USER_OBJECT)
787 ns = (xmlNsPtr) R_ExternalPtrAddr(s_ns);
788
789 if(LOGICAL(append)[0]) {
790 xmlNsPtr el;
791 if(!node->ns)
792 xmlSetNs(node, xmlNewNs(node, NULL, NULL));
793 el = node->ns;
794 while(el->next)
795 el = el->next;
796 el->next = ns;
797 } else
798 xmlSetNs(node, ns);
799
800 return(s_ns);
801 }
802
803 #if 0
804 /* remove if the above is sufficient. */
805 SEXP
806 RS_XML_setNS(SEXP s_node, SEXP r_ns)
807 {
808 xmlNodePtr node = (xmlNodePtr) R_ExternalPtrAddr(s_node);
809 xmlNsPtr ns = (xmlNsPtr) R_ExternalPtrAddr(r_ns);
810 xmlSetNS(node, ns);
811 return(NULL_USER_OBJECT);
812 }
813 #endif
814
815
816 static const char *DummyNamespaceHREF = "<dummy>";
817
818 USER_OBJECT_
R_xmlNewNs(USER_OBJECT_ sdoc,USER_OBJECT_ shref,USER_OBJECT_ sprefix)819 R_xmlNewNs(USER_OBJECT_ sdoc, USER_OBJECT_ shref, USER_OBJECT_ sprefix)
820 {
821 xmlNodePtr doc = (xmlNodePtr) R_ExternalPtrAddr(sdoc);
822 const char *href = Rf_length(shref) == 0 ? DummyNamespaceHREF : CHAR_DEREF(STRING_ELT(shref, 0));
823 const char *prefix = NULL;
824 xmlNsPtr ns;
825
826 if(Rf_length(sprefix)) {
827 prefix = CHAR_DEREF(STRING_ELT(sprefix, 0));
828 if(!prefix[0])
829 prefix = NULL;
830 }
831
832 if(!href[0])
833 href = NULL;
834
835 ns = xmlNewNs(doc, CHAR_TO_XMLCHAR(href), CHAR_TO_XMLCHAR(prefix));
836
837 return(R_createXMLNsRef(ns)); /*XXX */
838 }
839
840
841 USER_OBJECT_
RS_XML_clone(USER_OBJECT_ obj,USER_OBJECT_ recursive,USER_OBJECT_ manageMemory)842 RS_XML_clone(USER_OBJECT_ obj, USER_OBJECT_ recursive, USER_OBJECT_ manageMemory)
843 {
844 if(TYPEOF(obj) != EXTPTRSXP) {
845 Rf_error( "clone can only be applied to an internal, C-level libxml2 object");
846 }
847
848 if(!R_ExternalPtrAddr(obj)) {
849 Rf_error( "NULL value passed to clone, possibly from a previous session");
850 }
851
852 if(R_isInstanceOf(obj, "XMLInternalElementNode")) {
853 xmlNodePtr node, node_ans;
854 node = (xmlNodePtr) R_ExternalPtrAddr(obj);
855 node_ans = xmlCopyNode(node, INTEGER(recursive)[0]);
856 return(R_createXMLNodeRef(node_ans, manageMemory));
857 } else if(R_isInstanceOf(obj, "XMLInternalDocument") || R_isInstanceOf(obj, "XMLInternalDOM")) {
858 xmlDocPtr doc;
859 doc = (xmlDocPtr) R_ExternalPtrAddr(obj);
860 return(R_createXMLDocRef(xmlCopyDoc(doc, INTEGER(recursive)[0]))); // , manageMemory));
861 }
862
863 Rf_error("clone doesn't (yet) understand this internal data type");
864
865 return(NULL_USER_OBJECT); /* never reached */
866 }
867
868 #ifdef R_XML_DEBUG
869 xmlDocPtr currentDoc;
870 #endif
871
872
873 USER_OBJECT_
R_createXMLDocRef(xmlDocPtr doc)874 R_createXMLDocRef(xmlDocPtr doc)
875 {
876 SEXP ref, tmp;
877
878 #ifdef R_XML_DEBUG
879 currentDoc = doc;
880 #endif
881
882 if(!doc)
883 return(R_NilValue);
884
885 initDocRefCounter(doc);
886 incrementDocRef(doc);
887
888 #ifdef R_XML_DEBUG
889 fprintf(stderr, "creating document reference %s %p, count = %d\n",
890 doc->URL ? doc->URL : "internally created", doc,
891 * ((int*) doc->_private));
892 #endif
893
894 PROTECT(ref = R_MakeExternalPtr(doc, Rf_install("XMLInternalDocument"), R_NilValue));
895 PROTECT(tmp = NEW_CHARACTER(1));
896 SET_STRING_ELT(tmp, 0, mkChar( doc->type == XML_HTML_DOCUMENT_NODE ? "HTMLInternalDocument" : "XMLInternalDocument"));
897 SET_CLASS(ref, tmp);
898 UNPROTECT(2);
899 return(ref);
900 }
901
902 USER_OBJECT_
R_removeXMLNsRef(xmlNsPtr ns)903 R_removeXMLNsRef(xmlNsPtr ns)
904 {
905 /*XXX xmlNsPtr p = (xmlNsPtr) R_ExternalPtrAddr(); */
906 Rf_error("C routine R_removeXMLNsRef() not implemented yet");
907 return(R_NilValue);
908 }
909
910 USER_OBJECT_
R_createXMLNsRef(xmlNsPtr ns)911 R_createXMLNsRef(xmlNsPtr ns)
912 {
913 SEXP ref, tmp;
914
915 PROTECT(ref = R_MakeExternalPtr(ns, Rf_install("XMLNamespaceRef"), R_NilValue));
916 PROTECT(tmp = NEW_CHARACTER(1));
917 SET_STRING_ELT(tmp, 0, mkChar("XMLNamespaceRef"));
918 SET_CLASS(ref, tmp);
919 UNPROTECT(2);
920 return(ref);
921 }
922
923 USER_OBJECT_
R_convertXMLNsRef(SEXP r_ns)924 R_convertXMLNsRef(SEXP r_ns)
925 {
926 SEXP ans;
927 xmlNsPtr ns;
928
929 if(TYPEOF(r_ns) != EXTPTRSXP) {
930 Rf_error("wrong type for namespace reference");
931 }
932
933 ns = (xmlNsPtr) R_ExternalPtrAddr(r_ns);
934
935 PROTECT(ans = mkString((const char *)ns->href));
936 SET_NAMES(ans, mkString(ns->prefix ? XMLCHAR_TO_CHAR(ns->prefix) : ""));
937
938 UNPROTECT(1);
939
940 return(ans);
941 }
942
943 USER_OBJECT_
R_getXMLNsRef(USER_OBJECT_ r_node)944 R_getXMLNsRef(USER_OBJECT_ r_node)
945 {
946 xmlNodePtr node = (xmlNodePtr) R_ExternalPtrAddr(r_node);
947
948 if(!node)
949 return(R_NilValue);
950
951 return(node->ns ? R_createXMLNsRef(node->ns) : R_NilValue);
952 }
953
954
955 const char *
R_getInternalNodeClass(xmlElementType type)956 R_getInternalNodeClass(xmlElementType type)
957 {
958 const char * p = "";
959 switch(type) {
960 case XML_ELEMENT_NODE:
961 p = "XMLInternalElementNode";
962 break;
963 case XML_ELEMENT_DECL:
964 p = "XMLInternalElementDeclNode";
965 break;
966 case XML_TEXT_NODE:
967 p = "XMLInternalTextNode";
968 break;
969 case XML_CDATA_SECTION_NODE:
970 p = "XMLInternalCDataNode";
971 break;
972 case XML_ENTITY_NODE:
973 p = "XMLInternalEntityNode";
974 break;
975 case XML_ENTITY_REF_NODE:
976 p = "XMLInternalEntityRefNode";
977 break;
978 case XML_PI_NODE:
979 p = "XMLInternalPINode";
980 break;
981 case XML_COMMENT_NODE:
982 p = "XMLInternalCommentNode";
983 break;
984 case XML_NOTATION_NODE:
985 p = "XMLInternalNotationNode";
986 break;
987 case XML_DTD_NODE:
988 p = "XMLDTDNode";
989 break;
990 case XML_NAMESPACE_DECL:
991 p = "XMLNamespaceDeclaration";
992 break;
993 case XML_XINCLUDE_START:
994 p = "XMLXIncludeStartNode";
995 break;
996 case XML_XINCLUDE_END:
997 p = "XMLXIncludeEndNode";
998 break;
999 case XML_ENTITY_DECL:
1000 p = "XMLInternalEntityRefNode";
1001 break;
1002 case XML_ATTRIBUTE_DECL:
1003 p = "XMLAttributeDeclNode";
1004 break;
1005 case XML_DOCUMENT_NODE:
1006 p = "XMLDocumentNode";
1007 break;
1008 case XML_HTML_DOCUMENT_NODE:
1009 p = "XMLHTMLDocumentNode";
1010 break;
1011 case XML_DOCUMENT_TYPE_NODE:
1012 p = "XMLDocumentTypeNode";
1013 break;
1014 case XML_DOCUMENT_FRAG_NODE:
1015 p = "XMLDocumentFragNode";
1016 break;
1017 case XML_ATTRIBUTE_NODE:
1018 p = "XMLAttributeNode";
1019 break;
1020 default:
1021 p = "XMLUnknownInternalNode";
1022 }
1023
1024 return(p);
1025 }
1026
1027
1028
1029 SEXP
R_createXMLNodeRefDirect(xmlNodePtr node,int addFinalizer)1030 R_createXMLNodeRefDirect(xmlNodePtr node, int addFinalizer)
1031 {
1032 SEXP ref, tmp;
1033
1034 PROTECT(ref = R_MakeExternalPtr(node, Rf_install("XMLInternalNode"), R_NilValue));
1035
1036 #ifdef XML_REF_COUNT_NODES
1037
1038 if(addFinalizer > 0 || (addFinalizer < 0 && !IS_NOT_OUR_NODE_TO_TOUCH(node))) {
1039 #ifdef R_XML_DEBUG
1040 fprintf(stderr, "Creating reference with finalizer for %s (%p) '%s'\n",
1041 node->name, node, node->type == XML_TEXT_NODE ? node->content : "");fflush(stderr);
1042 #endif
1043 R_RegisterCFinalizer(ref, decrementNodeRefCount);
1044 }
1045 /*
1046 #else
1047 #warning "no ref counting enabled"
1048 */
1049 #endif
1050 PROTECT(tmp = NEW_CHARACTER(3));
1051 SET_STRING_ELT(tmp, 0, mkChar(R_getInternalNodeClass(node->type)));
1052 SET_STRING_ELT(tmp, 1, mkChar("XMLInternalNode"));
1053 SET_STRING_ELT(tmp, 2, mkChar("XMLAbstractNode"));
1054 SET_CLASS(ref, tmp);
1055 UNPROTECT(2);
1056 return(ref);
1057 }
1058
1059
1060
1061
1062 /**
1063 Used to be used as
1064 R_XML_getManageMemory(manageMemory, node->doc, node) > 0 ? R_createXMLNodeRef() : R_createXMLNodeRefDirect(node, 0));
1065 */
1066 USER_OBJECT_
R_createXMLNodeRef(xmlNodePtr node,USER_OBJECT_ finalize)1067 R_createXMLNodeRef(xmlNodePtr node, USER_OBJECT_ finalize)
1068 {
1069 int *val;
1070 int addFinalizer = 0;
1071
1072 if(!node)
1073 return(NULL_USER_OBJECT);
1074
1075
1076 addFinalizer = R_XML_getManageMemory(finalize, node->doc, node);
1077
1078 /* !IS_NOT_OUR_NODE_TO_TOUCH(node) */
1079 if(addFinalizer && ((node->_private && ((int*)node->_private)[1] == (int) R_MEMORY_MANAGER_MARKER)
1080 || !node->doc || (!(IS_NOT_OUR_DOC_TO_TOUCH(node->doc))))) {
1081 if(node->_private == NULL) {
1082 node->_private = calloc(2, sizeof(int));
1083 val = (int *) node->_private;
1084 val[1] = R_MEMORY_MANAGER_MARKER;
1085 }
1086
1087 val = (int *) node->_private;
1088 (*val)++;
1089 if(*val == 1)
1090 incrementDocRef(node->doc);
1091 #ifdef R_XML_DEBUG
1092 fprintf(stderr, "creating reference to node (%s, %d) count = %d (%p) (doc = %p count = %d)\n", node->name, node->type, (int) *val, node, node->doc, (node->doc && node->doc->_private) ? ((int *)node->doc->_private)[0] : -1);
1093 #endif
1094 }
1095
1096 return(R_createXMLNodeRefDirect(node, addFinalizer /* !IS_NOT_OUR_NODE_TO_TOUCH(node) */ ));
1097 }
1098
1099
1100 /*
1101 May not be used. Not yet.
1102 The idea is to allow the R user to explicitly add a finalizer, like
1103 we do for a document.
1104 */
1105 SEXP
R_addXMLNodeFinalizer(SEXP r_node)1106 R_addXMLNodeFinalizer(SEXP r_node)
1107 {
1108 #ifdef XML_REF_COUNT_NODES /* ??? should this be ifndef or ifdef.?? */
1109 // xmlNodePtr node = (xmlNodePtr) R_ExternalPtrAddr(r_node);
1110 R_RegisterCFinalizer(r_node, decrementNodeRefCount);
1111 #endif
1112 return(r_node);
1113 }
1114
1115
1116 #define ValOrNULL(x) CHAR_TO_XMLCHAR ((x && x[0] ? x : NULL))
1117
1118
1119
1120 /**
1121 Write the XML tree/DOM to a file or into a buffer (depending on the value
1122 of sfileName)
1123
1124 It would be nice to use connections, but this is not yet possible
1125 in full generality. Later
1126
1127 @sdoc: the S object that is a reference to the top-level XML DOM.
1128 @sfileName: the S object that gives the name of the file to which the
1129 DOM should be written or alternatively, the S value `NULL' indicating
1130 that the DOM should be dumped to a buffer and returned as an S string.
1131 @compression: if @sfileName is the name of a file and we are not
1132 returning the DOM as a string, then we set the compression level
1133 to the value of this integer, unless it is omitted and specified as
1134 the S value `NULL'.
1135 */
1136 USER_OBJECT_
R_saveXMLDOM(USER_OBJECT_ sdoc,USER_OBJECT_ sfileName,USER_OBJECT_ compression,USER_OBJECT_ sindent,USER_OBJECT_ prefix,USER_OBJECT_ r_encoding)1137 R_saveXMLDOM(USER_OBJECT_ sdoc, USER_OBJECT_ sfileName, USER_OBJECT_ compression, USER_OBJECT_ sindent,
1138 USER_OBJECT_ prefix, USER_OBJECT_ r_encoding)
1139 {
1140 xmlDocPtr doc;
1141 const char *fileName = NULL;
1142 USER_OBJECT_ ans = NULL_USER_OBJECT;
1143 xmlDtdPtr dtd = NULL;
1144
1145 int oldIndent = xmlIndentTreeOutput;
1146 const char *encoding = CHAR_DEREF(STRING_ELT(r_encoding, 0));
1147
1148 if(TYPEOF(sdoc) != EXTPTRSXP) {
1149 Rf_error("document passed to R_saveXMLDOM is not an external pointer");
1150 }
1151
1152 doc = (xmlDocPtr) R_ExternalPtrAddr(sdoc);
1153
1154 if(doc == NULL)
1155 return(NEW_CHARACTER(0));
1156
1157 xmlIndentTreeOutput = LOGICAL_DATA(sindent)[0];
1158
1159 if(GET_LENGTH(prefix) == 3) {
1160 dtd = xmlNewDtd(doc, ValOrNULL(CHAR_DEREF(STRING_ELT(prefix, 0))),
1161 ValOrNULL(CHAR_DEREF(STRING_ELT(prefix, 1))),
1162 ValOrNULL(CHAR_DEREF(STRING_ELT(prefix, 2))));
1163 dtd->parent = doc;
1164 dtd->doc = doc;
1165
1166 dtd->prev = doc->children->prev;
1167 dtd->next = doc->children;
1168 doc->children->prev = (xmlNodePtr) dtd;
1169
1170 doc->children = (xmlNodePtr) dtd;
1171 }
1172
1173
1174 /* Figure out what the name of the file is, or if it is NULL. */
1175 if(GET_LENGTH(sfileName))
1176 fileName = CHAR_DEREF(STRING_ELT(sfileName, 0));
1177
1178 /* If the user specified a file name, write to it and honor
1179 the compression setting they supplied.
1180 */
1181 if(fileName && fileName[0]) {
1182 int compressionLevel = -1;
1183 if(GET_LENGTH(compression)) {
1184 compressionLevel = xmlGetDocCompressMode(doc);
1185 xmlSetDocCompressMode(doc, INTEGER_DATA(compression)[0]);
1186 }
1187 if(encoding && encoding[0])
1188 // xmlSaveFileEnc doesn't indent. So use xmlSaveFormatFileEnc(). Issue identified by Earl Brown.
1189 // xmlSaveFileEnc(CHAR_DEREF(STRING_ELT(sfileName, 0)), doc, encoding);
1190 xmlSaveFormatFileEnc(CHAR_DEREF(STRING_ELT(sfileName, 0)), doc, encoding, LOGICAL_DATA(sindent)[0]);
1191 #if 0
1192 else
1193 xmlSaveFile(CHAR_DEREF(STRING_ELT(sfileName, 0)), doc);
1194 #else
1195 else {
1196 FILE *f;
1197 f = fopen(CHAR_DEREF(STRING_ELT(sfileName, 0)), "w");
1198 if(!f) {
1199 Rf_error("cannot create file %s. Check the directory exists and permissions are appropriate", CHAR_DEREF(STRING_ELT(sfileName, 0)) );
1200 }
1201 xmlDocFormatDump(f, doc, 1);
1202 fclose(f);
1203 }
1204 #endif
1205 if(compressionLevel != -1) {
1206 xmlSetDocCompressMode(doc, compressionLevel);
1207 }
1208 } else {
1209 /* So we are writing to a buffer and returning the DOM as an S string. */
1210 xmlChar *mem;
1211 int size;
1212 /*??? Do we need to allocate this memory? */
1213 PROTECT(ans = NEW_CHARACTER(1));
1214 if(encoding && encoding[0])
1215 xmlDocDumpFormatMemoryEnc(doc, &mem, &size, encoding, LOGICAL_DATA(sindent)[0]);
1216 else {
1217 xmlDocDumpFormatMemory(doc, &mem, &size, 1);
1218 /* xmlDocDumpMemory(doc, &mem, &size); original */
1219 }
1220
1221
1222 if(dtd) {
1223 xmlNodePtr tmp;
1224 doc->extSubset = NULL;
1225 tmp = doc->children->next;
1226 tmp->prev = NULL;
1227 doc->children = tmp;
1228 xmlFreeDtd(dtd);
1229 }
1230
1231 if(mem) {
1232 DECL_ENCODING_FROM_DOC(doc)
1233 SET_STRING_ELT(ans, 0, ENC_COPY_TO_USER_STRING(XMLCHAR_TO_CHAR(mem)));
1234 xmlFree(mem);
1235 } else {
1236 /*XXX get the error message from libxml2 */
1237 Rf_error("failed to write XML document contents");
1238 }
1239 UNPROTECT(1);
1240
1241 return(ans);
1242 }
1243
1244 xmlIndentTreeOutput = oldIndent;
1245 return(ans);
1246 }
1247
1248
1249 USER_OBJECT_
RS_XML_setDoc(USER_OBJECT_ snode,USER_OBJECT_ sdoc)1250 RS_XML_setDoc(USER_OBJECT_ snode, USER_OBJECT_ sdoc)
1251 {
1252 /*Might use xmlCopyNode or xmlCopyNodeList if we have to make a copy*/
1253 xmlDocPtr doc;
1254 xmlNodePtr node = (xmlNodePtr) R_ExternalPtrAddr(snode);
1255
1256 if(sdoc != NULL_USER_OBJECT) {
1257 doc = (xmlDocPtr) R_ExternalPtrAddr(sdoc);
1258 } else {
1259 doc = xmlNewDoc(CHAR_TO_XMLCHAR("1.0"));
1260 R_numXMLDocs++;
1261 }
1262
1263 xmlDocSetRootElement(doc, node);
1264 return(R_createXMLDocRef(doc));
1265 }
1266
1267 #if 0
1268 void
1269 RS_XML_recursive_unsetDoc(xmlNodePtr node)
1270 {
1271 xmlNodePtr tmp;
1272 node->doc = NULL;
1273 tmp = node->children;
1274 while(tmp) {
1275 RS_XML_recursive_unsetDoc(tmp);
1276 tmp = tmp->next;
1277 }
1278 }
1279 #endif
1280
1281 /* The following two routines are from Paul Murrell.
1282 They fix a problem with xpathApply() changing the document
1283 presumably when doing an XPath query on a node within a document.
1284 The old version didn't deal with the properties on the node.
1285 */
1286 void
RS_XML_recursive_unsetTreeDoc(xmlNodePtr node)1287 RS_XML_recursive_unsetTreeDoc(xmlNodePtr node) {
1288 xmlAttrPtr prop;
1289
1290 if (node == NULL)
1291 return;
1292 if(node->type == XML_ELEMENT_NODE) {
1293 prop = node->properties;
1294 while (prop != NULL) {
1295 prop->doc = NULL;
1296 RS_XML_recursive_unsetListDoc(prop->children);
1297 prop = prop->next;
1298 }
1299 }
1300 if (node->children != NULL)
1301 RS_XML_recursive_unsetListDoc(node->children);
1302 node->doc = NULL;
1303 }
1304
1305 void
RS_XML_recursive_unsetListDoc(xmlNodePtr list)1306 RS_XML_recursive_unsetListDoc(xmlNodePtr list) {
1307 xmlNodePtr cur;
1308
1309 if (list == NULL)
1310 return;
1311 cur = list;
1312 while (cur != NULL) {
1313 RS_XML_recursive_unsetTreeDoc(cur);
1314 cur = cur->next;
1315 }
1316 }
1317
1318 USER_OBJECT_
RS_XML_unsetDoc(USER_OBJECT_ snode,USER_OBJECT_ unlink,USER_OBJECT_ r_parent,USER_OBJECT_ recursive)1319 RS_XML_unsetDoc(USER_OBJECT_ snode, USER_OBJECT_ unlink, USER_OBJECT_ r_parent, USER_OBJECT_ recursive)
1320 {
1321 xmlNodePtr node = (xmlNodePtr) R_ExternalPtrAddr(snode);
1322 if(!node) {
1323 return(NULL_USER_OBJECT);
1324 }
1325
1326 if(node->doc && node->doc->children == node) {
1327 xmlDocSetRootElement(node->doc, NULL);
1328 }
1329
1330 if(LOGICAL(unlink)[0])
1331 xmlUnlinkNode(node);
1332
1333
1334 node->doc = NULL;
1335 node->parent = NULL;
1336
1337 if(r_parent != R_NilValue) {
1338 node->parent = (xmlNodePtr) R_ExternalPtrAddr(snode);
1339 }
1340
1341 if(LOGICAL(recursive)[0]) {
1342 RS_XML_recursive_unsetTreeDoc(node);
1343 }
1344
1345 return(ScalarLogical(TRUE));
1346 }
1347
1348 SEXP
RS_XML_setDocEl(SEXP r_node,SEXP r_doc)1349 RS_XML_setDocEl(SEXP r_node, SEXP r_doc)
1350 {
1351 xmlNodePtr node = (xmlNodePtr) R_ExternalPtrAddr(r_node);
1352 xmlDocPtr doc = (xmlDocPtr) R_ExternalPtrAddr(r_doc);
1353 xmlSetTreeDoc(node, doc);
1354 /* node->doc = doc; */
1355 return(R_NilValue);
1356 }
1357
1358
1359
1360 #ifdef ADD_XML_OUTPUT_BUFFER_CODE
1361
1362 /* These two taken from libxml2-2.6.27
1363 They are needed if xmlOutputBufferCreateBuffer()
1364 is not in the installed libxml2.
1365 It appeared in libxml2-2.6.23, released on Jan 5 2006
1366 */
1367 static int
xmlBufferWrite(void * context,const char * buffer,int len)1368 xmlBufferWrite (void * context, const char * buffer, int len) {
1369 int ret;
1370
1371 ret = xmlBufferAdd((xmlBufferPtr) context, (const xmlChar *) buffer, len);
1372 if (ret != 0)
1373 return(-1);
1374 return(len);
1375 }
1376
1377 xmlOutputBufferPtr
xmlOutputBufferCreateBuffer(xmlBufferPtr buffer,xmlCharEncodingHandlerPtr encoder)1378 xmlOutputBufferCreateBuffer(xmlBufferPtr buffer,
1379 xmlCharEncodingHandlerPtr encoder) {
1380 xmlOutputBufferPtr ret;
1381
1382 if (buffer == NULL) return(NULL);
1383
1384 ret = xmlOutputBufferCreateIO((xmlOutputWriteCallback)
1385 xmlBufferWrite,
1386 (xmlOutputCloseCallback)
1387 NULL, (void *) buffer, encoder);
1388
1389 return(ret);
1390 }
1391
1392 #endif
1393
1394
1395 /* Not completed.
1396 This could put the node into a new document and then call R_saveXMLDOM()
1397 but we are doing it in separate steps with separate C routines and
1398 calling these from R.
1399
1400 xmlNodeDumpOutput
1401
1402 Test:
1403 a = newXMLNode("a", "first bit", newXMLNode("b", "contents of b", newXMLNode("c", 3)), "more text")
1404 a = newXMLNode("a", newXMLNode("b", newXMLNode("c", 3)))
1405 .Call("RS_XML_printXMLNode", a, as.integer(1), as.integer(1), character())
1406 */
1407 USER_OBJECT_
RS_XML_printXMLNode(USER_OBJECT_ r_node,USER_OBJECT_ level,USER_OBJECT_ format,USER_OBJECT_ indent,USER_OBJECT_ r_encoding,USER_OBJECT_ r_encoding_int)1408 RS_XML_printXMLNode(USER_OBJECT_ r_node, USER_OBJECT_ level, USER_OBJECT_ format,
1409 USER_OBJECT_ indent, USER_OBJECT_ r_encoding, USER_OBJECT_ r_encoding_int)
1410 {
1411 USER_OBJECT_ ans;
1412 xmlNodePtr node;
1413 const char *encoding = NULL;
1414 xmlOutputBufferPtr buf;
1415 xmlBufferPtr xbuf;
1416
1417 int oldIndent;
1418
1419 oldIndent = xmlIndentTreeOutput;
1420
1421 node = (xmlNodePtr) R_ExternalPtrAddr(r_node);
1422
1423 xmlIndentTreeOutput = LOGICAL(indent)[0];
1424
1425 xbuf = xmlBufferCreate();
1426
1427 if(GET_LENGTH(r_encoding))
1428 encoding = CHAR_DEREF(STRING_ELT(r_encoding, 0));
1429
1430 buf = xmlOutputBufferCreateBuffer(xbuf, NULL);
1431 // xmlKeepBlanksDefault(0);
1432
1433 xmlNodeDumpOutput(buf, node->doc, node, INTEGER(level)[0], INTEGER(format)[0], encoding);
1434 xmlOutputBufferFlush(buf);
1435 xmlIndentTreeOutput = oldIndent;
1436
1437 if(xbuf->use > 0) {
1438 /*XXX this const char * in CHARSXP means we have to make multiple copies. */
1439 if(INTEGER(r_encoding_int)[0] == CE_NATIVE)
1440 ans = ScalarString(CreateCharSexpWithEncoding((const xmlChar *)encoding, (const xmlChar *)xbuf->content));
1441 else
1442 ans = ScalarString(mkCharCE((const char *)xbuf->content, INTEGER(r_encoding_int)[0]));
1443 } else
1444 ans = NEW_CHARACTER(1);
1445
1446 xmlOutputBufferClose(buf);
1447
1448 return(ans);
1449 }
1450
1451 SEXP
R_setXMLInternalTextNode_noenc(SEXP node)1452 R_setXMLInternalTextNode_noenc(SEXP node)
1453 {
1454 xmlNodePtr n = (xmlNodePtr) R_ExternalPtrAddr(node);
1455 if(!n) {
1456 Rf_error("null value passed for XMLInternalTextNode");
1457 }
1458 n->name = (const xmlChar *) (&xmlStringTextNoenc);
1459 return(ScalarLogical(TRUE));
1460 }
1461
1462 SEXP
1463 /*R_setXMLInternalTextNode_value(SEXP node, SEXP value, SEXP r_encoding)*/
R_setXMLInternalTextNode_value(SEXP node,SEXP value)1464 R_setXMLInternalTextNode_value(SEXP node, SEXP value)
1465 {
1466 xmlNodePtr n = (xmlNodePtr) R_ExternalPtrAddr(node);
1467 // xmlChar *tmp;
1468 const char *str;
1469
1470 // DECL_ENCODING_FROM_NODE(n)
1471
1472 if(n->type != XML_TEXT_NODE) {
1473 Rf_error( "Can only set value on an text node");
1474 }
1475
1476 str = CHAR(STRING_ELT(value, 0));
1477 xmlNodeSetContent(n, (const xmlChar *)str);
1478
1479 return(node);
1480 }
1481
1482 SEXP
R_xmlSetContent(SEXP node,SEXP content)1483 R_xmlSetContent(SEXP node, SEXP content)
1484 {
1485 xmlNodePtr n = (xmlNodePtr) R_ExternalPtrAddr(node);
1486 xmlNodeSetContent(n, CHAR_TO_XMLCHAR(CHAR_DEREF(STRING_ELT(content, 0))));
1487 return(R_NilValue);
1488 }
1489
1490 SEXP
R_xmlNodeValue(SEXP node,SEXP raw,SEXP r_encoding)1491 R_xmlNodeValue(SEXP node, SEXP raw, SEXP r_encoding)
1492 {
1493 xmlNodePtr n = (xmlNodePtr) R_ExternalPtrAddr(node);
1494 xmlChar *tmp;
1495 SEXP ans;
1496 DECL_ENCODING_FROM_NODE(n)
1497
1498 if(!n) {
1499 Rf_error( "null value for xml node reference");
1500 }
1501
1502 tmp = xmlNodeGetContent(n);
1503 /*
1504 xmlGetNodeRawString
1505 xmlGetNodeString
1506
1507 if(GET_LENGTH(raw) == 0)
1508 else if(LOGICAL(raw)[0]) {
1509 } else {
1510
1511 }
1512 */
1513 if(tmp) {
1514 if(INTEGER(r_encoding)[0] == CE_NATIVE)
1515 ans = ScalarString(CreateCharSexpWithEncoding(encoding, tmp));
1516 else
1517 ans = ScalarString(mkCharCE((const char *)tmp, INTEGER(r_encoding)[0]));
1518
1519
1520 free(tmp);
1521 // ans = mkString(XMLCHAR_TO_CHAR(tmp));
1522 // Just playing: ans = ScalarString(mkCharCE(tmp, CE_UTF8));
1523 } else
1524 ans = NEW_CHARACTER(0);
1525
1526 return(ans);
1527 }
1528
1529 USER_OBJECT_
R_xmlNsAsCharacter(USER_OBJECT_ s_ns)1530 R_xmlNsAsCharacter(USER_OBJECT_ s_ns)
1531 {
1532 xmlNsPtr ns = NULL;
1533 USER_OBJECT_ ans, names;
1534 const xmlChar *encoding = NULL;
1535 ns = (xmlNsPtr) R_ExternalPtrAddr(s_ns);
1536 #ifdef LIBXML_NAMESPACE_HAS_CONTEXT
1537 encoding = ns->context ? ns->context->encoding : NULL;
1538 #endif
1539
1540 PROTECT(ans = NEW_CHARACTER(2));
1541 PROTECT(names = NEW_CHARACTER(2));
1542
1543 SET_STRING_ELT(names, 0, mkChar("prefix"));
1544 SET_STRING_ELT(names, 1, mkChar("href"));
1545
1546 if(ns->prefix)
1547 SET_STRING_ELT(ans, 0, ENC_COPY_TO_USER_STRING(XMLCHAR_TO_CHAR(ns->prefix)));
1548 if(ns->href)
1549 SET_STRING_ELT(ans, 1, ENC_COPY_TO_USER_STRING(XMLCHAR_TO_CHAR(ns->href)));
1550
1551 SET_NAMES(ans, names);
1552 UNPROTECT(2);
1553 return(ans);
1554 }
1555
1556 USER_OBJECT_
R_getXMLNodeDocument(USER_OBJECT_ s_node)1557 R_getXMLNodeDocument(USER_OBJECT_ s_node)
1558 {
1559 xmlNodePtr n = (xmlNodePtr) R_ExternalPtrAddr(s_node);
1560 if(!n->doc)
1561 return(NULL_USER_OBJECT);
1562
1563 /*??? Does this arrange to free it? */
1564 return(R_createXMLDocRef(n->doc));
1565 }
1566
1567
1568 USER_OBJECT_
RS_XML_isDescendantOf(USER_OBJECT_ r_node,USER_OBJECT_ r_top,USER_OBJECT_ strict)1569 RS_XML_isDescendantOf(USER_OBJECT_ r_node, USER_OBJECT_ r_top, USER_OBJECT_ strict)
1570 {
1571 xmlNodePtr node, ptr, top;
1572 node = (xmlNodePtr) R_ExternalPtrAddr(r_node);
1573 top = (xmlNodePtr) R_ExternalPtrAddr(r_top);
1574
1575 if(!node || !top) {
1576 Rf_error( "null value passed to RS_XML_isDescendantOf");
1577 }
1578
1579 /*XXX */
1580 if(node->type == XML_NAMESPACE_DECL)
1581 return(ScalarLogical(TRUE));
1582
1583 ptr = node;
1584
1585 while(ptr && ptr->type != XML_DOCUMENT_NODE && ptr->type != XML_HTML_DOCUMENT_NODE) {
1586 if(ptr == top)
1587 return(ScalarLogical(ptr == node && LOGICAL(strict)[0] ? FALSE : TRUE));
1588 ptr = ptr->parent;
1589 }
1590
1591 return(ScalarLogical(FALSE));
1592 }
1593
1594
1595 SEXP
R_XML_indexOfChild(SEXP r_node)1596 R_XML_indexOfChild(SEXP r_node)
1597 {
1598 xmlNodePtr node, ptr; // parent
1599 int i = 0;
1600 node = (xmlNodePtr) R_ExternalPtrAddr(r_node);
1601 ptr = node->parent->children;
1602
1603 while(ptr) {
1604 if(ptr == node)
1605 return(ScalarInteger(i + 1));
1606
1607 i++;
1608 ptr = ptr->next;
1609 }
1610
1611 return(R_NilValue);
1612 }
1613
1614
1615
1616 SEXP
R_setNamespaceFromAncestors(SEXP r_node)1617 R_setNamespaceFromAncestors(SEXP r_node)
1618 {
1619 xmlNodePtr node, ptr;
1620 node = (xmlNodePtr) R_ExternalPtrAddr(r_node);
1621 ptr = node->parent;
1622 while(ptr) {
1623 if((ptr->type != XML_HTML_DOCUMENT_NODE && ptr->type != XML_DOCUMENT_NODE) &&
1624 ptr->ns && ptr->ns->href && (!ptr->ns->prefix || !ptr->ns->prefix[0])) {
1625 xmlSetNs(node, ptr->ns);
1626 return(ScalarLogical(TRUE));
1627 }
1628 ptr = ptr->parent;
1629 }
1630 return(ScalarLogical(FALSE));
1631 }
1632
1633
1634 #ifdef R_HAS_REMOVE_FINALIZERS
1635 int
xmlNode_removeFinalizers(xmlNodePtr node)1636 xmlNode_removeFinalizers(xmlNodePtr node)
1637 {
1638 xmlNodePtr tmp;
1639 int count = 0;
1640
1641 #if R_XML_DEBUG
1642 fprintf(stderr, "xml removeFinalizers %p %s\n", node, node->name);
1643 #endif
1644 count = R_RemoveExtPtrWeakRef_direct(node);
1645
1646 tmp = node->children;
1647 while(tmp) {
1648 count += xmlNode_removeFinalizers(tmp);
1649 tmp = tmp->next;
1650 }
1651 return(count);
1652 }
1653
1654 SEXP
R_xmlNode_removeFinalizers(SEXP r_node)1655 R_xmlNode_removeFinalizers(SEXP r_node)
1656 {
1657 int num;
1658 xmlNodePtr node = (xmlNodePtr) R_ExternalPtrAddr(r_node);
1659 num = xmlNode_removeFinalizers(node);
1660 return(ScalarInteger(num));
1661 }
1662 #endif
1663
1664
1665
1666
1667
1668
1669 SEXP
R_xmlSearchNs(SEXP r_doc,SEXP r_node,SEXP r_ns,SEXP r_asPrefix)1670 R_xmlSearchNs(SEXP r_doc, SEXP r_node, SEXP r_ns, SEXP r_asPrefix)
1671 {
1672 const xmlChar * val;
1673 xmlNsPtr ns;
1674
1675 xmlDocPtr doc = (r_doc == NULL_USER_OBJECT) ? NULL : R_ExternalPtrAddr(r_doc);
1676 xmlNodePtr node = (xmlNodePtr) R_ExternalPtrAddr(r_node);
1677
1678 if(Rf_length(r_ns) == 0)
1679 return(NEW_CHARACTER(0));
1680
1681 val = (const xmlChar *)CHAR_DEREF(STRING_ELT(r_ns, 0));
1682
1683 ns = LOGICAL(r_asPrefix)[0] ? xmlSearchNs(doc, node, val) : xmlSearchNsByHref(doc, node, val);
1684
1685 if(!ns)
1686 return(NEW_CHARACTER(0));
1687 else {
1688 SEXP r_ans;
1689 PROTECT(r_ans = mkString((const char *)ns->href));
1690 SET_NAMES(r_ans, mkString(ns->prefix ? XMLCHAR_TO_CHAR(ns->prefix) : ""));
1691 UNPROTECT(1);
1692 return(r_ans);
1693 }
1694 }
1695
1696
1697 USER_OBJECT_
R_getChildByIndex(USER_OBJECT_ r_node,USER_OBJECT_ r_index,USER_OBJECT_ r_addFinalizer)1698 R_getChildByIndex(USER_OBJECT_ r_node, USER_OBJECT_ r_index, USER_OBJECT_ r_addFinalizer)
1699 {
1700 xmlNodePtr node, ptr;
1701 int i = 0, idx;
1702 node = (xmlNodePtr) R_ExternalPtrAddr(r_node);
1703 ptr = node->children;
1704 idx = INTEGER(r_index)[0];
1705
1706 while(ptr && i < idx) {
1707 ptr = ptr->next;
1708 i++;
1709 }
1710
1711 return(R_createXMLNodeRef(ptr, r_addFinalizer));
1712 }
1713
1714
1715 USER_OBJECT_
R_getChildByName(USER_OBJECT_ r_node,USER_OBJECT_ r_index,USER_OBJECT_ r_addFinalizer)1716 R_getChildByName(USER_OBJECT_ r_node, USER_OBJECT_ r_index, USER_OBJECT_ r_addFinalizer)
1717 {
1718 xmlNodePtr node, ptr;
1719 node = (xmlNodePtr) R_ExternalPtrAddr(r_node);
1720 ptr = node->children;
1721 const char *name = CHAR_DEREF(STRING_ELT(r_index, 0));
1722
1723 while(ptr) {
1724 if(ptr->name && strcmp(name, (const char *)ptr->name) == 0)
1725 break;
1726 ptr = ptr->next;
1727 }
1728
1729 return(R_createXMLNodeRef(ptr, r_addFinalizer));
1730 }
1731
1732
1733 /*
1734 This is a C-level version equivalent to
1735 xmlApply(node, xmlValue)
1736
1737
1738 */
1739
1740 USER_OBJECT_
R_childStringValues(SEXP r_node,SEXP r_len,SEXP r_asVector,SEXP r_encoding,SEXP r_addNames)1741 R_childStringValues(SEXP r_node, SEXP r_len, SEXP r_asVector, SEXP r_encoding, SEXP r_addNames)
1742 {
1743 xmlNodePtr node, kid;
1744 int len, i;
1745 SEXP ans, names = NULL;
1746 int asVector = LOGICAL(r_asVector)[0];
1747 int encoding = INTEGER(r_encoding)[0];
1748 xmlChar *tmp;
1749 int nprotect = 0;
1750
1751 node = (xmlNodePtr) R_ExternalPtrAddr(r_node);
1752 len = INTEGER(r_len)[0];
1753
1754 if(asVector)
1755 ans = NEW_CHARACTER(len);
1756 else
1757 ans = NEW_LIST(len);
1758
1759 PROTECT(ans); nprotect++;
1760
1761 if(LOGICAL(r_addNames)[0]) {
1762 PROTECT(names = NEW_CHARACTER(len));
1763 nprotect++;
1764 }
1765
1766
1767 for(i = 0, kid = node->children; kid && i < len; i++, kid = kid->next) {
1768 tmp = xmlNodeGetContent(kid);
1769 SEXP val = mkCharCE((const char *)tmp, encoding);
1770 PROTECT(val);
1771 if(asVector)
1772 SET_STRING_ELT(ans, i, val);
1773 else
1774 SET_VECTOR_ELT(ans, i, ScalarString(val));
1775 if(names && kid->name) {
1776 SET_STRING_ELT(names, i, mkCharCE((const char *)kid->name, encoding));
1777 }
1778 UNPROTECT(1);
1779 }
1780
1781 if(names)
1782 SET_NAMES(ans, names);
1783
1784 UNPROTECT(nprotect);
1785 return(ans);
1786 }
1787
1788
1789
1790 USER_OBJECT_
R_replaceNodeWithChildren(USER_OBJECT_ r_node)1791 R_replaceNodeWithChildren(USER_OBJECT_ r_node)
1792 {
1793 xmlNodePtr node = (xmlNodePtr) R_ExternalPtrAddr(r_node);
1794
1795 xmlNodePtr nxt = node->next;
1796
1797 if(node->prev) {
1798 node->prev->next = node->children;
1799 node->children->prev = node->prev;
1800 } else if(node->parent)
1801 node->parent->children = node->children;
1802
1803 if(node->children) {
1804 xmlNodePtr cur = node->children;
1805 while(cur->next) {
1806 cur->parent = node->parent;
1807 cur = cur->next;
1808 }
1809
1810 cur->next = nxt;
1811 if(nxt)
1812 nxt->prev = cur;
1813 }
1814
1815 return(NULL_USER_OBJECT);
1816 }
1817