Menu
▾
▴
[perl-xml-cvs] CVS: XML-LibXML-XPathContext XPathContext.xs,1.2,1.3 XPathContext.pm,1.2,1.3
|
From: Petr P. <pa...@us...> - 2003-03-14 16:23:55
|
Update of /cvsroot/perl-xml/XML-LibXML-XPathContext
In directory sc8-pr-cvs1:/tmp/cvs-serv21709
Modified Files:
XPathContext.xs XPathContext.pm
Log Message:
added extension functions support
Index: XPathContext.xs
===================================================================
RCS file: /cvsroot/perl-xml/XML-LibXML-XPathContext/XPathContext.xs,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- XPathContext.xs 14 Mar 2003 16:12:39 -0000 1.2
+++ XPathContext.xs 14 Mar 2003 16:23:50 -0000 1.3
@@ -63,122 +63,338 @@
/* ****************************************************************
* Variable Lookup
* **************************************************************** */
-xmlXPathObjectPtr
+/* 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 *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 = (SV *) varLookupData;
-
- if (varLookupData == NULL ||
- SvTYPE(SvRV(data)) != SVt_PVAV) {
- croak("LibXML: lost data structure for variable lookup.\n");
- }
+ 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;
- lookup_func = *(av_fetch((AV *) SvRV(data),0,0 ));
- lookup_data = *(av_fetch((AV *) SvRV(data),1,0 ));
+ data = (SV *) varLookupData;
+ if (varLookupData == NULL || !SvROK(data) ||
+ SvTYPE(SvRV(data)) != SVt_PVAV) {
+ croak("XPathContext: lost variable lookup data structure!\n");
+ }
- ENTER;
- SAVETMPS;
- PUSHMARK(SP);
+ lookup_func = *(av_fetch((AV *) SvRV(data),0,0 ));
+ lookup_data = *(av_fetch((AV *) SvRV(data),1,0 ));
- XPUSHs(lookup_data);
- XPUSHs(sv_2mortal(C2Sv(name,NULL)));
- XPUSHs(sv_2mortal(C2Sv(ns_uri,NULL)));
- PUTBACK ;
+ ENTER;
+ SAVETMPS;
+ PUSHMARK(SP);
- count = perl_call_sv(lookup_func, G_SCALAR|G_EVAL);
+ XPUSHs(lookup_data);
+ XPUSHs(sv_2mortal(C2Sv(name,NULL)));
+ XPUSHs(sv_2mortal(C2Sv(ns_uri,NULL)));
+ PUTBACK ;
- SPAGAIN;
- if (SvTRUE(ERRSV)) {
- POPs;
- croak("LibXML: error coming back from variable lookup function. %s\n", SvPV(ERRSV, n_a));
- }
- if (count != 1) croak("LibXML: variable lookup function returned more than one argument!\n");
+ count = perl_call_sv(lookup_func, G_SCALAR|G_EVAL);
- 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));
- }
+ 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));
+ }
+
-FINISH:
+ FINISH:
- PUTBACK;
- FREETMPS;
- LEAVE;
- return ret;
+ PUTBACK;
+ FREETMPS;
+ LEAVE;
+ return ret;
}
+/* ****************************************************************
+ * Generic Extension Function
+ * **************************************************************** */
+/* Much of the code is borrowed from Matt Sergeant's XML::LibXSLT */
+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;
+
+ /* 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;
+
+ 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);
+
+ 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;
+
+ 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;
+
+ perl_dispatch = sv_2mortal(newSVpv("XML::LibXML::XPathContext::perl_dispatcher",0));
+ count = perl_call_sv(perl_dispatch, G_SCALAR|G_EVAL);
+
+ SPAGAIN;
+
+ 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");
+
+ 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));
+ }
+
+ FINISH:
+
+ valuePush(ctxt, ret);
+ PUTBACK;
+ FREETMPS;
+ LEAVE;
+}
MODULE = XML::LibXML::XPathContext PACKAGE = XML::LibXML::XPathContext
@@ -225,15 +441,19 @@
CODE:
xs_warn( "DESTROY XPATH CONTEXT" );
if (ctxt) {
- if (ctxt->namespaces != NULL) {
- xmlFree( ctxt->namespaces );
- }
- if (ctxt->varLookupData != NULL
- && SvTYPE(SvRV((SV *)ctxt->varLookupData)) == SVt_PVAV) {
- SvREFCNT_dec((SV *)ctxt->varLookupData);
- }
-
- xmlXPathFreeContext(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);
}
void
@@ -261,13 +481,14 @@
INIT:
xmlXPathContextPtr ctxt = (xmlXPathContextPtr)SvIV(SvRV(self));
CODE:
- if (ctxt->varLookupData != NULL
- && SvTYPE(SvRV((SV *)ctxt->varLookupData)) == SVt_PVAV) {
- RETVAL = *(av_fetch((AV *) SvRV((SV*)ctxt->varLookupData),1,0 ));
- SvREFCNT_inc(RETVAL);
+ 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);
} else {
- RETVAL = &PL_sv_undef;
- }
+ RETVAL = &PL_sv_undef;
+ }
OUTPUT:
RETVAL
@@ -281,13 +502,13 @@
SV * lookup_data
PREINIT:
xmlXPathContextPtr ctxt = NULL;
- SV* pfdr;
+ SV* pfdr;
INIT:
ctxt = (xmlXPathContextPtr)SvIV(SvRV(pxpath_context));
if ( ctxt == NULL ) {
croak( "missing xpath context" );
}
- if ( SvTYPE(SvRV(lookup_func)) == SVt_PVCV ) {
+ 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));
@@ -295,20 +516,72 @@
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" );
+ if (ctxt->varLookupData==NULL || ctxt->varLookupData != pfdr) {
+ croak( "registrating failed\n" );
}
+void
+registerFunctionNS( pxpath_context, name, uri, func)
+ SV * pxpath_context
+ char * name
+ char * uri
+ SV * func
+ PREINIT:
+ xmlXPathContextPtr ctxt = NULL;
+ SV * pfdr;
+ SV * key;
+ STRLEN len;
+ char *strkey;
+
+ INIT:
+ ctxt = (xmlXPathContextPtr)SvIV(SvRV(pxpath_context));
+ if ( ctxt == NULL ) {
+ 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 (uri && *uri) {
+ sv_catpv(key, "{");
+ sv_catpv(key, (const char*)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 (uri && *uri) {
+ /* warn("Registering function with NS '%s' (uri: %s)\n", name, uri); */
+ xmlXPathRegisterFuncNS(ctxt, name, uri, 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.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- XPathContext.pm 14 Mar 2003 16:12:40 -0000 1.2
+++ XPathContext.pm 14 Mar 2003 16:23:51 -0000 1.3
@@ -3,7 +3,7 @@
package XML::LibXML::XPathContext;
use strict;
-use vars qw($VERSION @ISA);
+use vars qw($VERSION @ISA $USE_LIBXML_DATA_TYPES);
use XML::LibXML::NodeList;
@@ -14,6 +14,10 @@
bootstrap XML::LibXML::XPathContext $VERSION;
+# should LibXML XPath data types be used for simple objects
+# when passing parameters to extension functions (default: no)
+$USE_LIBXML_DATA_TYPES = 0;
+
sub findnodes {
my ($self, $xpath) = @_;
my @nodes = $self->_findnodes($xpath);
@@ -45,6 +49,43 @@
}
return undef;
}
+
+sub registerFunction {
+ my ($self, $name, $sub)=@_;
+ $self->registerFunctionNS($name,undef,$sub);
+ return;
+}
+
+# extension function perl dispatcher
+# borrowed from XML::LibXSLT
+
+sub perl_dispatcher {
+ my $func = shift;
+ my @params = @_;
+ my @perlParams;
+
+ my $i = 0;
+ while (@params) {
+ my $type = shift(@params);
+ if ($type eq 'XML::LibXML::Literal' or
+ $type eq 'XML::LibXML::Number' or
+ $type eq 'XML::LibXML::Boolean')
+ {
+ my $val = shift(@params);
+ unshift(@perlParams, $USE_LIBXML_DATA_TYPES ? $type->new($val) : $val);
+ }
+ elsif ($type eq 'XML::LibXML::NodeList') {
+ my $node_count = shift(@params);
+ unshift(@perlParams, $type->new(splice(@params, 0, $node_count)));
+ }
+ }
+
+ $func = "main::$func" unless ref($func) || $func =~ /(.+)::/;
+ no strict 'refs';
+ my $res = $func->(@perlParams);
+ return $res;
+}
+
1;
|
