Menu
▾
▴
[perl-xml-cvs] CVS: XML-LibXML-XPathContext perl-libxml-mm.c,1.2,1.3 XPathContext.xs,1.36,1.37 XPathContext.pm,1.30,1.31 README,1.6,1.7 Changes,1.12,1.13
|
From: Petr P. <pa...@us...> - 2003-11-03 18:09:41
|
Update of /cvsroot/perl-xml/XML-LibXML-XPathContext
In directory sc8-pr-cvs1:/tmp/cvs-serv27421
Modified Files:
perl-libxml-mm.c XPathContext.xs XPathContext.pm README
Changes
Log Message:
* simplified variable lookup code to use a C structure instead of
a perl AV*
* made XPathContext reentrant (by saving the state before
a callback and restoring it afterwards).
* added get/setContextSize, get/setContextPosition
* added getVarLookupFunc
* added some tests and documentation for the new features
* applied last LibXML patch for perl-libxml-mm.c
Index: perl-libxml-mm.c
===================================================================
RCS file: /cvsroot/perl-xml/XML-LibXML-XPathContext/perl-libxml-mm.c,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- perl-libxml-mm.c 20 May 2003 15:25:50 -0000 1.2
+++ perl-libxml-mm.c 3 Nov 2003 18:09:38 -0000 1.3
@@ -5,7 +5,7 @@
* 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
+ * the core module in order to avoid cascades of c pragmas
*/
#ifdef __cplusplus
@@ -28,6 +28,7 @@
#include <libgdome/gdome-libxml-util.h>
#endif
+
#include "perl-libxml-sax.h"
#ifdef __cplusplus
@@ -132,7 +133,7 @@
#define xpc_PmmENCODING(node) node->encoding
#define xpc_PmmNodeEncoding(node) ((xpc_ProxyNodePtr)(node->_private))->encoding
-
+#define xpc_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.
*/
@@ -142,7 +143,7 @@
xpc_ProxyNodePtr proxy = NULL;
if ( node == NULL ) {
- warn( "no node found\n" );
+ xs_warn( "no node found\n" );
return NULL;
}
@@ -173,9 +174,12 @@
frag = xmlNewDocFragment( doc );
retval = xpc_PmmNewNode(frag);
- if ( doc ) {
+ if ( doc != NULL ) {
xs_warn("inc document\n");
- xpc_PmmREFCNT_inc(((xpc_ProxyNodePtr)doc->_private));
+ /* under rare circumstances _private is not set correctly? */
+ if ( doc->_private != NULL ) {
+ xpc_PmmREFCNT_inc(((xpc_ProxyNodePtr)doc->_private));
+ }
retval->owner = (xmlNodePtr)doc;
}
@@ -203,7 +207,7 @@
}
break;
case XML_DTD_NODE:
- if ( node->doc ) {
+ if ( node->doc != NULL ) {
if ( node->doc->extSubset != (xmlDtdPtr)node
&& node->doc->intSubset != (xmlDtdPtr)node ) {
xs_warn( "PFN: XML_DTD_NODE\n");
@@ -233,7 +237,7 @@
xpc_ProxyNodePtr owner = NULL;
int retval = 0;
- if ( node ) {
+ if ( node != NULL ) {
retval = xpc_PmmREFCNT(node)--;
if ( xpc_PmmREFCNT(node) <= 0 ) {
xs_warn( "NODE DELETATION\n" );
@@ -305,7 +309,7 @@
xs_warn(" return new perl node\n");
xs_warn( CLASS );
- if ( node->_private ) {
+ if ( node->_private != NULL ) {
dfProxy = xpc_PmmNewNode(node);
}
else {
@@ -467,7 +471,7 @@
void
xpc_PmmFixOwnerList( xmlNodePtr list, xpc_ProxyNodePtr parent )
{
- if ( list ) {
+ if ( list != NULL ) {
xmlNodePtr iterator = list;
while ( iterator != NULL ) {
switch ( iterator->type ) {
@@ -528,7 +532,7 @@
break;
}
- if ( xpc_PmmOWNER(nodetofix) ) {
+ if ( xpc_PmmOWNER(nodetofix) != NULL ) {
oldParent = xpc_PmmOWNERPO(nodetofix);
}
@@ -546,7 +550,7 @@
xpc_PmmOWNER(nodetofix) = NULL;
}
- if ( oldParent && oldParent != nodetofix )
+ if ( oldParent != NULL && oldParent != nodetofix )
xpc_PmmREFCNT_dec(oldParent);
if ( xpc_PmmNODE(nodetofix)->type != XML_ATTRIBUTE_NODE
@@ -605,7 +609,7 @@
{
xmlParserCtxtPtr libnode = NULL;
int retval = 0;
- if ( node ) {
+ if ( node != NULL ) {
retval = xpc_PmmREFCNT(node)--;
if ( xpc_PmmREFCNT(node) <= 0 ) {
xs_warn( "NODE DELETATION\n" );
@@ -689,21 +693,19 @@
xmlChar *retval = NULL;
xmlBufferPtr in = NULL, out = NULL;
- if ( charset == 1 ) {
+ if ( charset == XML_CHAR_ENCODING_UTF8 ) {
/* warn("use UTF8 for encoding ... %s ", string); */
- return xmlStrdup( string );
- }
-
- if ( charset > 1 ) {
- /* warn( "use document encoding %s (%d)", encoding, charset ); */
- coder= xmlGetCharEncodingHandler( charset );
- }
+ return xmlStrdup( string );
+ }
else if ( charset == XML_CHAR_ENCODING_ERROR ){
/* warn("no standard encoding %s\n", encoding); */
coder =xmlFindCharEncodingHandler( (const char *)encoding );
}
- else {
+ else if ( charset == XML_CHAR_ENCODING_NONE ){
xs_warn("no encoding found \n");
+ } else {
+ /* warn( "use document encoding %s (%d)", encoding, charset ); */
+ coder= xmlGetCharEncodingHandler( charset );
}
if ( coder != NULL ) {
@@ -716,7 +718,7 @@
/* warn( "encoded string is %s" , retval); */
}
else {
- xs_warn( "b0rked encoiding!\n");
+ /* warn( "b0rked encoiding!\n"); */
}
xmlBufferFree( in );
@@ -735,21 +737,16 @@
xmlChar *retval = NULL;
xmlBufferPtr in = NULL, out = NULL;
- if ( charset == 1 ) {
-
- return xmlStrdup( string );
- }
-
- if ( charset > 1 ) {
- /* warn( "use document encoding %s", encoding ); */
- coder= xmlGetCharEncodingHandler( charset );
- }
+ if ( charset == XML_CHAR_ENCODING_UTF8 ) {
+ return xmlStrdup( string );
+ }
else if ( charset == XML_CHAR_ENCODING_ERROR ){
- /* warn("no standard encoding\n"); */
- coder = xmlFindCharEncodingHandler( (const char *) encoding );
+ coder =xmlFindCharEncodingHandler( (const char *)encoding );
}
- else {
- xs_warn("no encoding found\n");
+ else if ( charset == XML_CHAR_ENCODING_NONE ){
+ xs_warn("no encoding found \n");
+ } else {
+ coder= xmlGetCharEncodingHandler( charset );
}
if ( coder != NULL ) {
@@ -759,7 +756,7 @@
xmlBufferCat( in, string );
if ( xmlCharEncOutFunc( coder, out, in ) >= 0 ) {
- retval = xmlStrdup(out->content);
+ retval = xmlCharStrndup(xmlBufferContent(out), xmlBufferLength(out));
}
else {
xs_warn("decoding error \n");
@@ -805,7 +802,6 @@
xpc_PmmDecodeString( const char *encoding, const xmlChar *string){
char *ret=NULL;
xmlCharEncoding enc;
- xmlBufferPtr in = NULL, out = NULL;
xmlCharEncodingHandlerPtr coder = NULL;
if ( string != NULL ) {
@@ -913,14 +909,23 @@
if ( refnode != NULL ) {
xmlDocPtr real_doc = refnode->doc;
- if ( real_doc && real_doc->encoding != NULL ) {
+ if ( real_doc != NULL && real_doc->encoding != NULL ) {
- xmlChar * decoded = xpc_PmmFastDecodeString( xpc_PmmNodeEncoding(real_doc) ,
- (const xmlChar *)string,
- (const xmlChar*)real_doc->encoding);
+ xmlChar * decoded = xpc_PmmDecodeString( (const xmlChar*)real_doc->encoding,
+ (const xmlChar *)string );
len = xmlStrlen( decoded );
- if ( real_doc->charset == XML_CHAR_ENCODING_UTF8 ) {
+ if ( xpc_PmmDocEncoding(real_doc) == XML_CHAR_ENCODING_UTF8
+ /* most probably true, since libxml2 always
+ * sets doc->charset to UTF8, see tree.c:
+ *
+ * The in memory encoding is always UTF8
+ * This field will never change and would
+ * be obsolete if not for binary compatibility.
+ */
+
+ && (real_doc->encoding == NULL ||
+ xmlParseCharEncoding(real_doc->encoding)==XML_CHAR_ENCODING_UTF8 )) {
/* create an UTF8 string. */
xs_warn("set UTF8 string");
/* create the SV */
@@ -960,7 +965,7 @@
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 */
-#ifdef HAVE_UTF8
+
if ( refnode != NULL ) {
xmlDocPtr real_dom = refnode->doc;
xs_warn("have node!");
@@ -976,15 +981,17 @@
xs_warn( "no undefs" );
#ifdef HAVE_UTF8
xs_warn( "use UTF8" );
- if( !DO_UTF8(scalar) && real_dom->encoding != NULL ) {
+ if( !DO_UTF8(scalar) && real_dom != NULL && real_dom->encoding != NULL ) {
xs_warn( "string is not UTF8\n" );
#else
- if ( real_dom->encoding != NULL ) {
+ if ( real_dom != NULL && real_dom->encoding != NULL ) {
#endif
xs_warn( "xpc_domEncodeString!" );
- ts= xpc_PmmFastEncodeString( xpc_PmmNodeEncoding(real_dom),
- string,
- (const xmlChar*)real_dom->encoding );
+ /* if ( string == NULL || *string == 0 ) warn("string is empty" ); */
+
+ ts= xpc_PmmEncodeString( (const xmlChar*)real_dom->encoding,
+ string );
+
xs_warn( "done!" );
if ( string != NULL ) {
xmlFree(string);
@@ -995,7 +1002,7 @@
xs_warn( "no encoding set, use UTF8!\n" );
}
}
- if ( string == NULL ) xs_warn( "string is NULL\n" );
+ /* if ( string == NULL ) warn( "string is NULL\n" ); */
return string;
}
else {
@@ -1008,7 +1015,6 @@
}
}
xs_warn("no encoding !!");
-#endif
return xpc_Sv2C( scalar, NULL );
}
Index: XPathContext.xs
===================================================================
RCS file: /cvsroot/perl-xml/XML-LibXML-XPathContext/XPathContext.xs,v
retrieving revision 1.36
retrieving revision 1.37
diff -u -d -r1.36 -r1.37
--- XPathContext.xs 21 Sep 2003 10:05:05 -0000 1.36
+++ XPathContext.xs 3 Nov 2003 18:09:38 -0000 1.37
@@ -25,7 +25,9 @@
static SV * xpc_LibXML_error = NULL;
-#define xpc_LibXML_init_error() xpc_LibXML_error = NEWSV(0, 512); \
+/* NEWSV(0, 512); \ */
+#define xpc_LibXML_init_error() if (xpc_LibXML_error == NULL || !SvOK(xpc_LibXML_error)) \
+ xpc_LibXML_error = NEWSV(0,512); \
sv_setpvn(xpc_LibXML_error, "", 0); \
xmlSetGenericErrorFunc( NULL , \
(xmlGenericErrorFunc)xpc_LibXML_error_handler);
@@ -36,8 +38,10 @@
struct _XPathContextData {
SV* node;
- int lock;
+ int lock; /* currently unnecessary */
HV* pool;
+ SV* varLookup;
+ SV* varData;
};
typedef struct _XPathContextData XPathContextData;
typedef XPathContextData* XPathContextDataPtr;
@@ -185,6 +189,61 @@
}
+/* save XPath context and XPathContextDATA for recursion */
+static xmlXPathContextPtr
+xpc_LibXML_save_context(xmlXPathContextPtr ctxt)
+{
+ xmlXPathContextPtr copy;
+ copy = xmlMalloc(sizeof(xmlXPathContext));
+ if (copy) {
+ /* backup ctxt */
+ memcpy(copy, ctxt, sizeof(xmlXPathContext));
+ /* clear namespaces so that they are not freed and overwritten
+ by configure_namespaces */
+ ctxt->namespaces = NULL;
+ /* backup data */
+ XPathContextDATA(copy) = xmlMalloc(sizeof(XPathContextData));
+ if (XPathContextDATA(copy)) {
+ memcpy(XPathContextDATA(copy), XPathContextDATA(ctxt),sizeof(XPathContextData));
+ /* clear ctxt->pool, so that it is not used freed during re-entrance */
+ XPathContextDATA(ctxt)->pool = NULL;
+ }
+ }
+ return copy;
+}
+
+/* restore XPath context and XPathContextDATA from a saved copy */
+static void
+xpc_LibXML_restore_context(xmlXPathContextPtr ctxt, xmlXPathContextPtr copy)
+{
+ /* cleanup */
+ if (XPathContextDATA(ctxt)) {
+ /* cleanup newly created pool */
+ if (XPathContextDATA(ctxt)->pool != NULL &&
+ SvOK(XPathContextDATA(ctxt)->pool)) {
+ SvREFCNT_dec((SV *)XPathContextDATA(ctxt)->pool);
+ }
+ }
+ if (ctxt->namespaces) {
+ /* free namespaces allocated during recursion */
+ xmlFree( ctxt->namespaces );
+ }
+
+ /* restore context */
+ if (copy) {
+ /* 1st restore our data */
+ if (XPathContextDATA(copy)) {
+ memcpy(XPathContextDATA(ctxt),XPathContextDATA(copy),sizeof(XPathContextData));
+ xmlFree(XPathContextDATA(copy));
+ XPathContextDATA(copy) = XPathContextDATA(ctxt);
+ }
+ /* now copy the rest */
+ memcpy(ctxt, copy, sizeof(xmlXPathContext));
+ xmlFree(copy);
+ }
+}
+
+
/* ****************************************************************
* Variable Lookup
* **************************************************************** */
@@ -195,37 +254,40 @@
const xmlChar *ns_uri)
{
xmlXPathObjectPtr ret;
- SV ** lookup_func;
- SV ** lookup_data;
+ xmlXPathContextPtr ctxt;
+ xmlXPathContextPtr copy;
+ XPathContextDataPtr data;
I32 count;
dSP;
- SV * data;
- SV ** fetch;
- data = (SV *) varLookupData;
- if (varLookupData == NULL || !SvROK(data) ||
- SvTYPE(SvRV(data)) != SVt_PVAV) {
- croak("XPathContext: lost variable lookup data structure!");
- }
-
- lookup_func = av_fetch((AV *) SvRV(data),0,0 );
- if ( lookup_func == NULL || !SvROK(*lookup_func) || SvTYPE(SvRV(*lookup_func)) != SVt_PVCV ) {
+ ctxt = (xmlXPathContextPtr) varLookupData;
+ if ( ctxt == NULL )
+ croak("XPathContext: missing xpath context");
+ data = XPathContextDATA(ctxt);
+ if ( data == NULL )
+ croak("XPathContext: missing xpath context private data");
+ if ( data->varLookup == NULL || !SvROK(data->varLookup) ||
+ SvTYPE(SvRV(data->varLookup)) != SVt_PVCV )
croak("XPathContext: lost variable lookup function!");
- }
- lookup_data = av_fetch((AV *) SvRV(data),1,0 );
ENTER;
SAVETMPS;
PUSHMARK(SP);
- XPUSHs( (lookup_data != NULL) ? *lookup_data : &PL_sv_undef );
+ XPUSHs( (data->varData != NULL) ? data->varData : &PL_sv_undef );
XPUSHs(sv_2mortal(xpc_C2Sv(name,NULL)));
XPUSHs(sv_2mortal(xpc_C2Sv(ns_uri,NULL)));
- PUTBACK ;
- count = perl_call_sv(*lookup_func, G_SCALAR|G_EVAL);
+ /* save context to allow recursive usage of XPathContext */
+ copy = xpc_LibXML_save_context(ctxt);
+ PUTBACK ;
+ count = perl_call_sv(data->varLookup, G_SCALAR|G_EVAL);
SPAGAIN;
+
+ /* restore the xpath context */
+ xpc_LibXML_restore_context(ctxt, copy);
+
if (SvTRUE(ERRSV)) {
POPs;
croak("XPathContext: error coming back from variable lookup function. %s", SvPV_nolen(ERRSV));
@@ -260,6 +322,7 @@
SV **perl_function;
dSP;
SV * data;
+ xmlXPathContextPtr copy;
/* warn("entered xpc_LibXML_generic_extension_function for %s\n",ctxt->context->function); */
data = (SV *) ctxt->context->funcLookupData;
@@ -362,14 +425,18 @@
xmlXPathFreeObject(obj);
}
+ /* save context to allow recursive usage of XPathContext */
+ copy = xpc_LibXML_save_context(ctxt->context);
+
/* 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);
-
+ count = perl_call_sv(perl_dispatch, G_SCALAR|G_EVAL);
SPAGAIN;
+ /* restore the xpath context */
+ xpc_LibXML_restore_context(ctxt->context, copy);
+
if (SvTRUE(ERRSV)) {
POPs;
croak("XPathContext: error coming back from perl-dispatcher in pm file. %s", SvPV_nolen(ERRSV));
@@ -453,6 +520,8 @@
XPathContextDATA(ctxt)->lock = 0;
XPathContextDATA(ctxt)->pool = NULL;
+ XPathContextDATA(ctxt)->varLookup = NULL;
+ XPathContextDATA(ctxt)->varData = NULL;
xmlXPathRegisterFunc(ctxt,
(const xmlChar *) "document",
@@ -478,6 +547,14 @@
SvOK(XPathContextDATA(ctxt)->node)) {
SvREFCNT_dec(XPathContextDATA(ctxt)->node);
}
+ if (XPathContextDATA(ctxt)->varLookup != NULL &&
+ SvOK(XPathContextDATA(ctxt)->varLookup)) {
+ SvREFCNT_dec(XPathContextDATA(ctxt)->varLookup);
+ }
+ if (XPathContextDATA(ctxt)->varData != NULL &&
+ SvOK(XPathContextDATA(ctxt)->varData)) {
+ SvREFCNT_dec(XPathContextDATA(ctxt)->varData);
+ }
if (XPathContextDATA(ctxt)->pool != NULL &&
SvOK(XPathContextDATA(ctxt)->pool)) {
SvREFCNT_dec((SV *)XPathContextDATA(ctxt)->pool);
@@ -488,10 +565,6 @@
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);
@@ -517,6 +590,32 @@
OUTPUT:
RETVAL
+int
+getContextPosition( self )
+ SV * self
+ INIT:
+ xmlXPathContextPtr ctxt = (xmlXPathContextPtr)SvIV(SvRV(self));
+ if ( ctxt == NULL ) {
+ croak("XPathContext: missing xpath context");
+ }
+ CODE:
+ RETVAL = ctxt->proximityPosition;
+ OUTPUT:
+ RETVAL
+
+int
+getContextSize( self )
+ SV * self
+ INIT:
+ xmlXPathContextPtr ctxt = (xmlXPathContextPtr)SvIV(SvRV(self));
+ if ( ctxt == NULL ) {
+ croak("XPathContext: missing xpath context");
+ }
+ CODE:
+ RETVAL = ctxt->contextSize;
+ OUTPUT:
+ RETVAL
+
void
setContextNode( self , pnode )
SV * self
@@ -536,6 +635,38 @@
XPathContextDATA(ctxt)->node = NULL;
}
+void
+setContextPosition( self , position )
+ SV * self
+ int position
+ INIT:
+ xmlXPathContextPtr ctxt = (xmlXPathContextPtr)SvIV(SvRV(self));
+ if ( ctxt == NULL )
+ croak("XPathContext: missing xpath context");
+ if ( position < 0 || position > ctxt->contextSize )
+ croak("XPathContext: invalid position");
+ PPCODE:
+ ctxt->proximityPosition = position;
+
+void
+setContextSize( self , size )
+ SV * self
+ int size
+ INIT:
+ xmlXPathContextPtr ctxt = (xmlXPathContextPtr)SvIV(SvRV(self));
+ if ( ctxt == NULL )
+ croak("XPathContext: missing xpath context");
+ if ( size < -1 )
+ croak("XPathContext: invalid size");
+ PPCODE:
+ ctxt->contextSize = size;
+ if ( size == 0 )
+ ctxt->proximityPosition = 0;
+ else if ( size > 0 )
+ ctxt->proximityPosition = 1;
+ else
+ ctxt->proximityPosition = -1;
+
void
registerNs( pxpath_context, prefix, ns_uri )
SV * pxpath_context
@@ -583,23 +714,30 @@
getVarLookupData( self )
SV * self
INIT:
- SV ** lookup_data;
xmlXPathContextPtr ctxt = (xmlXPathContextPtr)SvIV(SvRV(self));
if ( ctxt == NULL ) {
croak("XPathContext: missing xpath context");
}
- xpc_LibXML_configure_xpathcontext(ctxt);
CODE:
- if (ctxt->varLookupData != NULL &&
- SvROK((SV*)(ctxt->varLookupData)) &&
- SvTYPE(SvRV((SV*)(ctxt->varLookupData))) == SVt_PVAV) {
- lookup_data = av_fetch((AV *) SvRV((SV*)(ctxt->varLookupData)),1,0);
- if (lookup_data != NULL) {
- SvREFCNT_inc(*lookup_data);
- RETVAL = *lookup_data;
- } else {
- RETVAL = &PL_sv_undef;
- }
+ if(XPathContextDATA(ctxt)->varData != NULL) {
+ RETVAL = newSVsv(XPathContextDATA(ctxt)->varData);
+ } else {
+ RETVAL = &PL_sv_undef;
+ }
+ OUTPUT:
+ RETVAL
+
+SV*
+getVarLookupFunc( self )
+ SV * self
+ INIT:
+ xmlXPathContextPtr ctxt = (xmlXPathContextPtr)SvIV(SvRV(self));
+ if ( ctxt == NULL ) {
+ croak("XPathContext: missing xpath context");
+ }
+ CODE:
+ if(XPathContextDATA(ctxt)->varData != NULL) {
+ RETVAL = newSVsv(XPathContextDATA(ctxt)->varLookup);
} else {
RETVAL = &PL_sv_undef;
}
@@ -613,38 +751,37 @@
SV * lookup_data
PREINIT:
xmlXPathContextPtr ctxt = NULL;
+ XPathContextDataPtr data = NULL;
SV* pfdr;
INIT:
ctxt = (xmlXPathContextPtr)SvIV(SvRV(pxpath_context));
- if ( ctxt == NULL ) {
+ if ( ctxt == NULL )
croak("XPathContext: missing xpath context");
- }
+ data = XPathContextDATA(ctxt);
+ if ( data == NULL )
+ croak("XPathContext: missing xpath context private data");
xpc_LibXML_configure_xpathcontext(ctxt);
+ /* free previous lookup function and data */
+ if (data->varLookup && SvOK(data->varLookup))
+ SvREFCNT_dec(data->varLookup);
+ if (data->varData && SvOK(data->varData))
+ SvREFCNT_dec(data->varData);
+ data->varLookup=NULL;
+ data->varData=NULL;
+ PPCODE:
if (SvOK(lookup_func)) {
if ( SvROK(lookup_func) && SvTYPE(SvRV(lookup_func)) == SVt_PVCV ) {
- pfdr = newRV_inc((SV*) newAV());
- av_push((AV *)SvRV(pfdr), newSVsv(lookup_func));
- av_push((AV *)SvRV(pfdr), newSVsv(lookup_data));
+ data->varLookup = newSVsv(lookup_func);
+ if (SvOK(lookup_data))
+ data->varData = newSVsv(lookup_data);
+ xmlXPathRegisterVariableLookup(ctxt,
+ xpc_LibXML_generic_variable_lookup, ctxt);
+ if (ctxt->varLookupData==NULL || ctxt->varLookupData != ctxt) {
+ croak( "XPathContext: registration failure" );
+ }
} else {
croak("XPathContext: 1st argument is not a CODE reference");
}
- }
- if (ctxt->varLookupData != NULL) {
- /* free previous lookup data */
- if (SvTYPE(SvRV((SV *)ctxt->varLookupData)) == SVt_PVAV) {
- SvREFCNT_dec((SV *)ctxt->varLookupData);
- ctxt->varLookupData = NULL;
- ctxt->varLookupFunc = NULL;
- } else {
- croak("XPathContext: cannot register: varLookupData slot already occupied");
- }
- }
- PPCODE:
- if (SvOK(lookup_func)) {
- xmlXPathRegisterVariableLookup(ctxt, xpc_LibXML_generic_variable_lookup, pfdr);
- if (ctxt->varLookupData==NULL || ctxt->varLookupData != pfdr) {
- croak( "XPathContext: registration failure" );
- }
} else {
/* unregister */
xmlXPathRegisterVariableLookup(ctxt, NULL, NULL);
@@ -801,7 +938,6 @@
}
xmlFree(xpath);
- sv_2mortal( xpc_LibXML_error );
xpc_LibXML_croak_error();
if ( nodelist ) {
@@ -896,7 +1032,6 @@
xmlFree( xpath );
- sv_2mortal( xpc_LibXML_error );
xpc_LibXML_croak_error();
if (found) {
Index: XPathContext.pm
===================================================================
RCS file: /cvsroot/perl-xml/XML-LibXML-XPathContext/XPathContext.pm,v
retrieving revision 1.30
retrieving revision 1.31
diff -u -d -r1.30 -r1.31
--- XPathContext.pm 22 Sep 2003 08:02:56 -0000 1.30
+++ XPathContext.pm 3 Nov 2003 18:09:38 -0000 1.31
@@ -7,7 +7,7 @@
use XML::LibXML::NodeList;
-$VERSION = '0.05';
+$VERSION = '0.06';
require DynaLoader;
@ISA = qw(DynaLoader);
@@ -55,15 +55,15 @@
$prev_node = $self->getContextNode();
$self->setContextNode($node);
}
- $self->_enter;
+# $self->_enter; # lock
my @ret;
eval {
@ret = $self->$method($xpath);
};
- $self->_leave;
+ $self->_leave; # unlock and free node-pool
$self->setContextNode($prev_node) if ref($node);
- if ($@) { die $@; }
+ if ($@) { die "ERROR: $@"; }
return @ret;
}
@@ -147,6 +147,11 @@
my $node = $xc->getContextNode;
$xc->setContextNode($node);
+ my $position = $xc->getContextPosition;
+ $xc->setContextPosition($position);
+ my $size = $xc->getContextSize;
+ $xc->setContextSize($size);
+
$xc->registerNs($prefix, $namespace_uri);
$xc->unregisterNs($prefix);
my $namespace_uri = $xc->lookupNs($prefix);
@@ -158,6 +163,8 @@
$xc->registerVarLookupFunc(sub { ... }, $data);
$xc->unregisterVarLookupFunc($name);
+ $data = $xc->getVarLookupData();
+ $sub = $xc->getVarLookupFunc();
my @nodes = $xc->findnodes($xpath);
my @nodes = $xc->findnodes($xpath, $context_node);
@@ -191,6 +198,10 @@
defining variable lookup functions in Perl.
+=item 3
+
+cheating the context about current proximity position and context size
+
=back
=head1 EXAMPLES
@@ -369,20 +380,49 @@
Set the current context node.
-=back
+=item B<setContextPosition($position)>
-=head1 BUGS AND CAVEATS
+Set the current proximity position. By default, this value is -1 (and
+evaluating XPath function position() in the initial context raises an
+XPath error), but can be set to any value up to context size. This
+usually only serves to cheat the XPath engine to return given position
+when position() XPath function is called. Setting this value to -1
+restores the default behavior.
-XML::LibXML::XPathContext objects are not reentrant. It means you
-cannot register a Perl function with a XML::LibXML::XPathContext
-object if this Perl function uses itself the same
-XML::LibXML::XPathContext object internally.
+=item B<getContextPosition()>
-For example, the following code will not work:
+Get the current proximity position.
- my $xc = XML::LibXML::XPathContext->new($node);
- $xc->registerFunction('func', sub { $xc->findvalue('1') });
- my $result = $xc->findvalue('func()');
+=item B<setContextSize($size)>
+
+Set the current size. By default, this value is -1 (and evaluating
+XPath function last() in the initial context raises an XPath error),
+but can be set to any non-negative value. This usually only serves to
+cheat the XPath engine to return the given value when last() XPath
+function is called. If context size is set to 0, position is
+automatically also set to 0. If context size is positive, position is
+automatically set to 1. Setting context size to -1 restores the
+default behavior.
+
+=item B<getContextPosition()>
+
+Get the current proximity position.
+
+=item B<setContextNode($node)>
+
+Set the current context node.
+
+=back
+
+=head1 BUGS AND CAVEATS
+
+From version 0.06, XML::LibXML::XPathContext objects B<are> reentrant,
+meaning that you can call methods of an XML::LibXML::XPathContext even
+from XPath extension functions registered with the same object or from
+a variable lookup function. On the other hand, you should rather
+avoid registering new extension functions, namespaces and a variable
+lookup function from within extension functions and a variable lookup
+function, unless you want to experience untested behavior.
=head1 AUTHORS
Index: README
===================================================================
RCS file: /cvsroot/perl-xml/XML-LibXML-XPathContext/README,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -d -r1.6 -r1.7
--- README 25 Jul 2003 12:51:03 -0000 1.6
+++ README 3 Nov 2003 18:09:38 -0000 1.7
@@ -10,6 +10,11 @@
my $node = $xc->getContextNode;
$xc->setContextNode($node);
+ my $position = $xc->getContextPosition;
+ $xc->setContextPosition($position);
+ my $size = $xc->getContextSize;
+ $xc->setContextSize($size);
+
$xc->registerNs($prefix, $namespace_uri);
$xc->unregisterNs($prefix);
my $namespace_uri = $xc->lookupNs($prefix);
@@ -21,6 +26,8 @@
$xc->registerVarLookupFunc(sub { ... }, $data);
$xc->unregisterVarLookupFunc($name);
+ $data = $xc->getVarLookupData();
+ $sub = $xc->getVarLookupFunc();
my @nodes = $xc->findnodes($xpath);
my @nodes = $xc->findnodes($xpath, $context_node);
@@ -43,6 +50,9 @@
3 defining variable lookup functions in Perl.
+ 3 cheating the context about current proximity position and context
+ size
+
EXAMPLES
Find all paragraph nodes in XHTML document
This example demonstrates *registerNs()* usage:
@@ -190,17 +200,41 @@
setContextNode($node)
Set the current context node.
-BUGS AND CAVEATS
- XML::LibXML::XPathContext objects are not reentrant. It means you cannot
- register a Perl function with a XML::LibXML::XPathContext object if this
- Perl function uses itself the same XML::LibXML::XPathContext object
- internally.
+ setContextPosition($position)
+ Set the current proximity position. By default, this value is -1
+ (and evaluating XPath function position() in the initial context
+ raises an XPath error), but can be set to any value up to context
+ size. This usually only serves to cheat the XPath engine to return
+ given position when position() XPath function is called. Setting
+ this value to -1 restores the default behavior.
- For example, the following code will not work:
+ getContextPosition()
+ Get the current proximity position.
- my $xc = XML::LibXML::XPathContext->new($node);
- $xc->registerFunction('func', sub { $xc->findvalue('1') });
- my $result = $xc->findvalue('func()');
+ setContextSize($size)
+ Set the current size. By default, this value is -1 (and evaluating
+ XPath function last() in the initial context raises an XPath error),
+ but can be set to any non-negative value. This usually only serves
+ to cheat the XPath engine to return the given value when last()
+ XPath function is called. If context size is set to 0, position is
+ automatically also set to 0. If context size is positive, position
+ is automatically set to 1. Setting context size to -1 restores the
+ default behavior.
+
+ getContextPosition()
+ Get the current proximity position.
+
+ setContextNode($node)
+ Set the current context node.
+
+BUGS AND CAVEATS
+ From version 0.06, XML::LibXML::XPathContext objects are reentrant,
+ meaning that you can call methods of an XML::LibXML::XPathContext even
+ from XPath extension functions registered with the same object or from a
+ variable lookup function. On the other hand, you should rather avoid
+ registering new extension functions, namespaces and a variable lookup
+ function from within extension functions and a variable lookup function,
+ unless you want to experience untested behavior.
AUTHORS
Based on XML::LibXML and XML::XSLT code by Matt Sergeant and Christian
Index: Changes
===================================================================
RCS file: /cvsroot/perl-xml/XML-LibXML-XPathContext/Changes,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -d -r1.12 -r1.13
--- Changes 22 Sep 2003 08:02:26 -0000 1.12
+++ Changes 3 Nov 2003 18:09:38 -0000 1.13
@@ -2,6 +2,22 @@
Revision history for Perl module XML::LibXML::XPathContext.
+0.06 Mon Nov 3 2003
+
+* simplified variable lookup code to use a C structure instead of
+ a perl AV*
+
+* made XPathContext reentrant (by saving the state before
+ a callback and restoring it afterwards).
+
+* added get/setContextSize, get/setContextPosition
+
+* added getVarLookupFunc
+
+* added some tests and documentation for the new features
+
+* applied last LibXML patch for perl-libxml-mm.c
+
0.05 Mon Sep 22 2003
* lookupNs() method added
|