|
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
|