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'); |