Menu
▾
▴
perl-xml-commits — the list to which CVS commits go
You can subscribe to this list here.
| 2002 |
Jan
(8) |
Feb
(22) |
Mar
(3) |
Apr
(13) |
May
(1) |
Jun
(4) |
Jul
|
Aug
(5) |
Sep
(9) |
Oct
(36) |
Nov
(7) |
Dec
(15) |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 2003 |
Jan
(4) |
Feb
(1) |
Mar
(55) |
Apr
(25) |
May
(25) |
Jun
(4) |
Jul
(2) |
Aug
|
Sep
(12) |
Oct
(6) |
Nov
(14) |
Dec
(1) |
| 2004 |
Jan
(1) |
Feb
(8) |
Mar
(6) |
Apr
(5) |
May
|
Jun
|
Jul
|
Aug
(1) |
Sep
(1) |
Oct
(3) |
Nov
(11) |
Dec
|
| 2005 |
Jan
(14) |
Feb
(3) |
Mar
(4) |
Apr
(14) |
May
(1) |
Jun
|
Jul
(1) |
Aug
|
Sep
(1) |
Oct
(2) |
Nov
(2) |
Dec
(1) |
| 2006 |
Jan
|
Feb
|
Mar
|
Apr
(3) |
May
|
Jun
|
Jul
|
Aug
(1) |
Sep
(8) |
Oct
(19) |
Nov
(5) |
Dec
|
| 2007 |
Jan
(5) |
Feb
(1) |
Mar
|
Apr
(4) |
May
|
Jun
|
Jul
|
Aug
(8) |
Sep
|
Oct
|
Nov
|
Dec
|
| 2008 |
Jan
|
Feb
|
Mar
(2) |
Apr
|
May
|
Jun
|
Jul
(1) |
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
|
From: Petr P. <pa...@us...> - 2003-03-21 16:44:50
|
Update of /cvsroot/perl-xml/XML-LibXML-XPathContext
In directory sc8-pr-cvs1:/tmp/cvs-serv26795
Modified Files:
XPathContext.xs
Log Message:
- fixed SP bug in _find*
Index: XPathContext.xs
===================================================================
RCS file: /cvsroot/perl-xml/XML-LibXML-XPathContext/XPathContext.xs,v
retrieving revision 1.14
retrieving revision 1.15
diff -u -d -r1.14 -r1.15
--- XPathContext.xs 20 Mar 2003 17:10:01 -0000 1.14
+++ XPathContext.xs 21 Mar 2003 16:05:01 -0000 1.15
@@ -390,6 +390,7 @@
perl_result = POPs;
if (!SvOK(perl_result)) {
+ /* warn("result is a empty\n"); */
ret = (xmlXPathObjectPtr)xmlXPathNewCString("");
goto FINISH;
}
@@ -803,7 +804,11 @@
LibXML_init_error();
+
+ PUTBACK ;
nodelist = domXPathSelect( ctxt, xpath );
+ SPAGAIN ;
+
xmlFree(xpath);
sv_2mortal( LibXML_error );
@@ -840,7 +845,6 @@
else {
element = PmmNodeToSv(tnode, owner);
}
-
XPUSHs( sv_2mortal(element) );
}
}
@@ -879,6 +883,7 @@
croak( "empty XPath found" );
XSRETURN_UNDEF;
}
+
PPCODE:
if ( ctxt->node->doc ) {
domNodeNormalize( xmlDocGetRootElement( ctxt->node->doc ) );
@@ -889,7 +894,10 @@
LibXML_init_error();
+ PUTBACK ;
found = domXPathFind( ctxt, xpath );
+ SPAGAIN ;
+
xmlFree( xpath );
sv_2mortal( LibXML_error );
@@ -938,7 +946,6 @@
else {
element = PmmNodeToSv(tnode, owner);
}
-
XPUSHs( sv_2mortal(element) );
}
}
|
|
From: Petr P. <pa...@us...> - 2003-03-21 16:36:45
|
Update of /cvsroot/perl-xml/XML-LibXML-XPathContext/t
In directory sc8-pr-cvs1:/tmp/cvs-serv6905/t
Modified Files:
02-functions.t
Log Message:
- large nodelists test
Index: 02-functions.t
===================================================================
RCS file: /cvsroot/perl-xml/XML-LibXML-XPathContext/t/02-functions.t,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -d -r1.3 -r1.4
--- 02-functions.t 20 Mar 2003 17:10:00 -0000 1.3
+++ 02-functions.t 21 Mar 2003 16:27:49 -0000 1.4
@@ -1,6 +1,6 @@
# -*- cperl -*-
use Test;
-BEGIN { plan tests => 19 };
+BEGIN { plan tests => 22 };
use XML::LibXML;
use XML::LibXML::XPathContext;
@@ -67,9 +67,24 @@
$xc->registerFunction('new-chunk',
sub {
- XML::LibXML->new->parse_string('<x><a/><a/><a/></x>')->find('/x/*')
+ XML::LibXML->new->parse_string('<x><a/><a/><a/></x>')->find('//*')
});
-ok($xc->findnodes('new-chunk()')->size() == 3);
+ok($xc->findnodes('new-chunk()')->size() == 4);
my ($x)=$xc->findnodes('new-chunk()/parent::*');
ok($x->nodeName() eq 'x');
ok($xc->findvalue('name(new-chunk()/parent::*)') eq 'x');
+
+my $largedoc=XML::LibXML->new->parse_string('<a>'.('<b/>' x 3000).'</a>');
+$xc->setContextNode($largedoc);
+$xc->registerFunction('pass1',
+ sub {
+ [$largedoc->findnodes('(//*)')]
+ });
+$xc->registerFunction('pass2',sub { $_[0] } );
+$xc->registerVarLookupFunc( sub { [$largedoc->findnodes('(//*)')] }, undef);
+$largedoc->toString();
+
+ok($xc->find('$a[name()="b"]')->size()==3000);
+my @pass1=$xc->findnodes('pass1()');
+ok(@pass1==3001);
+ok($xc->find('pass2(//*)')->size()==3001);
|
|
From: Petr P. <pa...@us...> - 2003-03-20 17:10:35
|
Update of /cvsroot/perl-xml/XML-LibXML-XPathContext/t
In directory sc8-pr-cvs1:/tmp/cvs-serv28371/t
Modified Files:
02-functions.t
Log Message:
added node pool
Index: 02-functions.t
===================================================================
RCS file: /cvsroot/perl-xml/XML-LibXML-XPathContext/t/02-functions.t,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- 02-functions.t 20 Mar 2003 13:55:24 -0000 1.2
+++ 02-functions.t 20 Mar 2003 17:10:00 -0000 1.3
@@ -1,6 +1,6 @@
# -*- cperl -*-
use Test;
-BEGIN { plan tests => 15 };
+BEGIN { plan tests => 19 };
use XML::LibXML;
use XML::LibXML::XPathContext;
@@ -57,5 +57,19 @@
eval { $xc->findnodes('test-lock2()') };
ok($@);
+# function creating new nodes
+$xc->registerFunction('new-foo',
+ sub {
+ return $doc->createElement('foo');
+ });
+ok($xc->findnodes('new-foo()')->pop()->nodeName eq 'foo');
+my ($test_node) = $xc->findnodes('new-foo()');
-
+$xc->registerFunction('new-chunk',
+ sub {
+ XML::LibXML->new->parse_string('<x><a/><a/><a/></x>')->find('/x/*')
+ });
+ok($xc->findnodes('new-chunk()')->size() == 3);
+my ($x)=$xc->findnodes('new-chunk()/parent::*');
+ok($x->nodeName() eq 'x');
+ok($xc->findvalue('name(new-chunk()/parent::*)') eq 'x');
|
|
From: Petr P. <pa...@us...> - 2003-03-20 17:10:07
|
Update of /cvsroot/perl-xml/XML-LibXML-XPathContext
In directory sc8-pr-cvs1:/tmp/cvs-serv28371
Modified Files:
XPathContext.xs
Log Message:
added node pool
Index: XPathContext.xs
===================================================================
RCS file: /cvsroot/perl-xml/XML-LibXML-XPathContext/XPathContext.xs,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -d -r1.13 -r1.14
--- XPathContext.xs 20 Mar 2003 13:55:25 -0000 1.13
+++ XPathContext.xs 20 Mar 2003 17:10:01 -0000 1.14
@@ -72,6 +72,47 @@
}
/* ****************************************************************
+ * Temporary node pool
+ * **************************************************************** */
+
+/* Stores pnode in context node-pool hash table in order to preserve */
+/* at least one reference. */
+/* If pnode is NULL, only return current value for hashkey */
+static
+SV* LibXML_XPathContext_pool ( xmlXPathContextPtr ctxt, int hashkey, SV * pnode ) {
+ SV ** value;
+ HV * pool;
+ SV * key;
+ SV * pnode2;
+ STRLEN len;
+ char * strkey;
+
+ if (XPathContextDATA(ctxt)->pool == NULL) {
+ if (pnode == NULL) {
+ return &PL_sv_undef;
+ } else {
+ xs_warn("initializing node pool");
+ XPathContextDATA(ctxt)->pool = newHV();
+ }
+ }
+
+ key = newSViv(hashkey);
+ strkey = SvPV(key, len);
+ if (pnode != NULL && !hv_exists(XPathContextDATA(ctxt)->pool,strkey,len)) {
+ value = hv_store(XPathContextDATA(ctxt)->pool,strkey,len, SvREFCNT_inc(pnode),0);
+ } else {
+ value = hv_fetch(XPathContextDATA(ctxt)->pool,strkey,len, 0);
+ }
+ SvREFCNT_dec(key);
+
+ if (value == NULL) {
+ return &PL_sv_undef;
+ } else {
+ return *value;
+ }
+}
+
+/* ****************************************************************
* Variable Lookup
* **************************************************************** */
/* Much of the code is borrowed from Matt Sergeant's XML::LibXSLT */
@@ -370,6 +411,8 @@
sv_derived_from(*pnode,"XML::LibXML::Node")) {
xmlXPathNodeSetAdd(ret->nodesetval,
(xmlNodePtr)PmmSvNode(*pnode));
+ LibXML_XPathContext_pool(ctxt->context,
+ (int) PmmSvNode(*pnode), *pnode);
} else {
warn("XPathContext: ignoring non-node member of a nodelist");
}
@@ -383,6 +426,8 @@
ret = (xmlXPathObjectPtr)xmlXPathNewNodeSet(NULL);
tmp_node = (xmlNodePtr)PmmSvNode(perl_result);
xmlXPathNodeSetAdd(ret->nodesetval,tmp_node);
+ LibXML_XPathContext_pool(ctxt->context, (int) PmmSvNode(perl_result),
+ perl_result);
goto FINISH;
}
else if (sv_isa(perl_result, "XML::LibXML::Boolean")) {
@@ -717,6 +762,7 @@
XPathContextDATA(ctxt)->lock=0;
if (XPathContextDATA(ctxt)->pool != NULL) {
SvREFCNT_dec((SV *)XPathContextDATA(ctxt)->pool);
+ XPathContextDATA(ctxt)->pool = NULL;
}
void
|
|
From: Ilya M. <m_...@us...> - 2003-03-20 14:51:52
|
Update of /cvsroot/perl-xml/XML-LibXML-XPathContext
In directory sc8-pr-cvs1:/tmp/cvs-serv8117
Modified Files:
XPathContext.pm
Log Message:
Mention setContextNode() and getContextNode() in POD's synopsis
Index: XPathContext.pm
===================================================================
RCS file: /cvsroot/perl-xml/XML-LibXML-XPathContext/XPathContext.pm,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -d -r1.6 -r1.7
--- XPathContext.pm 20 Mar 2003 13:55:25 -0000 1.6
+++ XPathContext.pm 20 Mar 2003 14:51:45 -0000 1.7
@@ -121,6 +121,8 @@
my $result = $xc->find($xpath);
my $value = $xc->findvalue($xpath);
+ my $node = $xc->getContextNode;
+ $xc->setContextNode($node);
=head1 DESCRIPTION
|
|
From: Petr P. <pa...@us...> - 2003-03-20 13:55:29
|
Update of /cvsroot/perl-xml/XML-LibXML-XPathContext
In directory sc8-pr-cvs1:/tmp/cvs-serv27841
Modified Files:
XPathContext.xs XPathContext.pm
Log Message:
implement context locking by adding _enter and _leave
Index: XPathContext.xs
===================================================================
RCS file: /cvsroot/perl-xml/XML-LibXML-XPathContext/XPathContext.xs,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -d -r1.12 -r1.13
--- XPathContext.xs 20 Mar 2003 13:25:19 -0000 1.12
+++ XPathContext.xs 20 Mar 2003 13:55:25 -0000 1.13
@@ -490,7 +490,7 @@
SvREFCNT_dec(XPathContextDATA(ctxt)->node);
}
if (XPathContextDATA(ctxt)->pool != NULL) {
- SvREFCNT_dec(XPathContextDATA(ctxt)->pool);
+ SvREFCNT_dec((SV *)XPathContextDATA(ctxt)->pool);
}
Safefree(XPathContextDATA(ctxt));
}
@@ -685,6 +685,38 @@
} else {
/* warn("Registering function '%s'\n", name); */
xmlXPathRegisterFunc(ctxt, name, LibXML_generic_extension_function);
+ }
+
+void
+_enter( pxpath_context )
+ SV * pxpath_context
+ PREINIT:
+ xmlXPathContextPtr ctxt = NULL;
+ INIT:
+ ctxt = (xmlXPathContextPtr)SvIV(SvRV(pxpath_context));
+ if ( ctxt == NULL ) {
+ croak( "XPathContext: missing xpath context" );
+ }
+ PPCODE:
+ if ( XPathContextDATA(ctxt)->lock != 0 ) {
+ croak( "XPathContext: context is locked" );
+ }
+ XPathContextDATA(ctxt)->lock=1;
+
+void
+_leave( pxpath_context )
+ SV * pxpath_context
+ PREINIT:
+ xmlXPathContextPtr ctxt = NULL;
+ INIT:
+ ctxt = (xmlXPathContextPtr)SvIV(SvRV(pxpath_context));
+ if ( ctxt == NULL ) {
+ croak( "missing xpath context" );
+ }
+ PPCODE:
+ XPathContextDATA(ctxt)->lock=0;
+ if (XPathContextDATA(ctxt)->pool != NULL) {
+ SvREFCNT_dec((SV *)XPathContextDATA(ctxt)->pool);
}
void
Index: XPathContext.pm
===================================================================
RCS file: /cvsroot/perl-xml/XML-LibXML-XPathContext/XPathContext.pm,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -d -r1.5 -r1.6
--- XPathContext.pm 16 Mar 2003 16:21:29 -0000 1.5
+++ XPathContext.pm 20 Mar 2003 13:55:25 -0000 1.6
@@ -20,7 +20,14 @@
sub findnodes {
my ($self, $xpath) = @_;
- my @nodes = $self->_findnodes($xpath);
+ my @nodes;
+ $self->_enter;
+ eval {
+ @nodes = $self->_findnodes($xpath);
+ };
+ $self->_leave;
+ if ($@) { die $@; }
+
if (wantarray) {
return @nodes;
}
@@ -32,18 +39,21 @@
sub findvalue {
my ($self, $xpath) = @_;
my $res;
- eval {
- $res = $self->find($xpath);
- };
- if ( $@ ) {
- die $@;
- }
+ $res = $self->find($xpath);
return $res->to_literal->value;
}
sub find {
my ($self, $xpath) = @_;
- my ($type, @params) = $self->_find($xpath);
+ my ($type, @params);
+
+ $self->_enter;
+ eval {
+ ($type, @params) = $self->_find($xpath);
+ };
+ $self->_leave;
+ if ($@) { die $@; }
+
if ($type) {
return $type->new(@params);
}
|
|
From: Petr P. <pa...@us...> - 2003-03-20 13:55:28
|
Update of /cvsroot/perl-xml/XML-LibXML-XPathContext/t
In directory sc8-pr-cvs1:/tmp/cvs-serv27841/t
Modified Files:
02-functions.t
Log Message:
implement context locking by adding _enter and _leave
Index: 02-functions.t
===================================================================
RCS file: /cvsroot/perl-xml/XML-LibXML-XPathContext/t/02-functions.t,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -d -r1.1 -r1.2
--- 02-functions.t 14 Mar 2003 16:23:50 -0000 1.1
+++ 02-functions.t 20 Mar 2003 13:55:24 -0000 1.2
@@ -1,6 +1,6 @@
# -*- cperl -*-
use Test;
-BEGIN { plan tests => 11 };
+BEGIN { plan tests => 15 };
use XML::LibXML;
use XML::LibXML::XPathContext;
@@ -44,3 +44,18 @@
ok($xc->findvalue('join("","a","b","c")') eq 'abc');
ok($xc->findvalue('join("-","a",/foo,//*)') eq 'a-foo-foo-bar-bar');
ok($xc->findvalue('join("-",foo:copy(//*))') eq 'foo-bar-bar');
+
+# test context locking mechanism
+$xc->registerFunction('test-lock1', sub { $xc->find('1') });
+$xc->registerFunction('test-lock2', sub { $xc->findnodes('1') });
+eval { $xc->find('test-lock1()') };
+ok($@);
+eval { $xc->findnodes('test-lock1()') };
+ok($@);
+eval { $xc->find('test-lock2()') };
+ok($@);
+eval { $xc->findnodes('test-lock2()') };
+ok($@);
+
+
+
|
|
From: Petr P. <pa...@us...> - 2003-03-20 13:25:51
|
Update of /cvsroot/perl-xml/XML-LibXML-XPathContext
In directory sc8-pr-cvs1:/tmp/cvs-serv11152
Modified Files:
XPathContext.xs
Log Message:
store context data in a _XPathContextData struct
Index: XPathContext.xs
===================================================================
RCS file: /cvsroot/perl-xml/XML-LibXML-XPathContext/XPathContext.xs,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -d -r1.11 -r1.12
--- XPathContext.xs 20 Mar 2003 10:15:59 -0000 1.11
+++ XPathContext.xs 20 Mar 2003 13:25:19 -0000 1.12
@@ -33,6 +33,17 @@
croak("%s",SvPV(LibXML_error, len)); \
}
+struct _XPathContextData {
+ SV* node;
+ int lock;
+ HV* pool;
+};
+typedef struct _XPathContextData XPathContextData;
+typedef XPathContextData* XPathContextDataPtr;
+
+#define XPathContextDATA(ctxt) ((XPathContextDataPtr) ctxt->user)
+
+
/* ****************************************************************
* Error handler
* **************************************************************** */
@@ -429,7 +440,7 @@
static void
LibXML_configure_xpathcontext( xmlXPathContextPtr ctxt ) {
- xmlNodePtr node = PmmSvNode(ctxt->user);
+ xmlNodePtr node = PmmSvNode(XPathContextDATA(ctxt)->node);
ctxt->doc = node->doc;
ctxt->node = node;
@@ -447,8 +458,13 @@
xmlXPathContextPtr ctxt;
CODE:
ctxt = xmlXPathNewContext( NULL );
- ctxt->user = pnode;
- SvREFCNT_inc(pnode);
+ New(0, ctxt->user, sizeof(XPathContextData), XPathContextData);
+ if (ctxt->user == NULL) {
+ croak("XPathContext: failed to allocate proxy object");
+ }
+ XPathContextDATA(ctxt)->node = SvREFCNT_inc(pnode);
+ XPathContextDATA(ctxt)->lock = 0;
+ XPathContextDATA(ctxt)->pool = NULL;
xmlXPathRegisterFunc(ctxt,
(const xmlChar *) "document",
@@ -469,8 +485,14 @@
CODE:
xs_warn( "DESTROY XPATH CONTEXT" );
if (ctxt) {
- if (ctxt->user) {
- SvREFCNT_dec(ctxt->user);
+ if (XPathContextDATA(ctxt) != NULL) {
+ if (XPathContextDATA(ctxt)->node != NULL) {
+ SvREFCNT_dec(XPathContextDATA(ctxt)->node);
+ }
+ if (XPathContextDATA(ctxt)->pool != NULL) {
+ SvREFCNT_dec(XPathContextDATA(ctxt)->pool);
+ }
+ Safefree(XPathContextDATA(ctxt));
}
if (ctxt->namespaces != NULL) {
@@ -519,10 +541,10 @@
croak( "missing xpath context" );
}
PPCODE:
- if (ctxt->user) {
- SvREFCNT_dec(ctxt->user);
+ if (XPathContextDATA(ctxt)->node) {
+ SvREFCNT_dec(XPathContextDATA(ctxt)->node);
}
- ctxt->user = pnode;
+ XPathContextDATA(ctxt)->node = pnode;
SvREFCNT_inc(pnode);
void
|
|
From: Ilya M. <m_...@us...> - 2003-03-20 10:16:29
|
Update of /cvsroot/perl-xml/XML-LibXML-XPathContext/t
In directory sc8-pr-cvs1:/tmp/cvs-serv15069/t
Modified Files:
00-xpathcontext.t
Log Message:
Added test case for bug with changing context node
Index: 00-xpathcontext.t
===================================================================
RCS file: /cvsroot/perl-xml/XML-LibXML-XPathContext/t/00-xpathcontext.t,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- 00-xpathcontext.t 16 Mar 2003 16:21:28 -0000 1.2
+++ 00-xpathcontext.t 20 Mar 2003 10:16:25 -0000 1.3
@@ -1,5 +1,5 @@
use Test;
-BEGIN { plan tests => 15 };
+BEGIN { plan tests => 16 };
use XML::LibXML;
use XML::LibXML::XPathContext;
@@ -46,9 +46,16 @@
ok($xc->findnodes('.')->pop->isSameNode($doc1->getDocumentElement));
# test xpath context preserves the document
-my $xc2=XML::LibXML::XPathContext->new(
- XML::LibXML->new->parse_string(<<'XML'));
+my $xc2 = XML::LibXML::XPathContext->new(
+ XML::LibXML->new->parse_string(<<'XML'));
<foo/>
XML
ok($xc2->findnodes('*')->pop->nodeName eq 'foo');
+# test xpath context preserves context node
+my $doc2 = XML::LibXML->new->parse_string(<<'XML');
+<foo><bar/></foo>
+XML
+my $xc3 = XML::LibXML::XPathContext->new($doc2->getDocumentElement);
+$xc3->find('/');
+ok($xc3->getContextNode->toString() eq '<foo><bar/></foo>');
|
|
From: Ilya M. <m_...@us...> - 2003-03-20 10:16:03
|
Update of /cvsroot/perl-xml/XML-LibXML-XPathContext
In directory sc8-pr-cvs1:/tmp/cvs-serv14801
Modified Files:
XPathContext.xs
Log Message:
Preserve current node and reset context structure before each method call
Index: XPathContext.xs
===================================================================
RCS file: /cvsroot/perl-xml/XML-LibXML-XPathContext/XPathContext.xs,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -d -r1.10 -r1.11
--- XPathContext.xs 20 Mar 2003 09:02:27 -0000 1.10
+++ XPathContext.xs 20 Mar 2003 10:15:59 -0000 1.11
@@ -407,6 +407,36 @@
LEAVE;
}
+static void
+LibXML_configure_namespaces( xmlXPathContextPtr ctxt ) {
+ xmlNodePtr node = ctxt->node;
+
+ if (ctxt->namespaces != NULL) {
+ xmlFree( ctxt->namespaces );
+ }
+ 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++;
+ }
+}
+
+static void
+LibXML_configure_xpathcontext( xmlXPathContextPtr ctxt ) {
+ xmlNodePtr node = PmmSvNode(ctxt->user);
+
+ ctxt->doc = node->doc;
+ ctxt->node = node;
+
+ LibXML_configure_namespaces(ctxt);
+}
+
MODULE = XML::LibXML::XPathContext PACKAGE = XML::LibXML::XPathContext
SV*
@@ -414,28 +444,11 @@
const char * CLASS
SV * pnode
INIT:
- xmlNodePtr node = PmmSvNode(pnode);
xmlXPathContextPtr ctxt;
CODE:
- 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,
- 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++;
- }
+ ctxt = xmlXPathNewContext( NULL );
+ ctxt->user = pnode;
+ SvREFCNT_inc(pnode);
xmlXPathRegisterFunc(ctxt,
(const xmlChar *) "document",
@@ -456,11 +469,8 @@
CODE:
xs_warn( "DESTROY XPATH CONTEXT" );
if (ctxt) {
- if (ctxt->node) {
- PmmREFCNT_dec(ctxt->node->_private);
- }
- if (ctxt->doc) {
- PmmREFCNT_dec(ctxt->doc->_private);
+ if (ctxt->user) {
+ SvREFCNT_dec(ctxt->user);
}
if (ctxt->namespaces != NULL) {
@@ -483,6 +493,10 @@
SV * self
INIT:
xmlXPathContextPtr ctxt = (xmlXPathContextPtr)SvIV(SvRV(self));
+ if ( ctxt == NULL ) {
+ croak( "missing xpath context" );
+ }
+ LibXML_configure_xpathcontext(ctxt);
CODE:
if (ctxt->node != NULL) {
RETVAL = PmmNodeToSv(ctxt->node,
@@ -500,46 +514,16 @@
SV * self
SV * pnode
INIT:
- xmlNodePtr node = PmmSvNode(pnode);
xmlXPathContextPtr ctxt = (xmlXPathContextPtr)SvIV(SvRV(self));
+ if ( ctxt == NULL ) {
+ croak( "missing xpath context" );
+ }
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");
+ if (ctxt->user) {
+ SvREFCNT_dec(ctxt->user);
}
+ ctxt->user = pnode;
+ SvREFCNT_inc(pnode);
void
registerNs( pxpath_context, prefix, ns_uri )
@@ -554,6 +538,7 @@
if ( ctxt == NULL ) {
croak( "missing xpath context" );
}
+ LibXML_configure_xpathcontext(ctxt);
PPCODE:
ret = xmlXPathRegisterNs(ctxt, prefix, ns_uri);
if(ret == -1) {
@@ -566,6 +551,10 @@
INIT:
SV ** lookup_data;
xmlXPathContextPtr ctxt = (xmlXPathContextPtr)SvIV(SvRV(self));
+ if ( ctxt == NULL ) {
+ croak( "missing xpath context" );
+ }
+ LibXML_configure_xpathcontext(ctxt);
CODE:
if (ctxt->varLookupData != NULL &&
SvROK((SV*)(ctxt->varLookupData)) &&
@@ -599,6 +588,7 @@
if ( ctxt == NULL ) {
croak( "missing xpath context" );
}
+ LibXML_configure_xpathcontext(ctxt);
if ( SvROK(lookup_func) && SvTYPE(SvRV(lookup_func)) == SVt_PVCV ) {
pfdr = newRV_inc((SV*) newAV());
av_push((AV *)SvRV(pfdr), SvREFCNT_inc(lookup_func));
@@ -639,6 +629,7 @@
if ( ctxt == NULL ) {
croak( "missing xpath context" );
}
+ LibXML_configure_xpathcontext(ctxt);
if ( SvTYPE(SvRV(func)) == SVt_PVCV ) {
if (ctxt->funcLookupData == NULL) {
pfdr = newRV_inc((SV*) newHV());
@@ -690,6 +681,7 @@
if ( ctxt == NULL ) {
croak( "missing xpath context" );
}
+ LibXML_configure_xpathcontext(ctxt);
if ( ctxt->node == NULL ) {
croak( "lost node" );
}
@@ -775,6 +767,7 @@
if ( ctxt == NULL ) {
croak( "missing xpath context" );
}
+ LibXML_configure_xpathcontext(ctxt);
if ( ctxt->node == NULL ) {
croak( "lost node" );
}
|
|
From: Ilya M. <m_...@us...> - 2003-03-20 09:02:36
|
Update of /cvsroot/perl-xml/XML-LibXML-XPathContext
In directory sc8-pr-cvs1:/tmp/cvs-serv9727
Modified Files:
XPathContext.xs
Log Message:
Fix indentation
Index: XPathContext.xs
===================================================================
RCS file: /cvsroot/perl-xml/XML-LibXML-XPathContext/XPathContext.xs,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -d -r1.9 -r1.10
--- XPathContext.xs 18 Mar 2003 08:44:12 -0000 1.9
+++ XPathContext.xs 20 Mar 2003 09:02:27 -0000 1.10
@@ -600,9 +600,9 @@
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" );
}
@@ -667,12 +667,12 @@
}
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 )
|
|
From: Petr P. <pa...@us...> - 2003-03-18 08:44:17
|
Update of /cvsroot/perl-xml/XML-LibXML-XPathContext
In directory sc8-pr-cvs1:/tmp/cvs-serv12274
Modified Files:
XPathContext.xs
Log Message:
fixed all *v_fetch to avoid sigsegvs (esp. with undefined varLookupData)
Index: XPathContext.xs
===================================================================
RCS file: /cvsroot/perl-xml/XML-LibXML-XPathContext/XPathContext.xs,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -d -r1.8 -r1.9
--- XPathContext.xs 17 Mar 2003 12:27:22 -0000 1.8
+++ XPathContext.xs 18 Mar 2003 08:44:12 -0000 1.9
@@ -70,8 +70,8 @@
const xmlChar *ns_uri)
{
xmlXPathObjectPtr ret;
- SV * lookup_func;
- SV * lookup_data;
+ SV ** lookup_func;
+ SV ** lookup_data;
I32 count;
STRLEN n_a;
SV * perl_result;
@@ -82,6 +82,7 @@
double tmp_double;
int tmp_int;
SV * data;
+ SV ** fetch;
data = (SV *) varLookupData;
if (varLookupData == NULL || !SvROK(data) ||
@@ -89,19 +90,22 @@
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 );
+ if ( lookup_func == NULL || !SvROK(*lookup_func) || SvTYPE(SvRV(*lookup_func)) != SVt_PVCV ) {
+ croak("XPathContext: lost variable lookup function!\n");
+ }
+ lookup_data = av_fetch((AV *) SvRV(data),1,0 );
ENTER;
SAVETMPS;
PUSHMARK(SP);
- XPUSHs(lookup_data);
+ XPUSHs( (lookup_data != NULL) ? *lookup_data : &PL_sv_undef );
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)) {
@@ -120,19 +124,19 @@
SvTYPE(SvRV(perl_result)) == SVt_PVAV) {
/* consider any array ref to be a nodelist */
int i = 0;
- int len;
- SV * pnode;
+ int length;
+ SV ** pnode;
/* 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++ ) {
- pnode = *(av_fetch(array_result,i,0));
- if (sv_isobject(pnode) &&
- sv_derived_from(pnode,"XML::LibXML::Node")) {
+ length = av_len(array_result);
+ for( i; i <= length ; i++ ) {
+ pnode = av_fetch(array_result,i,0);
+ if (pnode != NULL && sv_isobject(*pnode) &&
+ sv_derived_from(*pnode,"XML::LibXML::Node")) {
xmlXPathNodeSetAdd(ret->nodesetval,
- (xmlNodePtr)PmmSvNode(pnode));
+ (xmlNodePtr)PmmSvNode(*pnode));
} else {
warn("XPathContext: ignoring non-node member of a nodelist");
}
@@ -232,6 +236,10 @@
strkey = SvPV(key, len);
perl_function =
hv_fetch((HV*)SvRV(data), strkey, len, 0);
+ if ( perl_function == NULL || !SvROK(*perl_function) ||
+ SvTYPE(SvRV(*perl_function)) != SVt_PVCV ) {
+ croak("XPathContext: lost perl extension function!\n");
+ }
SvREFCNT_dec(key);
ENTER;
@@ -338,19 +346,19 @@
if (SvROK(perl_result) &&
SvTYPE(SvRV(perl_result)) == SVt_PVAV) {
/* consider any array ref to be a nodelist */
- SV * pnode;
- i = 0;
+ int length = 0;
+ SV ** pnode;
/* 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++ ) {
- pnode = *(av_fetch(array_result,i,0));
- if (sv_isobject(pnode) &&
- sv_derived_from(pnode,"XML::LibXML::Node")) {
+ length = av_len(array_result);
+ for( i=0 ; i <= length ; i++ ) {
+ pnode = av_fetch(array_result,i,0);
+ if (pnode != NULL && sv_isobject(*pnode) &&
+ sv_derived_from(*pnode,"XML::LibXML::Node")) {
xmlXPathNodeSetAdd(ret->nodesetval,
- (xmlNodePtr)PmmSvNode(pnode));
+ (xmlNodePtr)PmmSvNode(*pnode));
} else {
warn("XPathContext: ignoring non-node member of a nodelist");
}
@@ -556,13 +564,19 @@
getVarLookupData( self )
SV * self
INIT:
+ SV ** lookup_data;
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);
+ 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;
+ }
} else {
RETVAL = &PL_sv_undef;
}
|
|
From: Petr P. <pa...@us...> - 2003-03-17 12:27:25
|
Update of /cvsroot/perl-xml/XML-LibXML-XPathContext
In directory sc8-pr-cvs1:/tmp/cvs-serv6600
Modified Files:
XPathContext.xs
Log Message:
minor compile fix
Index: XPathContext.xs
===================================================================
RCS file: /cvsroot/perl-xml/XML-LibXML-XPathContext/XPathContext.xs,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -d -r1.7 -r1.8
--- XPathContext.xs 16 Mar 2003 18:26:13 -0000 1.7
+++ XPathContext.xs 17 Mar 2003 12:27:22 -0000 1.8
@@ -338,8 +338,8 @@
if (SvROK(perl_result) &&
SvTYPE(SvRV(perl_result)) == SVt_PVAV) {
/* consider any array ref to be a nodelist */
- i = 0;
SV * pnode;
+ i = 0;
/* warn("result is a node list\n"); */
ret = (xmlXPathObjectPtr) xmlXPathNewNodeSet((xmlNodePtr) NULL);
|
|
From: Petr P. <pa...@us...> - 2003-03-16 18:26:18
|
Update of /cvsroot/perl-xml/XML-LibXML-XPathContext
In directory sc8-pr-cvs1:/tmp/cvs-serv17167
Modified Files:
XPathContext.xs
Log Message:
removed experimental code
Index: XPathContext.xs
===================================================================
RCS file: /cvsroot/perl-xml/XML-LibXML-XPathContext/XPathContext.xs,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -d -r1.6 -r1.7
--- XPathContext.xs 16 Mar 2003 18:21:42 -0000 1.6
+++ XPathContext.xs 16 Mar 2003 18:26:13 -0000 1.7
@@ -363,28 +363,7 @@
/* 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));
-
- /* 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 */
-
xmlXPathNodeSetAdd(ret->nodesetval,tmp_node);
- warn("NODE: goto finish\n");
goto FINISH;
}
else if (sv_isa(perl_result, "XML::LibXML::Boolean")) {
|
|
From: Petr P. <pa...@us...> - 2003-03-16 18:21:48
|
Update of /cvsroot/perl-xml/XML-LibXML-XPathContext
In directory sc8-pr-cvs1:/tmp/cvs-serv15614
Modified Files:
XPathContext.xs
Log Message:
allow unblessed ARRAY refs as nodelists
Index: XPathContext.xs
===================================================================
RCS file: /cvsroot/perl-xml/XML-LibXML-XPathContext/XPathContext.xs,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -d -r1.5 -r1.6
--- XPathContext.xs 16 Mar 2003 16:21:29 -0000 1.5
+++ XPathContext.xs 16 Mar 2003 18:21:42 -0000 1.6
@@ -116,30 +116,32 @@
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 (SvROK(perl_result) &&
+ SvTYPE(SvRV(perl_result)) == SVt_PVAV) {
+ /* consider any array ref to be a nodelist */
+ int i = 0;
+ int len;
+ SV * pnode;
+
+ /* 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++ ) {
+ pnode = *(av_fetch(array_result,i,0));
+ if (sv_isobject(pnode) &&
+ sv_derived_from(pnode,"XML::LibXML::Node")) {
+ xmlXPathNodeSetAdd(ret->nodesetval,
+ (xmlNodePtr)PmmSvNode(pnode));
+ } else {
+ warn("XPathContext: ignoring non-node member of a nodelist");
+ }
+ }
+ goto FINISH;
+ } else if (sv_isobject(perl_result) &&
+ (SvTYPE(SvRV(perl_result)) == SVt_PVMG))
{
- 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")) {
+ if (sv_derived_from(perl_result, "XML::LibXML::Node")) {
/* warn("result is a node\n"); */
ret = (xmlXPathObjectPtr)xmlXPathNewNodeSet(NULL);
tmp_node = (xmlNodePtr)PmmSvNode(perl_result);
@@ -245,7 +247,7 @@
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) */
+ xslt_tree = 1; /* PP: these get destroyed (they have boolval=1) */
case XPATH_NODESET:
nodelist = obj->nodesetval;
if ( nodelist ) {
@@ -333,29 +335,31 @@
}
/* 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 (SvROK(perl_result) &&
+ SvTYPE(SvRV(perl_result)) == SVt_PVAV) {
+ /* consider any array ref to be a nodelist */
+ i = 0;
+ SV * pnode;
+
+ /* 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++ ) {
+ pnode = *(av_fetch(array_result,i,0));
+ if (sv_isobject(pnode) &&
+ sv_derived_from(pnode,"XML::LibXML::Node")) {
+ xmlXPathNodeSetAdd(ret->nodesetval,
+ (xmlNodePtr)PmmSvNode(pnode));
+ } else {
+ warn("XPathContext: ignoring non-node member of a nodelist");
+ }
+ }
+ goto FINISH;
+ } else if (sv_isobject(perl_result) &&
+ (SvTYPE(SvRV(perl_result)) == SVt_PVMG))
{
- 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")) {
+ if (sv_derived_from(perl_result, "XML::LibXML::Node")) {
/* warn("result is a node\n"); */
ret = (xmlXPathObjectPtr)xmlXPathNewNodeSet(NULL);
tmp_node = (xmlNodePtr)PmmSvNode(perl_result);
@@ -410,15 +414,10 @@
}
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
|
|
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
|
|
From: Petr P. <pa...@us...> - 2003-03-16 16:21:32
|
Update of /cvsroot/perl-xml/XML-LibXML-XPathContext/t
In directory sc8-pr-cvs1:/tmp/cvs-serv27568/t
Modified Files:
00-xpathcontext.t
Log Message:
- added getContextNode and setContextNode
- XPathContext object now increments PmmREFCNT for ctx->node and ctx->doc
Index: 00-xpathcontext.t
===================================================================
RCS file: /cvsroot/perl-xml/XML-LibXML-XPathContext/t/00-xpathcontext.t,v
retrieving revision 1.1.1.1
retrieving revision 1.2
diff -u -d -r1.1.1.1 -r1.2
--- 00-xpathcontext.t 14 Mar 2003 14:32:04 -0000 1.1.1.1
+++ 00-xpathcontext.t 16 Mar 2003 16:21:28 -0000 1.2
@@ -1,5 +1,5 @@
use Test;
-BEGIN { plan tests => 11 };
+BEGIN { plan tests => 15 };
use XML::LibXML;
use XML::LibXML::XPathContext;
@@ -38,3 +38,17 @@
my $xc = XML::LibXML::XPathContext->new($doc1);
$xc->registerNs('xxx', 'http://example.com/foobar');
ok($xc->findnodes('/xxx:foo')->pop->nodeName eq 'foo');
+
+# test getContextNode and setContextNode
+ok($xc->getContextNode->isSameNode($doc1));
+$xc->setContextNode($doc1->getDocumentElement);
+ok($xc->getContextNode->isSameNode($doc1->getDocumentElement));
+ok($xc->findnodes('.')->pop->isSameNode($doc1->getDocumentElement));
+
+# test xpath context preserves the document
+my $xc2=XML::LibXML::XPathContext->new(
+ XML::LibXML->new->parse_string(<<'XML'));
+<foo/>
+XML
+ok($xc2->findnodes('*')->pop->nodeName eq 'foo');
+
|
|
From: Christian G. <phi...@us...> - 2003-03-15 20:55:35
|
Update of /cvsroot/perl-xml/XML-LibXML-Common
In directory sc8-pr-cvs1:/tmp/cvs-serv25554
Modified Files:
Common.xs
Log Message:
Modified Files:
Common.xs
+ use the correct copy function while docing strings.
Index: Common.xs
===================================================================
RCS file: /cvsroot/perl-xml/XML-LibXML-Common/Common.xs,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -d -r1.5 -r1.6
--- Common.xs 27 Feb 2003 18:32:59 -0000 1.5
+++ Common.xs 15 Mar 2003 20:55:32 -0000 1.6
@@ -165,6 +165,7 @@
/* copy the string */
/* warn( "simply copy the string" ); */
tstr = xmlStrdup( realstring );
+ len = xmlStrlen( tstr );
}
else {
LibXML_COMMON_error = NEWSV(0, 512);
@@ -191,8 +192,8 @@
out = xmlBufferCreate();
xmlBufferCCat( in, realstring );
if ( xmlCharEncOutFunc( coder, out, in ) >= 0 ) {
- len = xmlBufferLength(out);
- tstr = (xmlChar*)xmlBufferContent(out);
+ len = xmlBufferLength( out );
+ tstr = xmlCharStrndup( xmlBufferContent( out ), len );
}
xmlBufferFree( in );
@@ -208,7 +209,6 @@
}
}
- /* len = xmlStrlen( tstr ); */
RETVAL = newSVpvn( (const char *)tstr, len );
#ifdef HAVE_UTF8
if ( enc == XML_CHAR_ENCODING_UTF8 ) {
|
|
From: Petr P. <pa...@us...> - 2003-03-14 17:20:55
|
Update of /cvsroot/perl-xml/XML-LibXML-XPathContext
In directory sc8-pr-cvs1:/tmp/cvs-serv21066
Modified Files:
XPathContext.xs
Log Message:
fixed problem with undefined uri in registerFunctionNS
Index: XPathContext.xs
===================================================================
RCS file: /cvsroot/perl-xml/XML-LibXML-XPathContext/XPathContext.xs,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -d -r1.3 -r1.4
--- XPathContext.xs 14 Mar 2003 16:23:50 -0000 1.3
+++ XPathContext.xs 14 Mar 2003 17:20:47 -0000 1.4
@@ -534,7 +534,7 @@
registerFunctionNS( pxpath_context, name, uri, func)
SV * pxpath_context
char * name
- char * uri
+ SV * uri
SV * func
PREINIT:
xmlXPathContextPtr ctxt = NULL;
@@ -561,9 +561,9 @@
}
}
key = newSVpvn("",0);
- if (uri && *uri) {
+ if (SvOK(uri)) {
sv_catpv(key, "{");
- sv_catpv(key, (const char*)uri);
+ sv_catsv(key, uri);
sv_catpv(key, "}");
}
sv_catpv(key, (const char*)name);
@@ -575,13 +575,13 @@
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);
- }
+ 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);
+ }
void
_findnodes( pxpath_context, perl_xpath )
|
|
From: Ilya M. <m_...@us...> - 2003-03-14 16:41:24
|
Update of /cvsroot/perl-xml/XML-LibXML-XPathContext In directory sc8-pr-cvs1:/tmp/cvs-serv31972 Added Files: MANIFEST.SKIP .cvsignore Log Message: Added --- NEW FILE: MANIFEST.SKIP --- CVS/.* \.bak$ \.old$ \.o$ \.bs$ ^XPathContext.c$ \.tar\.gz$ ^blib/ ^Makefile$ ^pm_to_blib$ ^MANIFEST.SKIP$ ^.cvsignore$ ~$ --- NEW FILE: .cvsignore --- Makefile XPathContext.bs XPathContext.c blib pm_to_blib |
|
From: Petr P. <pa...@us...> - 2003-03-14 16:37:48
|
Update of /cvsroot/perl-xml/XML-LibXML-XPathContext
In directory sc8-pr-cvs1:/tmp/cvs-serv29535
Modified Files:
XPathContext.pm
Log Message:
added documentation for registerFunctionNS and registerFunction
Index: XPathContext.pm
===================================================================
RCS file: /cvsroot/perl-xml/XML-LibXML-XPathContext/XPathContext.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -d -r1.3 -r1.4
--- XPathContext.pm 14 Mar 2003 16:23:51 -0000 1.3
+++ XPathContext.pm 14 Mar 2003 16:37:45 -0000 1.4
@@ -102,12 +102,16 @@
my $xc = XML::LibXML::XPathContext->new($node);
$xc->registerNs($prefix, $namespace_uri);
+ $xc->registerFunction($name, sub { ... });
+ $xc->registerFunctionNS($name, $namespace_uri, sub { ... });
+ $xc->registerVariableLookup(sub { ... },$data);
my @nodes = $xc->findnodes($xpath);
my $nodelist = $xc->findnodes($xpath);
my $result = $xc->find($xpath);
my $value = $xc->findvalue($xpath);
+
=head1 DESCRIPTION
This module augments XML::LibXML by providing Perl interface to
@@ -141,6 +145,22 @@
Returns the data associated with a variable lookup function during a
previous call to I<registerVarLookupFunc>.
+
+=item B<registerFunctionNS($name, $uri, $callback)>
+
+Registers an extension function I<$name> in I<$uri>
+namespace. I<$callback> must be a CODE reference. The arguments of the
+callback function are either simple scalars or XML::LibXML::NodeList
+objects depending on the XPath argument types. The function is
+responsible for checking the argument number and types. Result of the
+callback code must be a single value of the following types: a simple
+scalar (number,string) or an arbitrary XML::LibXML object that can be
+a result of findnodes: Boolean, Literal, Number, Node (e.g. Document,
+Element, etc.), or NodeList.
+
+=item B<registerFunction($name, $callback)>
+
+Same as I<registerFunctionNS> but without a namespace.
=item B<findnodes($xpath)>
|
|
From: Petr P. <pa...@us...> - 2003-03-14 16:26:12
|
Update of /cvsroot/perl-xml/XML-LibXML-XPathContext/t
In directory sc8-pr-cvs1:/tmp/cvs-serv23041/t
Modified Files:
01-variables.t
Log Message:
removed unnecessary code
Index: 01-variables.t
===================================================================
RCS file: /cvsroot/perl-xml/XML-LibXML-XPathContext/t/01-variables.t,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -d -r1.1 -r1.2
--- 01-variables.t 14 Mar 2003 16:11:20 -0000 1.1
+++ 01-variables.t 14 Mar 2003 16:26:08 -0000 1.2
@@ -1,12 +1,9 @@
+# -*- cperl -*-
use Test;
BEGIN { plan tests => 30 };
-use IO::File;
-
use XML::LibXML;
use XML::LibXML::XPathContext;
-autoflush STDERR;
-autoflush STDOUT;
my $doc = XML::LibXML->new->parse_string(<<'XML');
<foo><bar a="b">Bla</bar><bar/></foo>
|
|
From: Petr P. <pa...@us...> - 2003-03-14 16:24:53
|
Update of /cvsroot/perl-xml/XML-LibXML-XPathContext In directory sc8-pr-cvs1:/tmp/cvs-serv22179 Modified Files: MANIFEST Log Message: added t/02-functions.t Index: MANIFEST =================================================================== RCS file: /cvsroot/perl-xml/XML-LibXML-XPathContext/MANIFEST,v retrieving revision 1.2 retrieving revision 1.3 diff -u -d -r1.2 -r1.3 --- MANIFEST 14 Mar 2003 16:12:04 -0000 1.2 +++ MANIFEST 14 Mar 2003 16:24:49 -0000 1.3 @@ -13,6 +13,7 @@ ppport.h t/00-xpathcontext.t t/01-variables.t +t/02-functions.t typemap xpath.c xpath.h |
|
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;
|
|
From: Petr P. <pa...@us...> - 2003-03-14 16:23:55
|
Update of /cvsroot/perl-xml/XML-LibXML-XPathContext/t
In directory sc8-pr-cvs1:/tmp/cvs-serv21709/t
Added Files:
02-functions.t
Log Message:
added extension functions support
--- NEW FILE: 02-functions.t ---
# -*- cperl -*-
use Test;
BEGIN { plan tests => 11 };
use XML::LibXML;
use XML::LibXML::XPathContext;
my $doc = XML::LibXML->new->parse_string(<<'XML');
<foo><bar a="b">Bla</bar><bar/></foo>
XML
ok($doc);
my $xc = XML::LibXML::XPathContext->new($doc);
$xc->registerNs('foo','urn:foo');
$xc->registerFunctionNS('copy','urn:foo',
sub { @_==1 ? $_[0] : die "too many parameters"}
);
# copy string, real, integer, nodelist
ok($xc->findvalue('foo:copy("bar")') eq 'bar');
ok($xc->findvalue('foo:copy(3.14)') == 3.14);
ok($xc->findvalue('foo:copy(7)') == 7);
ok($xc->find('foo:copy(//*)')->size() == 3);
my ($foo)=$xc->findnodes('(//*)[2]');
ok($xc->findnodes('foo:copy(//*)[2]')->pop->isSameNode($foo));
# too many arguments
eval { $xc->findvalue('foo:copy(1,xyz)') };
ok ($@);
# without a namespace
$xc->registerFunction('dummy', sub { 'DUMMY' });
ok($xc->findvalue('dummy()') eq 'DUMMY');
# a mix of different arguments types
$xc->registerFunction('join',
sub { join shift,
map { (ref($_)&&$_->isa('XML::LibXML::Node')) ? $_->nodeName : $_ }
map { (ref($_)&&$_->isa('XML::LibXML::NodeList')) ? @$_ : $_ }
@_
});
ok($xc->findvalue('join("","a","b","c")') eq 'abc');
ok($xc->findvalue('join("-","a",/foo,//*)') eq 'a-foo-foo-bar-bar');
ok($xc->findvalue('join("-",foo:copy(//*))') eq 'foo-bar-bar');
|
1 message has been excluded from this view by a project administrator.
