From: Petr P. <pa...@us...> - 2003-03-14 16:12:45
|
Update of /cvsroot/perl-xml/XML-LibXML-XPathContext In directory sc8-pr-cvs1:/tmp/cvs-serv15544 Modified Files: XPathContext.xs XPathContext.pm Log Message: added variable lookup support Index: XPathContext.xs =================================================================== RCS file: /cvsroot/perl-xml/XML-LibXML-XPathContext/XPathContext.xs,v retrieving revision 1.1.1.1 retrieving revision 1.2 diff -u -d -r1.1.1.1 -r1.2 --- XPathContext.xs 14 Mar 2003 14:32:00 -0000 1.1.1.1 +++ XPathContext.xs 14 Mar 2003 16:12:39 -0000 1.2 @@ -60,6 +60,126 @@ SvREFCNT_dec(sv); } +/* **************************************************************** + * Variable Lookup + * **************************************************************** */ +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"); + } + + lookup_func = *(av_fetch((AV *) SvRV(data),0,0 )); + lookup_data = *(av_fetch((AV *) SvRV(data),1,0 )); + + ENTER; + SAVETMPS; + PUSHMARK(SP); + + 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); + + 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"); + + 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: + + PUTBACK; + FREETMPS; + LEAVE; + return ret; +} + + MODULE = XML::LibXML::XPathContext PACKAGE = XML::LibXML::XPathContext SV* @@ -108,6 +228,10 @@ 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); } @@ -130,6 +254,60 @@ if(ret == -1) { croak( "cannot register ns" ); } + +SV* +getVarLookupData( self ) + SV * self + 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); + } else { + RETVAL = &PL_sv_undef; + } + + OUTPUT: + RETVAL + + + +void +registerVarLookupFunc( pxpath_context, lookup_func, lookup_data ) + SV * pxpath_context + SV * lookup_func + SV * lookup_data + PREINIT: + xmlXPathContextPtr ctxt = NULL; + SV* pfdr; + INIT: + ctxt = (xmlXPathContextPtr)SvIV(SvRV(pxpath_context)); + if ( ctxt == NULL ) { + croak( "missing xpath context" ); + } + if ( 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)); + } 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"); + } + } + PPCODE: + xmlXPathRegisterVariableLookup(ctxt, LibXML_generic_variable_lookup, pfdr); + if (ctxt->varLookupData==NULL || ctxt->varLookupData != pfdr) { + croak( "registrating failed\n" ); + } void Index: XPathContext.pm =================================================================== RCS file: /cvsroot/perl-xml/XML-LibXML-XPathContext/XPathContext.pm,v retrieving revision 1.1.1.1 retrieving revision 1.2 diff -u -d -r1.1.1.1 -r1.2 --- XPathContext.pm 14 Mar 2003 14:32:04 -0000 1.1.1.1 +++ XPathContext.pm 14 Mar 2003 16:12:40 -0000 1.2 @@ -87,6 +87,20 @@ Registers namespace I<$prefix> to I<$namespace_uri>. +=item B<registerVarLookupFunc($callback, $data)> + +Registers variable lookup function I<$prefix>. The registered function +is executed by the XPath engine each time an XPath variable is +evaluated. It takes three arguments: I<$data>, variable name, and +variable ns-URI and must return one value: a number or string or any +XML::LibXML object that can be a result of findnodes: Boolean, +Literal, Number, Node (e.g. Document, Element, etc.), or NodeList. + +=item B<getVarLookupData()> + +Returns the data associated with a variable lookup function during a +previous call to I<registerVarLookupFunc>. + =item B<findnodes($xpath)> Performs the xpath statement on the current node and returns the |