Menu
▾
▴
[perl-xml-cvs] CVS: XML-LibXML-XPathContext XPathContext.xs,1.4,1.5 XPathContext.pm,1.4,1.5
|
From: Petr P. <pa...@us...> - 2003-03-16 16:21:32
|
Update of /cvsroot/perl-xml/XML-LibXML-XPathContext
In directory sc8-pr-cvs1:/tmp/cvs-serv27568
Modified Files:
XPathContext.xs XPathContext.pm
Log Message:
- added getContextNode and setContextNode
- XPathContext object now increments PmmREFCNT for ctx->node and ctx->doc
Index: XPathContext.xs
===================================================================
RCS file: /cvsroot/perl-xml/XML-LibXML-XPathContext/XPathContext.xs,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -d -r1.4 -r1.5
--- XPathContext.xs 14 Mar 2003 17:20:47 -0000 1.4
+++ XPathContext.xs 16 Mar 2003 16:21:29 -0000 1.5
@@ -49,12 +49,12 @@
va_start(args, msg);
sv_vsetpvfn(sv, msg, strlen(msg), &args, NULL, 0, NULL);
va_end(args);
-
+
if (LibXML_error != NULL) {
sv_catsv(LibXML_error, sv); /* remember the last error */
}
else {
- croak("%s",SvPV(sv, PL_na));
+ croak("%s",SvPV(sv, PL_na));
}
SvREFCNT_dec(sv);
@@ -66,119 +66,119 @@
/* Much of the code is borrowed from Matt Sergeant's XML::LibXSLT */
static xmlXPathObjectPtr
LibXML_generic_variable_lookup(void* varLookupData,
- const xmlChar *name,
+ const xmlChar *name,
const xmlChar *ns_uri)
{
- xmlXPathObjectPtr ret;
- SV * lookup_func;
- SV * lookup_data;
- I32 count;
- STRLEN n_a;
- SV * perl_result;
- AV * array_result;
- xmlNodePtr tmp_node, tmp_node1;
- dSP;
- char * tmp_string;
- double tmp_double;
- int tmp_int;
- SV * data;
+ xmlXPathObjectPtr ret;
+ SV * lookup_func;
+ SV * lookup_data;
+ I32 count;
+ STRLEN n_a;
+ SV * perl_result;
+ AV * array_result;
+ xmlNodePtr tmp_node, tmp_node1;
+ dSP;
+ char * tmp_string;
+ double tmp_double;
+ int tmp_int;
+ SV * data;
- data = (SV *) varLookupData;
- if (varLookupData == NULL || !SvROK(data) ||
- SvTYPE(SvRV(data)) != SVt_PVAV) {
- croak("XPathContext: lost variable lookup data structure!\n");
- }
+ data = (SV *) varLookupData;
+ if (varLookupData == NULL || !SvROK(data) ||
+ SvTYPE(SvRV(data)) != SVt_PVAV) {
+ croak("XPathContext: lost variable lookup data structure!\n");
+ }
- lookup_func = *(av_fetch((AV *) SvRV(data),0,0 ));
- lookup_data = *(av_fetch((AV *) SvRV(data),1,0 ));
+ lookup_func = *(av_fetch((AV *) SvRV(data),0,0 ));
+ lookup_data = *(av_fetch((AV *) SvRV(data),1,0 ));
- ENTER;
- SAVETMPS;
- PUSHMARK(SP);
+ ENTER;
+ SAVETMPS;
+ PUSHMARK(SP);
- XPUSHs(lookup_data);
- XPUSHs(sv_2mortal(C2Sv(name,NULL)));
- XPUSHs(sv_2mortal(C2Sv(ns_uri,NULL)));
- PUTBACK ;
+ XPUSHs(lookup_data);
+ XPUSHs(sv_2mortal(C2Sv(name,NULL)));
+ XPUSHs(sv_2mortal(C2Sv(ns_uri,NULL)));
+ PUTBACK ;
- count = perl_call_sv(lookup_func, G_SCALAR|G_EVAL);
+ count = perl_call_sv(lookup_func, G_SCALAR|G_EVAL);
- SPAGAIN;
- if (SvTRUE(ERRSV)) {
- POPs;
- croak("XPathContext: error coming back from variable lookup function. %s\n", SvPV(ERRSV, n_a));
- }
- if (count != 1) croak("XPathContext: variable lookup function returned more than one argument!\n");
+ SPAGAIN;
+ if (SvTRUE(ERRSV)) {
+ POPs;
+ croak("XPathContext: error coming back from variable lookup function. %s\n", SvPV(ERRSV, n_a));
+ }
+ if (count != 1) croak("XPathContext: variable lookup function returned more than one argument!\n");
- perl_result = POPs;
- if (!SvOK(perl_result)) {
- ret = (xmlXPathObjectPtr)xmlXPathNewCString("");
- goto FINISH;
- }
- /* convert perl result structures to LibXML structures */
- if (sv_isobject(perl_result) &&
- (SvTYPE(SvRV(perl_result)) == SVt_PVMG ||
- SvTYPE(SvRV(perl_result)) == SVt_PVAV))
- {
- if (sv_isa(perl_result, "XML::LibXML::NodeList")) {
- int i = 0;
- int len;
- /* warn("result is a node list\n"); */
- ret = (xmlXPathObjectPtr) xmlXPathNewNodeSet((xmlNodePtr) NULL);
- array_result = (AV*)SvRV(perl_result);
- len = av_len(array_result);
- for( i; i <= len ; i++ ) {
- tmp_node = (xmlNodePtr)PmmSvNode(*(av_fetch(array_result,i,0)));
- xmlXPathNodeSetAdd(ret->nodesetval, tmp_node);
- }
- goto FINISH;
- }
- else if (sv_isa(perl_result, "XML::LibXML::Node") ||
- sv_isa(perl_result, "XML::LibXML::Element") ||
- sv_isa(perl_result, "XML::LibXML::Attr") ||
- sv_isa(perl_result, "XML::LibXML::Text") ||
- sv_isa(perl_result, "XML::LibXML::Comment") ||
- sv_isa(perl_result, "XML::LibXML::Document") ||
- sv_isa(perl_result, "XML::LibXML::PI")) {
- /* warn("result is a node\n"); */
- ret = (xmlXPathObjectPtr)xmlXPathNewNodeSet(NULL);
- tmp_node = (xmlNodePtr)PmmSvNode(perl_result);
- xmlXPathNodeSetAdd(ret->nodesetval,tmp_node);
- goto FINISH;
- }
- else if (sv_isa(perl_result, "XML::LibXML::Boolean")) {
- /* warn("result is a boolean\n"); */
- tmp_int = SvIV(SvRV(perl_result));
- ret = (xmlXPathObjectPtr)xmlXPathNewBoolean(tmp_int);
- goto FINISH;
- }
- else if (sv_isa(perl_result, "XML::LibXML::Literal")) {
- /* warn("result is a literal\n"); */
- tmp_string = SvPV(SvRV(perl_result), n_a);
- ret = (xmlXPathObjectPtr)xmlXPathNewCString(tmp_string);
- goto FINISH;
- }
- else if (sv_isa(perl_result, "XML::LibXML::Number")) {
- /* warn("result is a number\n"); */
- tmp_double = SvNV(SvRV(perl_result));
- ret = (xmlXPathObjectPtr)xmlXPathNewFloat(tmp_double);
- goto FINISH;
- }
- } else if (SvNOK(perl_result) || SvIOK(perl_result)) {
- /* warn("result is an unblessed number\n"); */
- ret = (xmlXPathObjectPtr)xmlXPathNewFloat(SvNV(perl_result));
- } else {
- /* warn("result is an unblessed string\n"); */
- ret = (xmlXPathObjectPtr)xmlXPathNewCString(SvPV(perl_result, n_a));
- }
-
+ perl_result = POPs;
+ if (!SvOK(perl_result)) {
+ ret = (xmlXPathObjectPtr)xmlXPathNewCString("");
+ goto FINISH;
+ }
+ /* convert perl result structures to LibXML structures */
+ if (sv_isobject(perl_result) &&
+ (SvTYPE(SvRV(perl_result)) == SVt_PVMG ||
+ SvTYPE(SvRV(perl_result)) == SVt_PVAV))
+ {
+ if (sv_isa(perl_result, "XML::LibXML::NodeList")) {
+ int i = 0;
+ int len;
+ /* warn("result is a node list\n"); */
+ ret = (xmlXPathObjectPtr) xmlXPathNewNodeSet((xmlNodePtr) NULL);
+ array_result = (AV*)SvRV(perl_result);
+ len = av_len(array_result);
+ for( i; i <= len ; i++ ) {
+ tmp_node = (xmlNodePtr)PmmSvNode(*(av_fetch(array_result,i,0)));
+ xmlXPathNodeSetAdd(ret->nodesetval, tmp_node);
+ }
+ goto FINISH;
+ }
+ else if (sv_isa(perl_result, "XML::LibXML::Node") ||
+ sv_isa(perl_result, "XML::LibXML::Element") ||
+ sv_isa(perl_result, "XML::LibXML::Attr") ||
+ sv_isa(perl_result, "XML::LibXML::Text") ||
+ sv_isa(perl_result, "XML::LibXML::Comment") ||
+ sv_isa(perl_result, "XML::LibXML::Document") ||
+ sv_isa(perl_result, "XML::LibXML::PI")) {
+ /* warn("result is a node\n"); */
+ ret = (xmlXPathObjectPtr)xmlXPathNewNodeSet(NULL);
+ tmp_node = (xmlNodePtr)PmmSvNode(perl_result);
+ xmlXPathNodeSetAdd(ret->nodesetval,tmp_node);
+ goto FINISH;
+ }
+ else if (sv_isa(perl_result, "XML::LibXML::Boolean")) {
+ /* warn("result is a boolean\n"); */
+ tmp_int = SvIV(SvRV(perl_result));
+ ret = (xmlXPathObjectPtr)xmlXPathNewBoolean(tmp_int);
+ goto FINISH;
+ }
+ else if (sv_isa(perl_result, "XML::LibXML::Literal")) {
+ /* warn("result is a literal\n"); */
+ tmp_string = SvPV(SvRV(perl_result), n_a);
+ ret = (xmlXPathObjectPtr)xmlXPathNewCString(tmp_string);
+ goto FINISH;
+ }
+ else if (sv_isa(perl_result, "XML::LibXML::Number")) {
+ /* warn("result is a number\n"); */
+ tmp_double = SvNV(SvRV(perl_result));
+ ret = (xmlXPathObjectPtr)xmlXPathNewFloat(tmp_double);
+ goto FINISH;
+ }
+ } else if (SvNOK(perl_result) || SvIOK(perl_result)) {
+ /* warn("result is an unblessed number\n"); */
+ ret = (xmlXPathObjectPtr)xmlXPathNewFloat(SvNV(perl_result));
+ } else {
+ /* warn("result is an unblessed string\n"); */
+ ret = (xmlXPathObjectPtr)xmlXPathNewCString(SvPV(perl_result, n_a));
+ }
+
- FINISH:
+ FINISH:
- PUTBACK;
- FREETMPS;
- LEAVE;
- return ret;
+ PUTBACK;
+ FREETMPS;
+ LEAVE;
+ return ret;
}
/* ****************************************************************
@@ -188,212 +188,237 @@
static void
LibXML_generic_extension_function(xmlXPathParserContextPtr ctxt, int nargs)
{
- xmlXPathObjectPtr obj,ret;
- xmlNodeSetPtr nodelist = NULL;
- int count;
- SV * perl_dispatch;
- int i;
- STRLEN len;
- SV * perl_result;
- ProxyNodePtr owner = NULL;
- char * tmp_string;
- STRLEN n_a;
- double tmp_double;
- int tmp_int;
- AV * array_result;
- xmlNodePtr tmp_node;
- SV *key;
- char *strkey;
- const char *function, *uri;
- SV **perl_function;
- int xslt_tree = 0;
- dSP;
- SV * data;
+ xmlXPathObjectPtr obj,ret;
+ xmlNodeSetPtr nodelist = NULL;
+ int count;
+ SV * perl_dispatch;
+ int i;
+ STRLEN len;
+ SV * perl_result;
+ ProxyNodePtr owner = NULL;
+ char * tmp_string;
+ STRLEN n_a;
+ double tmp_double;
+ int tmp_int;
+ AV * array_result;
+ xmlNodePtr tmp_node;
+ SV *key;
+ char *strkey;
+ const char *function, *uri;
+ SV **perl_function;
+ int xslt_tree = 0;
+ dSP;
+ SV * data;
- /* warn("entered LibXML_generic_extension_function for %s\n",ctxt->context->function); */
- data = (SV *) ctxt->context->funcLookupData;
- if (ctxt->context->funcLookupData == NULL || !SvROK(data) ||
- SvTYPE(SvRV(data)) != SVt_PVHV) {
- croak("XPathContext: lost function lookup data structure!\n");
- }
+ /* warn("entered LibXML_generic_extension_function for %s\n",ctxt->context->function); */
+ data = (SV *) ctxt->context->funcLookupData;
+ if (ctxt->context->funcLookupData == NULL || !SvROK(data) ||
+ SvTYPE(SvRV(data)) != SVt_PVHV) {
+ croak("XPathContext: lost function lookup data structure!\n");
+ }
- function = ctxt->context->function;
- uri = ctxt->context->functionURI;
+ function = ctxt->context->function;
+ uri = ctxt->context->functionURI;
- key = newSVpvn("",0);
- if (uri && *uri) {
- sv_catpv(key, "{");
- sv_catpv(key, (const char*)uri);
- sv_catpv(key, "}");
- }
- sv_catpv(key, (const char*)function);
- strkey = SvPV(key, len);
- perl_function =
- hv_fetch((HV*)SvRV(data), strkey, len, 0);
- SvREFCNT_dec(key);
+ key = newSVpvn("",0);
+ if (uri && *uri) {
+ sv_catpv(key, "{");
+ sv_catpv(key, (const char*)uri);
+ sv_catpv(key, "}");
+ }
+ sv_catpv(key, (const char*)function);
+ strkey = SvPV(key, len);
+ perl_function =
+ hv_fetch((HV*)SvRV(data), strkey, len, 0);
+ SvREFCNT_dec(key);
- ENTER;
- SAVETMPS;
- PUSHMARK(SP);
+ ENTER;
+ SAVETMPS;
+ PUSHMARK(SP);
- XPUSHs(*perl_function);
+ XPUSHs(*perl_function);
- /* set up call to perl dispatcher function */
- for (i = 0; i < nargs; i++) {
- obj = (xmlXPathObjectPtr)valuePop(ctxt);
- xslt_tree = 0;
- switch (obj->type) {
- case XPATH_XSLT_TREE: /* PP: what's this? */
- warn("%d's argument to %s is XPATH_XSLT_TREE",i,function);
- xslt_tree = 1; /* PP: these are destroyed (they have boolval=1) */
- case XPATH_NODESET:
- nodelist = obj->nodesetval;
- if ( nodelist ) {
- XPUSHs(sv_2mortal(newSVpv("XML::LibXML::NodeList", 0)));
- XPUSHs(sv_2mortal(newSViv(nodelist->nodeNr)));
- if ( nodelist->nodeNr > 0 ) {
- int j = 0 ;
- const char * cls = "XML::LibXML::Node";
- xmlNodePtr tnode;
- SV * element;
+ /* set up call to perl dispatcher function */
+ for (i = 0; i < nargs; i++) {
+ obj = (xmlXPathObjectPtr)valuePop(ctxt);
+ xslt_tree = 0;
+ switch (obj->type) {
+ case XPATH_XSLT_TREE: /* PP: what's this? */
+ warn("%d's argument to %s is XPATH_XSLT_TREE",i,function);
+ xslt_tree = 1; /* PP: these are destroyed (they have boolval=1) */
+ case XPATH_NODESET:
+ nodelist = obj->nodesetval;
+ if ( nodelist ) {
+ XPUSHs(sv_2mortal(newSVpv("XML::LibXML::NodeList", 0)));
+ XPUSHs(sv_2mortal(newSViv(nodelist->nodeNr)));
+ if ( nodelist->nodeNr > 0 ) {
+ int j = 0 ;
+ const char * cls = "XML::LibXML::Node";
+ xmlNodePtr tnode;
+ SV * element;
- len = nodelist->nodeNr;
- for( j ; j < len; j++){
- tnode = nodelist->nodeTab[j];
- if( tnode != NULL && tnode->doc != NULL) {
- owner = SvPROXYNODE(sv_2mortal(PmmNodeToSv((xmlNodePtr)(tnode->doc), NULL)));
- }
- if (tnode->type == XML_NAMESPACE_DECL) {
- element = sv_newmortal();
- cls = PmmNodeTypeName( tnode );
- element = sv_setref_pv( element,
- (const char *)cls,
- (void *)xmlCopyNamespace((xmlNsPtr)tnode)
- );
- }
- else {
- /* need to copy the node as libxml2 will free it */
- /* PP: I guess its only true for XSLT_TREEs */
- if (xslt_tree) {
- xmlNodePtr tnode_cpy = xmlCopyNode(tnode, 1);
- element = PmmNodeToSv(tnode_cpy, owner);
- } else {
- element = PmmNodeToSv(tnode, owner);
- }
- }
- XPUSHs( sv_2mortal(element) );
- }
- }
- } else {
- /* PP: We can't simply leave out an empty nodelist as Matt does! */
- /* PP: The number of arguments must match! */
- XPUSHs(sv_2mortal(newSVpv("XML::LibXML::NodeList", 0)));
- XPUSHs(sv_2mortal(newSViv(0)));
- }
- break;
- case XPATH_BOOLEAN:
- XPUSHs(sv_2mortal(newSVpv("XML::LibXML::Boolean", 0)));
- XPUSHs(sv_2mortal(newSViv(obj->boolval)));
- break;
- case XPATH_NUMBER:
- XPUSHs(sv_2mortal(newSVpv("XML::LibXML::Number", 0)));
- XPUSHs(sv_2mortal(newSVnv(obj->floatval)));
- break;
- case XPATH_STRING:
- XPUSHs(sv_2mortal(newSVpv("XML::LibXML::Literal", 0)));
- XPUSHs(sv_2mortal(C2Sv(obj->stringval, 0)));
- break;
- default:
- warn("Unknown XPath return type (%d) in call to {%s}%s - assuming string", obj->type, uri, function);
- XPUSHs(sv_2mortal(newSVpv("XML::LibXML::Literal", 0)));
- XPUSHs(sv_2mortal(C2Sv((char*)xmlXPathCastToString(obj), 0)));
- }
- xmlXPathFreeObject(obj);
- }
+ len = nodelist->nodeNr;
+ for( j ; j < len; j++){
+ tnode = nodelist->nodeTab[j];
+ if( tnode != NULL && tnode->doc != NULL) {
+ owner = SvPROXYNODE(sv_2mortal(PmmNodeToSv((xmlNodePtr)(tnode->doc), NULL)));
+ }
+ if (tnode->type == XML_NAMESPACE_DECL) {
+ element = sv_newmortal();
+ cls = PmmNodeTypeName( tnode );
+ element = sv_setref_pv( element,
+ (const char *)cls,
+ (void *)xmlCopyNamespace((xmlNsPtr)tnode)
+ );
+ }
+ else {
+ /* need to copy the node as libxml2 will free it */
+ /* PP: I guess its only true for XSLT_TREEs */
+ if (xslt_tree) {
+ xmlNodePtr tnode_cpy = xmlCopyNode(tnode, 1);
+ element = PmmNodeToSv(tnode_cpy, owner);
+ } else {
+ element = PmmNodeToSv(tnode, owner);
+ }
+ }
+ XPUSHs( sv_2mortal(element) );
+ }
+ }
+ } else {
+ /* PP: We can't simply leave out an empty nodelist as Matt does! */
+ /* PP: The number of arguments must match! */
+ XPUSHs(sv_2mortal(newSVpv("XML::LibXML::NodeList", 0)));
+ XPUSHs(sv_2mortal(newSViv(0)));
+ }
+ break;
+ case XPATH_BOOLEAN:
+ XPUSHs(sv_2mortal(newSVpv("XML::LibXML::Boolean", 0)));
+ XPUSHs(sv_2mortal(newSViv(obj->boolval)));
+ break;
+ case XPATH_NUMBER:
+ XPUSHs(sv_2mortal(newSVpv("XML::LibXML::Number", 0)));
+ XPUSHs(sv_2mortal(newSVnv(obj->floatval)));
+ break;
+ case XPATH_STRING:
+ XPUSHs(sv_2mortal(newSVpv("XML::LibXML::Literal", 0)));
+ XPUSHs(sv_2mortal(C2Sv(obj->stringval, 0)));
+ break;
+ default:
+ warn("Unknown XPath return type (%d) in call to {%s}%s - assuming string", obj->type, uri, function);
+ XPUSHs(sv_2mortal(newSVpv("XML::LibXML::Literal", 0)));
+ XPUSHs(sv_2mortal(C2Sv((char*)xmlXPathCastToString(obj), 0)));
+ }
+ xmlXPathFreeObject(obj);
+ }
- /* call perl dispatcher */
- PUTBACK;
+ /* call perl dispatcher */
+ PUTBACK;
- perl_dispatch = sv_2mortal(newSVpv("XML::LibXML::XPathContext::perl_dispatcher",0));
- count = perl_call_sv(perl_dispatch, G_SCALAR|G_EVAL);
+ perl_dispatch = sv_2mortal(newSVpv("XML::LibXML::XPathContext::perl_dispatcher",0));
+ count = perl_call_sv(perl_dispatch, G_SCALAR|G_EVAL);
- SPAGAIN;
+ SPAGAIN;
- if (SvTRUE(ERRSV)) {
- POPs;
- croak("XPathContext: error coming back from perl-dispatcher in pm file. %s\n", SvPV(ERRSV, n_a));
- }
+ if (SvTRUE(ERRSV)) {
+ POPs;
+ croak("XPathContext: error coming back from perl-dispatcher in pm file. %s\n", SvPV(ERRSV, n_a));
+ }
- if (count != 1) croak("XPathContext: perl-dispatcher in pm file returned more than one argument!\n");
+ if (count != 1) croak("XPathContext: perl-dispatcher in pm file returned more than one argument!\n");
- perl_result = POPs;
- if (!SvOK(perl_result)) {
- ret = (xmlXPathObjectPtr)xmlXPathNewCString("");
- goto FINISH;
- }
+ perl_result = POPs;
+ if (!SvOK(perl_result)) {
+ ret = (xmlXPathObjectPtr)xmlXPathNewCString("");
+ goto FINISH;
+ }
- /* convert perl result structures to LibXML structures */
- if (sv_isobject(perl_result) &&
- (SvTYPE(SvRV(perl_result)) == SVt_PVMG ||
- SvTYPE(SvRV(perl_result)) == SVt_PVAV))
- {
- if (sv_isa(perl_result, "XML::LibXML::NodeList")) {
- i = 0;
- /* warn("result is a node list\n"); */
- ret = (xmlXPathObjectPtr)xmlXPathNewNodeSet(NULL);
- array_result = (AV*)SvRV(perl_result);
- len = av_len(array_result);
- for( i; i <= len ; i++ ) {
- tmp_node = (xmlNodePtr)PmmSvNode(*(av_fetch(array_result,i,0)));
- xmlXPathNodeSetAdd(ret->nodesetval, tmp_node);
- }
- goto FINISH;
- }
- else if (sv_isa(perl_result, "XML::LibXML::Node") ||
- sv_isa(perl_result, "XML::LibXML::Element") ||
- sv_isa(perl_result, "XML::LibXML::Attr") ||
- sv_isa(perl_result, "XML::LibXML::Text") ||
- sv_isa(perl_result, "XML::LibXML::Comment") ||
- sv_isa(perl_result, "XML::LibXML::Document") ||
- sv_isa(perl_result, "XML::LibXML::PI")) {
- /* warn("result is a node\n"); */
- ret = (xmlXPathObjectPtr)xmlXPathNewNodeSet(NULL);
- tmp_node = (xmlNodePtr)PmmSvNode(perl_result);
- xmlXPathNodeSetAdd(ret->nodesetval,tmp_node);
- goto FINISH;
- }
- else if (sv_isa(perl_result, "XML::LibXML::Boolean")) {
- /* warn("result is a boolean\n"); */
- tmp_int = SvIV(SvRV(perl_result));
- ret = (xmlXPathObjectPtr)xmlXPathNewBoolean(tmp_int);
- goto FINISH;
- }
- else if (sv_isa(perl_result, "XML::LibXML::Literal")) {
- /* warn("result is a literal\n"); */
- tmp_string = SvPV(SvRV(perl_result), len);
- ret = (xmlXPathObjectPtr)xmlXPathNewCString(tmp_string);
- goto FINISH;
- }
- else if (sv_isa(perl_result, "XML::LibXML::Number")) {
- /* warn("result is a number\n"); */
- tmp_double = SvNV(SvRV(perl_result));
- ret = (xmlXPathObjectPtr)xmlXPathNewFloat(tmp_double);
- goto FINISH;
- }
- } else if (SvNOK(perl_result) || SvIOK(perl_result)) {
- /* warn("result is an unblessed number\n"); */
- ret = (xmlXPathObjectPtr)xmlXPathNewFloat(SvNV(perl_result));
- } else {
- /* warn("result is an unblessed string\n"); */
- ret = (xmlXPathObjectPtr)xmlXPathNewCString(SvPV(perl_result, n_a));
- }
+ /* convert perl result structures to LibXML structures */
+ if (sv_isobject(perl_result) &&
+ (SvTYPE(SvRV(perl_result)) == SVt_PVMG ||
+ SvTYPE(SvRV(perl_result)) == SVt_PVAV))
+ {
+ if (sv_isa(perl_result, "XML::LibXML::NodeList")) {
+ i = 0;
+ /* warn("result is a node list\n"); */
+ ret = (xmlXPathObjectPtr)xmlXPathNewNodeSet(NULL);
+ array_result = (AV*)SvRV(perl_result);
+ len = av_len(array_result);
+ for( i; i <= len ; i++ ) {
+ tmp_node = (xmlNodePtr)PmmSvNode(*(av_fetch(array_result,i,0)));
+ xmlXPathNodeSetAdd(ret->nodesetval, tmp_node);
+ }
+ goto FINISH;
+ }
+ else if (sv_isa(perl_result, "XML::LibXML::Node") ||
+ sv_isa(perl_result, "XML::LibXML::Element") ||
+ sv_isa(perl_result, "XML::LibXML::Attr") ||
+ sv_isa(perl_result, "XML::LibXML::Text") ||
+ sv_isa(perl_result, "XML::LibXML::Comment") ||
+ sv_isa(perl_result, "XML::LibXML::Document") ||
+ sv_isa(perl_result, "XML::LibXML::PI")) {
+ /* warn("result is a node\n"); */
+ ret = (xmlXPathObjectPtr)xmlXPathNewNodeSet(NULL);
+ tmp_node = (xmlNodePtr)PmmSvNode(perl_result);
+ warn("NODE: perl mortality count %d\n",
+ SvREFCNT(SvRV(perl_result)));
+ warn("NODE: owner mortality count %d\n",
+ PmmREFCNT(PmmOWNERPO(((ProxyNodePtr)(tmp_node->_private)))));
+ warn("NODE: mortality count %d\n",
+ PmmREFCNT(((ProxyNodePtr)(tmp_node->_private))));
+ warn("NODE: is proxy %d\n",
+ (((ProxyNodePtr)(tmp_node->_private))->node == tmp_node));
- FINISH:
+ /* safely remove the node from perl structures without */
+ /* deleting any real libxml2 object */
+ if (SvREFCNT(SvRV(perl_result))==1) {
+ int result=PmmREFCNT_dec_flag_delete(SvPROXYNODE(perl_result));
+ warn("NODE PmmREFCNT_dec_flag_delete: %d\n",result);
+ sv_setiv(SvRV(perl_result),0); /* make DESTROY do nothing */
+ }
+ /* now, this is a memory leak; something has to be done */
+ /* with the nodes for which PmmREFCNT_dec_flag_delete */
+ /* returned 0 */
- valuePush(ctxt, ret);
- PUTBACK;
- FREETMPS;
- LEAVE;
+ xmlXPathNodeSetAdd(ret->nodesetval,tmp_node);
+ warn("NODE: goto finish\n");
+ goto FINISH;
+ }
+ else if (sv_isa(perl_result, "XML::LibXML::Boolean")) {
+ /* warn("result is a boolean\n"); */
+ tmp_int = SvIV(SvRV(perl_result));
+ ret = (xmlXPathObjectPtr)xmlXPathNewBoolean(tmp_int);
+ goto FINISH;
+ }
+ else if (sv_isa(perl_result, "XML::LibXML::Literal")) {
+ /* warn("result is a literal\n"); */
+ tmp_string = SvPV(SvRV(perl_result), len);
+ ret = (xmlXPathObjectPtr)xmlXPathNewCString(tmp_string);
+ goto FINISH;
+ }
+ else if (sv_isa(perl_result, "XML::LibXML::Number")) {
+ /* warn("result is a number\n"); */
+ tmp_double = SvNV(SvRV(perl_result));
+ ret = (xmlXPathObjectPtr)xmlXPathNewFloat(tmp_double);
+ goto FINISH;
+ }
+ } else if (SvNOK(perl_result) || SvIOK(perl_result)) {
+ /* warn("result is an unblessed number\n"); */
+ ret = (xmlXPathObjectPtr)xmlXPathNewFloat(SvNV(perl_result));
+ } else {
+ /* warn("result is an unblessed string\n"); */
+ ret = (xmlXPathObjectPtr)xmlXPathNewCString(SvPV(perl_result, n_a));
+ }
+
+ FINISH:
+ fprintf(stderr,"NODE: value push\n");
+ valuePush(ctxt, ret);
+ fprintf(stderr,"NODE: putback\n");
+ PUTBACK;
+ fprintf(stderr,"NODE: freetmps\n");
+ FREETMPS;
+ fprintf(stderr,"NODE: leave\n");
+ LEAVE;
+ fprintf(stderr,"NODE: left\n");
}
MODULE = XML::LibXML::XPathContext PACKAGE = XML::LibXML::XPathContext
@@ -409,6 +434,10 @@
ctxt = xmlXPathNewContext( node->doc );
ctxt->node = node;
+ /* we want the node and doc live as long as ctxt does */
+ PmmREFCNT_inc(SvPROXYNODE(pnode));
+ PmmREFCNT_inc(PmmNewNode((xmlNodePtr)node->doc));
+
/* get the namespace information */
if (node->type == XML_DOCUMENT_NODE) {
ctxt->namespaces = xmlGetNsList( node->doc,
@@ -441,19 +470,89 @@
CODE:
xs_warn( "DESTROY XPATH CONTEXT" );
if (ctxt) {
- if (ctxt->namespaces != NULL) {
- xmlFree( ctxt->namespaces );
- }
- if (ctxt->varLookupData != NULL && SvROK((SV*)ctxt->varLookupData)
- && SvTYPE(SvRV((SV *)ctxt->varLookupData)) == SVt_PVAV) {
- SvREFCNT_dec((SV *)ctxt->varLookupData);
- }
- if (ctxt->funcLookupData != NULL && SvROK((SV*)ctxt->funcLookupData)
- && SvTYPE(SvRV((SV *)ctxt->funcLookupData)) == SVt_PVHV) {
- SvREFCNT_dec((SV *)ctxt->funcLookupData);
- }
-
- xmlXPathFreeContext(ctxt);
+ if (ctxt->node) {
+ PmmREFCNT_dec(ctxt->node->_private);
+ }
+ if (ctxt->doc) {
+ PmmREFCNT_dec(ctxt->doc->_private);
+ }
+
+ if (ctxt->namespaces != NULL) {
+ xmlFree( ctxt->namespaces );
+ }
+ if (ctxt->varLookupData != NULL && SvROK((SV*)ctxt->varLookupData)
+ && SvTYPE(SvRV((SV *)ctxt->varLookupData)) == SVt_PVAV) {
+ SvREFCNT_dec((SV *)ctxt->varLookupData);
+ }
+ if (ctxt->funcLookupData != NULL && SvROK((SV*)ctxt->funcLookupData)
+ && SvTYPE(SvRV((SV *)ctxt->funcLookupData)) == SVt_PVHV) {
+ SvREFCNT_dec((SV *)ctxt->funcLookupData);
+ }
+
+ xmlXPathFreeContext(ctxt);
+ }
+
+SV*
+getContextNode( self )
+ SV * self
+ INIT:
+ xmlXPathContextPtr ctxt = (xmlXPathContextPtr)SvIV(SvRV(self));
+ CODE:
+ if (ctxt->node != NULL) {
+ RETVAL = PmmNodeToSv(ctxt->node,
+ PmmOWNERPO( PmmPROXYNODE(ctxt->node)));
+
+ } else {
+ warn("XPathContext: lost context node\n");
+ RETVAL = &PL_sv_undef;
+ }
+OUTPUT:
+ RETVAL
+
+void
+setContextNode( self , pnode )
+ SV * self
+ SV * pnode
+ INIT:
+ xmlNodePtr node = PmmSvNode(pnode);
+ xmlXPathContextPtr ctxt = (xmlXPathContextPtr)SvIV(SvRV(self));
+ PPCODE:
+ if (node != NULL) {
+ /* we want the node and doc live as long as ctxt does */
+ PmmREFCNT_inc(SvPROXYNODE(pnode));
+ PmmREFCNT_inc(PmmNewNode((xmlNodePtr)node->doc));
+
+ if (ctxt->node != NULL) {
+ PmmREFCNT_dec(ctxt->node->_private);
+ } else {
+ warn("XPathContext: Lost previous context node");
+ }
+ if (ctxt->doc != NULL) {
+ PmmREFCNT_dec(ctxt->doc->_private);
+ } else {
+ warn("XPathContext: Lost previous document node");
+ }
+ ctxt->node = node;
+ ctxt->doc = node->doc;
+
+ /* free old namespace information */
+ if (ctxt->namespaces != NULL) {
+ xmlFree( ctxt->namespaces );
+ }
+ /* get new namespace information */
+ if (node->type == XML_DOCUMENT_NODE) {
+ ctxt->namespaces = xmlGetNsList( node->doc,
+ xmlDocGetRootElement( node->doc ) );
+ } else {
+ ctxt->namespaces = xmlGetNsList(node->doc, node);
+ }
+ ctxt->nsNr = 0;
+ if (ctxt->namespaces != NULL) {
+ while (ctxt->namespaces[ctxt->nsNr] != NULL)
+ ctxt->nsNr++;
+ }
+ } else {
+ croak("XPathContext: Cannot set an undefined context node");
}
void
@@ -482,13 +581,13 @@
xmlXPathContextPtr ctxt = (xmlXPathContextPtr)SvIV(SvRV(self));
CODE:
if (ctxt->varLookupData != NULL &&
- SvROK((SV*)(ctxt->varLookupData)) &&
- SvTYPE(SvRV((SV*)(ctxt->varLookupData))) == SVt_PVAV) {
- RETVAL = *(av_fetch((AV *) SvRV((SV*)(ctxt->varLookupData)),1,0));
- SvREFCNT_inc(RETVAL);
+ SvROK((SV*)(ctxt->varLookupData)) &&
+ SvTYPE(SvRV((SV*)(ctxt->varLookupData))) == SVt_PVAV) {
+ RETVAL = *(av_fetch((AV *) SvRV((SV*)(ctxt->varLookupData)),1,0));
+ SvREFCNT_inc(RETVAL);
} else {
- RETVAL = &PL_sv_undef;
- }
+ RETVAL = &PL_sv_undef;
+ }
OUTPUT:
RETVAL
@@ -509,26 +608,26 @@
croak( "missing xpath context" );
}
if ( SvROK(lookup_func) && SvTYPE(SvRV(lookup_func)) == SVt_PVCV ) {
- pfdr = newRV_inc((SV*) newAV());
- av_push((AV *)SvRV(pfdr), SvREFCNT_inc(lookup_func));
- av_push((AV *)SvRV(pfdr), SvREFCNT_inc(lookup_data));
+ pfdr = newRV_inc((SV*) newAV());
+ av_push((AV *)SvRV(pfdr), SvREFCNT_inc(lookup_func));
+ av_push((AV *)SvRV(pfdr), SvREFCNT_inc(lookup_data));
} else {
croak( "1st argument is not a CODE reference" );
}
if (ctxt->varLookupData != NULL) {
- if (SvTYPE(SvRV((SV *)ctxt->varLookupData)) == SVt_PVAV) {
- SvREFCNT_dec((SV *)ctxt->varLookupData);
- ctxt->varLookupData = NULL;
- ctxt->varLookupFunc = NULL;
- } else {
- croak("can't register: varLookupData slot already occupied\n");
- }
- }
+ if (SvTYPE(SvRV((SV *)ctxt->varLookupData)) == SVt_PVAV) {
+ SvREFCNT_dec((SV *)ctxt->varLookupData);
+ ctxt->varLookupData = NULL;
+ ctxt->varLookupFunc = NULL;
+ } else {
+ croak("can't register: varLookupData slot already occupied\n");
+ }
+ }
PPCODE:
xmlXPathRegisterVariableLookup(ctxt, LibXML_generic_variable_lookup, pfdr);
if (ctxt->varLookupData==NULL || ctxt->varLookupData != pfdr) {
- croak( "registrating failed\n" );
- }
+ croak( "registrating failed\n" );
+ }
void
registerFunctionNS( pxpath_context, name, uri, func)
@@ -549,39 +648,39 @@
croak( "missing xpath context" );
}
if ( SvTYPE(SvRV(func)) == SVt_PVCV ) {
- if (ctxt->funcLookupData == NULL) {
- pfdr = newRV_inc((SV*) newHV());
- ctxt->funcLookupData = pfdr;
- } else {
- if (SvTYPE(SvRV((SV *)ctxt->funcLookupData)) == SVt_PVHV) {
- /* good, it's a HV */
- pfdr = (SV *)ctxt->funcLookupData;
- } else {
- croak ( "can't register: funcLookupData structure occupied\n" );
- }
- }
- key = newSVpvn("",0);
- if (SvOK(uri)) {
- sv_catpv(key, "{");
- sv_catsv(key, uri);
- sv_catpv(key, "}");
- }
- sv_catpv(key, (const char*)name);
- strkey = SvPV(key, len);
- /* warn("Trying to store function '%s' in %d\n", strkey, pfdr); */
- hv_store((HV *)SvRV(pfdr),strkey, len, SvREFCNT_inc(func), 0);
- SvREFCNT_dec(key);
- } else {
- croak( "function is not a CODE reference\n" );
+ if (ctxt->funcLookupData == NULL) {
+ pfdr = newRV_inc((SV*) newHV());
+ ctxt->funcLookupData = pfdr;
+ } else {
+ if (SvTYPE(SvRV((SV *)ctxt->funcLookupData)) == SVt_PVHV) {
+ /* good, it's a HV */
+ pfdr = (SV *)ctxt->funcLookupData;
+ } else {
+ croak ( "can't register: funcLookupData structure occupied\n" );
+ }
+ }
+ key = newSVpvn("",0);
+ if (SvOK(uri)) {
+ sv_catpv(key, "{");
+ sv_catsv(key, uri);
+ sv_catpv(key, "}");
+ }
+ sv_catpv(key, (const char*)name);
+ strkey = SvPV(key, len);
+ /* warn("Trying to store function '%s' in %d\n", strkey, pfdr); */
+ hv_store((HV *)SvRV(pfdr),strkey, len, SvREFCNT_inc(func), 0);
+ SvREFCNT_dec(key);
+ } else {
+ croak( "function is not a CODE reference\n" );
}
PPCODE:
if (SvOK(uri)) {
- /* warn("Registering function with NS '%s' (uri: %s)\n", name, uri); */
- xmlXPathRegisterFuncNS(ctxt, name, SvPV(uri, len), LibXML_generic_extension_function);
- } else {
- /* warn("Registering function '%s'\n", name); */
- xmlXPathRegisterFunc(ctxt, name, LibXML_generic_extension_function);
- }
+ /* warn("Registering function with NS '%s' (uri: %s)\n", name, uri); */
+ xmlXPathRegisterFuncNS(ctxt, name, SvPV(uri, len), LibXML_generic_extension_function);
+ } else {
+ /* warn("Registering function '%s'\n", name); */
+ xmlXPathRegisterFunc(ctxt, name, LibXML_generic_extension_function);
+ }
void
_findnodes( pxpath_context, perl_xpath )
Index: XPathContext.pm
===================================================================
RCS file: /cvsroot/perl-xml/XML-LibXML-XPathContext/XPathContext.pm,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -d -r1.4 -r1.5
--- XPathContext.pm 14 Mar 2003 16:37:45 -0000 1.4
+++ XPathContext.pm 16 Mar 2003 16:21:29 -0000 1.5
@@ -189,6 +189,14 @@
certain shortcuts. This could be used as the equivalent of
<xsl:value-of select="some_xpath"/>.
+=item B<getContextNode()>
+
+Get current context node.
+
+=item B<setContextNode($node)>
+
+Set current context node.
+
=back
=head1 AUTHORS
|
