/** * perl-libxml-mm.c * $Id$ * * Basic concept: * perl varies in the implementation of UTF8 handling. this header (together * with the c source) implements a few functions, that can be used from within * the core module inorder to avoid cascades of c pragmas */#ifdef __cplusplusextern"C"{#endif#include <stdarg.h>#include <stdlib.h>#include "EXTERN.h"#include "perl.h"#include "XSUB.h"#include <libxml/parser.h>#include <libxml/tree.h>#ifdef XML_LIBXML_GDOME_SUPPORT#include <libgdome/gdome.h>#include <libgdome/gdome-libxml-util.h>#endif#include "perl-libxml-sax.h"#ifdef __cplusplus}#endif#ifdef XS_WARNINGS#define xs_warn(string) warn(string) #else#define xs_warn(string)#endif/** * this is a wrapper function that does the type evaluation for the * node. this makes the code a little more readable in the .XS * * the code is not really portable, but i think we'll avoid some * memory leak problems that way. **/constchar*PmmNodeTypeName(xmlNodePtrelem){constchar*name="XML::LibXML::Node";if(elem!=NULL){char*ptrHlp;switch(elem->type){caseXML_ELEMENT_NODE:name="XML::LibXML::Element";break;caseXML_TEXT_NODE:name="XML::LibXML::Text";break;caseXML_COMMENT_NODE:name="XML::LibXML::Comment";break;caseXML_CDATA_SECTION_NODE:name="XML::LibXML::CDATASection";break;caseXML_ATTRIBUTE_NODE:name="XML::LibXML::Attr";break;caseXML_DOCUMENT_NODE:caseXML_HTML_DOCUMENT_NODE:name="XML::LibXML::Document";break;caseXML_DOCUMENT_FRAG_NODE:name="XML::LibXML::DocumentFragment";break;caseXML_NAMESPACE_DECL:name="XML::LibXML::Namespace";break;caseXML_DTD_NODE:name="XML::LibXML::Dtd";break;caseXML_PI_NODE:name="XML::LibXML::PI";break;default:name="XML::LibXML::Node";break;};returnname;}return"";}/* * @node: Reference to the node the structure proxies * @owner: libxml defines only the document, but not the node owner * (in case of document fragments, they are not the same!) * @count: this is the internal reference count! * @encoding: this value is missing in libxml2's doc structure * * Since XML::LibXML will not know, is a certain node is already * defined in the perl layer, it can't shurely tell when a node can be * safely be removed from the memory. This structure helps to keep * track how intense the nodes of a document are used and will not * delete the nodes unless they are not refered from somewhere else. */struct_ProxyNode{xmlNodePtrnode;xmlNodePtrowner;intcount;intencoding;};/* helper type for the proxy structure */typedefstruct_ProxyNodeProxyNode;/* pointer to the proxy structure */typedefProxyNode*ProxyNodePtr;/* this my go only into the header used by the xs */#define SvPROXYNODE(x) ((ProxyNodePtr)SvIV(SvRV(x)))#define SvNAMESPACE(x) ((xmlNsPtr)SvIV(SvRV(x)))#define PmmREFCNT(node) node->count#define PmmREFCNT_inc(node) node->count++#define PmmNODE(thenode) thenode->node#define PmmOWNER(node) node->owner#define PmmOWNERPO(node) ((node && PmmOWNER(node)) ? (ProxyNodePtr)PmmOWNER(node)->_private : node)#define PmmENCODING(node) node->encoding#define PmmNodeEncoding(node) ((ProxyNodePtr)(node->_private))->encoding#define PmmDocEncoding(node) (node->charset)/* creates a new proxy node from a given node. this function is aware * about the fact that a node may already has a proxy structure. */ProxyNodePtrPmmNewNode(xmlNodePtrnode){ProxyNodePtrproxy=NULL;if(node==NULL){xs_warn("no node found\n");returnNULL;}if(node->_private==NULL){proxy=(ProxyNodePtr)malloc(sizeof(struct_ProxyNode));/* proxy = (ProxyNodePtr)Newz(0, proxy, 0, ProxyNode); */if(proxy!=NULL){proxy->node=node;proxy->owner=NULL;proxy->count=0;node->_private=(void*)proxy;}}else{proxy=(ProxyNodePtr)node->_private;}returnproxy;}ProxyNodePtrPmmNewFragment(xmlDocPtrdoc){ProxyNodePtrretval=NULL;xmlNodePtrfrag=NULL;xs_warn("new frag\n");frag=xmlNewDocFragment(doc);retval=PmmNewNode(frag);if(doc!=NULL){xs_warn("inc document\n");/* under rare circumstances _private is not set correctly? */if(doc->_private!=NULL){PmmREFCNT_inc(((ProxyNodePtr)doc->_private));}retval->owner=(xmlNodePtr)doc;}returnretval;}/* frees the node if nessecary. this method is aware, that libxml2 * has several diffrent nodetypes. */voidPmmFreeNode(xmlNodePtrnode){switch(node->type){caseXML_DOCUMENT_NODE:caseXML_HTML_DOCUMENT_NODE:xs_warn("PFN: XML_DOCUMENT_NODE\n");xmlFreeDoc((xmlDocPtr)node);break;caseXML_ATTRIBUTE_NODE:xs_warn("PFN: XML_ATTRIBUTE_NODE\n");if(node->parent==NULL){xs_warn("free node!\n");node->ns=NULL;xmlFreeProp((xmlAttrPtr)node);}break;caseXML_DTD_NODE:if(node->doc!=NULL){if(node->doc->extSubset!=(xmlDtdPtr)node&&node->doc->intSubset!=(xmlDtdPtr)node){xs_warn("PFN: XML_DTD_NODE\n");node->doc=NULL;xmlFreeDtd((xmlDtdPtr)node);}}break;caseXML_DOCUMENT_FRAG_NODE:xs_warn("PFN: XML_DOCUMENT_FRAG_NODE\n");default:xs_warn("PFN: normal node");xmlFreeNode(node);break;}}/* decrements the proxy counter. if the counter becomes zero or less, this method will free the proxy node. If the node is part of a subtree, PmmREFCNT_def will fix the reference counts and delete the subtree if it is not required any more. */intPmmREFCNT_dec(ProxyNodePtrnode){xmlNodePtrlibnode=NULL;ProxyNodePtrowner=NULL;intretval=0;if(node!=NULL){retval=PmmREFCNT(node)--;if(PmmREFCNT(node)<=0){xs_warn("NODE DELETATION\n");libnode=PmmNODE(node);if(libnode!=NULL){if(libnode->_private!=node){xs_warn("lost node\n");libnode=NULL;}else{libnode->_private=NULL;}}PmmNODE(node)=NULL;if(PmmOWNER(node)&&PmmOWNERPO(node)){xs_warn("DOC NODE!\n");owner=PmmOWNERPO(node);PmmOWNER(node)=NULL;if(libnode!=NULL&&libnode->parent==NULL){/* this is required if the node does not directly * belong to the document tree */xs_warn("REAL DELETE");PmmFreeNode(libnode);}xs_warn("decrease owner");PmmREFCNT_dec(owner);}elseif(libnode!=NULL){xs_warn("STANDALONE REAL DELETE");PmmFreeNode(libnode);}/* Safefree( node ); */free(node);}}else{xs_warn("lost node");}returnretval;}/* @node: the node that should be wrapped into a SV * @owner: perl instance of the owner node (may be NULL) * * This function will create a real perl instance of a given node. * the function is called directly by the XS layer, to generate a perl * instance of the node. All node reference counts are updated within * this function. Therefore this function returns a node that can * directly be used as output. * * if @ower is NULL or undefined, the node is ment to be the root node * of the tree. this node will later be used as an owner of other * nodes. */SV*PmmNodeToSv(xmlNodePtrnode,ProxyNodePtrowner){ProxyNodePtrdfProxy=NULL;SV*retval=&PL_sv_undef;constchar*CLASS="XML::LibXML::Node";if(node!=NULL){/* find out about the class */CLASS=PmmNodeTypeName(node);xs_warn(" return new perl node\n");xs_warn(CLASS);if(node->_private!=NULL){dfProxy=PmmNewNode(node);}else{dfProxy=PmmNewNode(node);if(dfProxy!=NULL){if(owner!=NULL){dfProxy->owner=PmmNODE(owner);PmmREFCNT_inc(owner);}else{xs_warn("node contains himself");}}else{xs_warn("proxy creation failed!\n");}}retval=NEWSV(0,0);sv_setref_pv(retval,CLASS,(void*)dfProxy);PmmREFCNT_inc(dfProxy);switch(node->type){caseXML_DOCUMENT_NODE:caseXML_HTML_DOCUMENT_NODE:caseXML_DOCB_DOCUMENT_NODE:if(((xmlDocPtr)node)->encoding!=NULL){dfProxy->encoding=(int)xmlParseCharEncoding((constchar*)((xmlDocPtr)node)->encoding);}break;default:break;}}else{xs_warn("no node found!");}returnretval;}xmlNodePtrPmmCloneNode(xmlNodePtrnode,intrecursive){xmlNodePtrretval=NULL;if(node!=NULL){switch(node->type){caseXML_ELEMENT_NODE:caseXML_TEXT_NODE:caseXML_CDATA_SECTION_NODE:caseXML_ENTITY_REF_NODE:caseXML_PI_NODE:caseXML_COMMENT_NODE:caseXML_DOCUMENT_FRAG_NODE:caseXML_ENTITY_DECL:retval=xmlCopyNode(node,recursive);break;caseXML_ATTRIBUTE_NODE:retval=(xmlNodePtr)xmlCopyProp(NULL,(xmlAttrPtr)node);break;caseXML_DOCUMENT_NODE:caseXML_HTML_DOCUMENT_NODE:retval=(xmlNodePtr)xmlCopyDoc((xmlDocPtr)node,recursive);break;caseXML_DOCUMENT_TYPE_NODE:caseXML_DTD_NODE:retval=(xmlNodePtr)xmlCopyDtd((xmlDtdPtr)node);break;caseXML_NAMESPACE_DECL:retval=(xmlNodePtr)xmlCopyNamespace((xmlNsPtr)node);break;default:break;}}returnretval;}/* extracts the libxml2 node from a perl reference */xmlNodePtrPmmSvNodeExt(SV*perlnode,intcopy){xmlNodePtrretval=NULL;ProxyNodePtrproxy=NULL;if(perlnode!=NULL&&perlnode!=&PL_sv_undef){/* if ( sv_derived_from(perlnode, "XML::LibXML::Node") *//* && SvPROXYNODE(perlnode) != NULL ) { *//* retval = PmmNODE( SvPROXYNODE(perlnode) ) ; *//* } */xs_warn(" perlnode found\n");if(sv_derived_from(perlnode,"XML::LibXML::Node")){proxy=SvPROXYNODE(perlnode);if(proxy!=NULL){xs_warn("is a xmlNodePtr structure\n");retval=PmmNODE(proxy);}if(retval!=NULL&&((ProxyNodePtr)retval->_private)!=proxy){xs_warn("no node in proxy node");PmmNODE(proxy)=NULL;retval=NULL;}}#ifdef XML_LIBXML_GDOME_SUPPORTelseif(sv_derived_from(perlnode,"XML::GDOME::Node")){GdomeNode*gnode=(GdomeNode*)SvIV((SV*)SvRV(perlnode));if(gnode==NULL){warn("no XML::GDOME data found (datastructure empty)");}else{retval=gdome_xml_n_get_xmlNode(gnode);if(retval==NULL){xs_warn("no XML::LibXML node found in GDOME object");}elseif(copy==1){retval=PmmCloneNode(retval,1);}}}#endif}returnretval;}/* extracts the libxml2 owner node from a perl reference */xmlNodePtrPmmSvOwner(SV*perlnode){xmlNodePtrretval=NULL;if(perlnode!=NULL&&perlnode!=&PL_sv_undef&&SvPROXYNODE(perlnode)!=NULL){retval=PmmOWNER(SvPROXYNODE(perlnode));}returnretval;}/* reverse to PmmSvOwner(). sets the owner of the current node. this * will increase the proxy count of the owner. */SV*PmmSetSvOwner(SV*perlnode,SV*extra){if(perlnode!=NULL&&perlnode!=&PL_sv_undef){PmmOWNER(SvPROXYNODE(perlnode))=PmmNODE(SvPROXYNODE(extra));PmmREFCNT_inc(SvPROXYNODE(extra));}returnperlnode;}voidPmmFixOwnerList(xmlNodePtrlist,ProxyNodePtrparent){if(list!=NULL){xmlNodePtriterator=list;while(iterator!=NULL){switch(iterator->type){caseXML_ENTITY_DECL:caseXML_ATTRIBUTE_DECL:caseXML_NAMESPACE_DECL:caseXML_ELEMENT_DECL:iterator=iterator->next;continue;break;default:break;}if(iterator->_private!=NULL){PmmFixOwner((ProxyNodePtr)iterator->_private,parent);}else{if(iterator->type!=XML_ATTRIBUTE_NODE&&iterator->properties!=NULL){PmmFixOwnerList((xmlNodePtr)iterator->properties,parent);}PmmFixOwnerList(iterator->children,parent);}iterator=iterator->next;}}}/** * this functions fixes the reference counts for an entire subtree. * it is very important to fix an entire subtree after node operations * where the documents or the owner node may get changed. this method is * aware about nodes that already belong to a certain owner node. * * the method uses the internal methods PmmFixNode and PmmChildNodes to * do the real updates. * * in the worst case this traverses the subtree twice durig a node * operation. this case is only given when the node has to be * adopted by the document. Since the ownerdocument and the effective * owner may differ this double traversing makes sense. */intPmmFixOwner(ProxyNodePtrnodetofix,ProxyNodePtrparent){ProxyNodePtroldParent=NULL;if(nodetofix!=NULL){switch(PmmNODE(nodetofix)->type){caseXML_ENTITY_DECL:caseXML_ATTRIBUTE_DECL:caseXML_NAMESPACE_DECL:caseXML_ELEMENT_DECL:caseXML_DOCUMENT_NODE:return(0);default:break;}if(PmmOWNER(nodetofix)!=NULL){oldParent=PmmOWNERPO(nodetofix);}/* The owner data is only fixed if the node is neither a * fragment nor a document. Also no update will happen if * the node is already his owner or the owner has not * changed during previous operations. */if(oldParent!=parent){if(parent&&parent!=nodetofix){PmmOWNER(nodetofix)=PmmNODE(parent);PmmREFCNT_inc(parent);}else{PmmOWNER(nodetofix)=NULL;}if(oldParent!=NULL&&oldParent!=nodetofix)PmmREFCNT_dec(oldParent);if(PmmNODE(nodetofix)->type!=XML_ATTRIBUTE_NODE&&PmmNODE(nodetofix)->properties!=NULL){PmmFixOwnerList((xmlNodePtr)PmmNODE(nodetofix)->properties,parent);}if(parent==NULL||PmmNODE(nodetofix)->parent==NULL){/* fix to self */parent=nodetofix;}PmmFixOwnerList(PmmNODE(nodetofix)->children,parent);}else{xs_warn("node doesn't need to get fixed");}return(1);}return(0);}voidPmmFixOwnerNode(xmlNodePtrnode,ProxyNodePtrparent){if(node!=NULL&&parent!=NULL){if(node->_private!=NULL){PmmFixOwner(node->_private,parent);}else{PmmFixOwnerList(node->children,parent);}}}ProxyNodePtrPmmNewContext(xmlParserCtxtPtrnode){ProxyNodePtrproxy=NULL;proxy=(ProxyNodePtr)xmlMalloc(sizeof(ProxyNode));if(proxy!=NULL){proxy->node=(xmlNodePtr)node;proxy->owner=NULL;proxy->count=1;}else{warn("empty context");}returnproxy;}intPmmContextREFCNT_dec(ProxyNodePtrnode){xmlParserCtxtPtrlibnode=NULL;intretval=0;if(node!=NULL){retval=PmmREFCNT(node)--;if(PmmREFCNT(node)<=0){xs_warn("NODE DELETATION\n");libnode=(xmlParserCtxtPtr)PmmNODE(node);if(libnode!=NULL){if(libnode->_private!=NULL){if(libnode->_private!=(void*)node){PmmSAXCloseContext(libnode);}else{xmlFree(libnode->_private);}libnode->_private=NULL;}PmmNODE(node)=NULL;xmlFreeParserCtxt(libnode);}}xmlFree(node);}returnretval;}SV*PmmContextSv(xmlParserCtxtPtrctxt){ProxyNodePtrdfProxy=NULL;SV*retval=&PL_sv_undef;constchar*CLASS="XML::LibXML::ParserContext";void*saxvector=NULL;if(ctxt!=NULL){dfProxy=PmmNewContext(ctxt);retval=NEWSV(0,0);sv_setref_pv(retval,CLASS,(void*)dfProxy);PmmREFCNT_inc(dfProxy);}else{xs_warn("no node found!");}returnretval;}xmlParserCtxtPtrPmmSvContext(SV*scalar){xmlParserCtxtPtrretval=NULL;if(scalar!=NULL&&scalar!=&PL_sv_undef&&sv_isa(scalar,"XML::LibXML::ParserContext")&&SvPROXYNODE(scalar)!=NULL){retval=(xmlParserCtxtPtr)PmmNODE(SvPROXYNODE(scalar));}else{if(scalar==NULL&&scalar==&PL_sv_undef){xs_warn("no scalar!");}elseif(!sv_isa(scalar,"XML::LibXML::ParserContext")){xs_warn("bad object");}elseif(SvPROXYNODE(scalar)==NULL){xs_warn("empty object");}else{xs_warn("nothing was wrong!");}}returnretval;}xmlChar*PmmFastEncodeString(intcharset,constxmlChar*string,constxmlChar*encoding){xmlCharEncodingHandlerPtrcoder=NULL;xmlChar*retval=NULL;xmlBufferPtrin=NULL,out=NULL;if(charset==1){/* warn("use UTF8 for encoding ... %s ", string); */returnxmlStrdup(string);}if(charset>1){/* warn( "use document encoding %s (%d)", encoding, charset ); */coder=xmlGetCharEncodingHandler(charset);}elseif(charset==XML_CHAR_ENCODING_ERROR){/* warn("no standard encoding %s\n", encoding); */coder=xmlFindCharEncodingHandler((constchar*)encoding);}else{xs_warn("no encoding found \n");}if(coder!=NULL){xs_warn("coding machine found \n");in=xmlBufferCreate();out=xmlBufferCreate();xmlBufferCCat(in,(constchar*)string);if(xmlCharEncInFunc(coder,out,in)>=0){retval=xmlStrdup(out->content);/* warn( "encoded string is %s" , retval); */}else{/* warn( "b0rked encoiding!\n"); */}xmlBufferFree(in);xmlBufferFree(out);xmlCharEncCloseFunc(coder);}returnretval;}xmlChar*PmmFastDecodeString(intcharset,constxmlChar*string,constxmlChar*encoding){xmlCharEncodingHandlerPtrcoder=NULL;xmlChar*retval=NULL;xmlBufferPtrin=NULL,out=NULL;if(charset==1){returnxmlStrdup(string);}if(charset>1){coder=xmlGetCharEncodingHandler(charset);}elseif(charset==XML_CHAR_ENCODING_ERROR){coder=xmlFindCharEncodingHandler((constchar*)encoding);}else{xs_warn("no encoding found\n");}if(coder!=NULL){/* warn( "do encoding %s", string ); */in=xmlBufferCreate();out=xmlBufferCreate();xmlBufferCat(in,string);if(xmlCharEncOutFunc(coder,out,in)>=0){retval=xmlCharStrndup(xmlBufferContent(out),xmlBufferLength(out));}else{xs_warn("decoding error \n");}xmlBufferFree(in);xmlBufferFree(out);xmlCharEncCloseFunc(coder);}returnretval;}/** * encodeString returns an UTF-8 encoded String * while the encodig has the name of the encoding of string **/xmlChar*PmmEncodeString(constchar*encoding,constxmlChar*string){xmlCharEncodingenc;xmlChar*ret=NULL;xmlCharEncodingHandlerPtrcoder=NULL;if(string!=NULL){if(encoding!=NULL){xs_warn(encoding);enc=xmlParseCharEncoding(encoding);ret=PmmFastEncodeString(enc,string,(constxmlChar*)encoding);}else{/* if utf-8 is requested we do nothing */ret=xmlStrdup(string);}}returnret;}/** * decodeString returns an $encoding encoded string. * while string is an UTF-8 encoded string and * encoding is the coding name **/char*PmmDecodeString(constchar*encoding,constxmlChar*string){char*ret=NULL;xmlCharEncodingenc;xmlCharEncodingHandlerPtrcoder=NULL;if(string!=NULL){xs_warn("PmmDecodeString called");if(encoding!=NULL){enc=xmlParseCharEncoding(encoding);ret=(char*)PmmFastDecodeString(enc,string,(constxmlChar*)encoding);xs_warn("PmmDecodeString done");}else{ret=(char*)xmlStrdup(string);}}returnret;}SV*C2Sv(constxmlChar*string,constxmlChar*encoding){SV*retval=&PL_sv_undef;xmlCharEncodingenc;if(string!=NULL){if(encoding!=NULL){enc=xmlParseCharEncoding((constchar*)encoding);}else{enc=0;}if(enc==0){/* this happens if the encoding is "" or NULL */enc=XML_CHAR_ENCODING_UTF8;}if(enc==XML_CHAR_ENCODING_UTF8){/* create an UTF8 string. */STRLENlen=0;xs_warn("set UTF8 string");len=xmlStrlen(string);/* create the SV *//* string[len] = 0; */retval=NEWSV(0,len+1);sv_setpvn(retval,(constchar*)string,len);#ifdef HAVE_UTF8xs_warn("set UTF8-SV-flag");SvUTF8_on(retval);#endif }else{/* just create an ordinary string. */xs_warn("set ordinary string");retval=newSVpvn((constchar*)string,xmlStrlen(string));}}returnretval;}xmlChar*Sv2C(SV*scalar,constxmlChar*encoding){xmlChar*retval=NULL;xs_warn("sv2c start!");if(scalar!=NULL&&scalar!=&PL_sv_undef){STRLENlen=0;char*t_pv=SvPV(scalar,len);xmlChar*ts=NULL;xmlChar*string=xmlStrdup((xmlChar*)t_pv);if(xmlStrlen(string)>0){xs_warn("no undefs");#ifdef HAVE_UTF8xs_warn("use UTF8");if(!DO_UTF8(scalar)&&encoding!=NULL){#elseif(encoding!=NULL){#endifxs_warn("domEncodeString!");ts=PmmEncodeString((constchar*)encoding,string);xs_warn("done!");if(string!=NULL){xmlFree(string);}string=ts;}}retval=xmlStrdup(string);if(string!=NULL){xmlFree(string);}}xs_warn("sv2c end!");returnretval;}SV*nodeC2Sv(constxmlChar*string,xmlNodePtrrefnode){/* this is a little helper function to avoid to much redundand code in LibXML.xs */SV*retval=&PL_sv_undef;STRLENlen=0;if(refnode!=NULL){xmlDocPtrreal_doc=refnode->doc;if(real_doc!=NULL&&real_doc->encoding!=NULL){xmlChar*decoded=PmmFastDecodeString(PmmDocEncoding(real_doc),(constxmlChar*)string,(constxmlChar*)real_doc->encoding);len=xmlStrlen(decoded);if(real_doc->charset==XML_CHAR_ENCODING_UTF8){/* create an UTF8 string. */xs_warn("set UTF8 string");/* create the SV *//* warn( "string is %s\n", string ); */retval=newSVpvn((constchar*)decoded,len);#ifdef HAVE_UTF8xs_warn("set UTF8-SV-flag");SvUTF8_on(retval);#endif }else{/* just create an ordinary string. */xs_warn("set ordinary string");retval=newSVpvn((constchar*)decoded,len);}/* retval = C2Sv( decoded, real_doc->encoding ); */xmlFree(decoded);}else{retval=newSVpvn((constchar*)string,xmlStrlen(string));}}else{retval=newSVpvn((constchar*)string,xmlStrlen(string));}returnretval;}xmlChar*nodeSv2C(SV*scalar,xmlNodePtrrefnode){/* this function requires conditionized compiling, because we request a function, that does not exists in earlier versions of perl. in this cases the library assumes, all strings are in UTF8. if a programmer likes to have the intelligent code, he needs to upgrade perl */if(refnode!=NULL){xmlDocPtrreal_dom=refnode->doc;xs_warn("have node!");if(real_dom!=NULL&&real_dom->encoding!=NULL){xs_warn("encode string!");/* speed things a bit up.... */if(scalar!=NULL&&scalar!=&PL_sv_undef){STRLENlen=0;char*t_pv=SvPV(scalar,len);xmlChar*ts=NULL;xmlChar*string=xmlStrdup((xmlChar*)t_pv);if(xmlStrlen(string)>0){xs_warn("no undefs");#ifdef HAVE_UTF8xs_warn("use UTF8");if(!DO_UTF8(scalar)&&real_dom!=NULL&&real_dom->encoding!=NULL){xs_warn("string is not UTF8\n");#elseif(real_dom!=NULL&&real_dom->encoding!=NULL){#endifxs_warn("domEncodeString!");/* if ( string == NULL || *string == 0 ) warn("string is empty" ); */ts=PmmFastEncodeString(PmmDocEncoding(real_dom),string,(constxmlChar*)real_dom->encoding);xs_warn("done!");if(string!=NULL){xmlFree(string);}string=ts;}else{xs_warn("no encoding set, use UTF8!\n");}}/* if ( string == NULL ) warn( "string is NULL\n" ); */returnstring;}else{xs_warn("return NULL");returnNULL;}}else{xs_warn("document has no encoding defined! use simple SV extraction\n");}}xs_warn("no encoding !!");returnSv2C(scalar,NULL);}SV*PmmNodeToGdomeSv(xmlNodePtrnode){SV*retval=&PL_sv_undef;#ifdef XML_LIBXML_GDOME_SUPPORTGdomeNode*gnode=NULL;GdomeExceptionexc;constchar*CLASS="";if(node!=NULL){gnode=gdome_xml_n_mkref(node);if(gnode!=NULL){switch(gdome_n_nodeType(gnode,&exc)){caseGDOME_ELEMENT_NODE:CLASS="XML::GDOME::Element";break;caseGDOME_ATTRIBUTE_NODE:CLASS="XML::GDOME::Attr";break;caseGDOME_TEXT_NODE:CLASS="XML::GDOME::Text";break;caseGDOME_CDATA_SECTION_NODE:CLASS="XML::GDOME::CDATASection";break;caseGDOME_ENTITY_REFERENCE_NODE:CLASS="XML::GDOME::EntityReference";break;caseGDOME_ENTITY_NODE:CLASS="XML::GDOME::Entity";break;caseGDOME_PROCESSING_INSTRUCTION_NODE:CLASS="XML::GDOME::ProcessingInstruction";break;caseGDOME_COMMENT_NODE:CLASS="XML::GDOME::Comment";break;caseGDOME_DOCUMENT_TYPE_NODE:CLASS="XML::GDOME::DocumentType";break;caseGDOME_DOCUMENT_FRAGMENT_NODE:CLASS="XML::GDOME::DocumentFragment";break;caseGDOME_NOTATION_NODE:CLASS="XML::GDOME::Notation";break;caseGDOME_DOCUMENT_NODE:CLASS="XML::GDOME::Document";break;default:break;}retval=NEWSV(0,0);sv_setref_pv(retval,CLASS,gnode);}}#endifreturnretval;}