From: Petr P. <pa...@us...> - 2003-03-26 15:26:53
|
Update of /cvsroot/perl-xml/XML-LibXML-XPathContext In directory sc8-pr-cvs1:/tmp/cvs-serv10352 Modified Files: XPathContext.xs XPathContext.pm Log Message: - support for unregisering - extension functions can be registered by name - POD update Index: XPathContext.xs =================================================================== RCS file: /cvsroot/perl-xml/XML-LibXML-XPathContext/XPathContext.xs,v retrieving revision 1.22 retrieving revision 1.23 diff -u -d -r1.22 -r1.23 --- XPathContext.xs 25 Mar 2003 20:05:15 -0000 1.22 +++ XPathContext.xs 26 Mar 2003 15:26:47 -0000 1.23 @@ -287,8 +287,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 ) { + if ( perl_function == NULL || !SvOK(*perl_function) || + !(SvPOK(*perl_function) || + (SvROK(*perl_function) && + SvTYPE(SvRV(*perl_function)) == SVt_PVCV))) { croak("XPathContext: lost perl extension function!"); } SvREFCNT_dec(key); @@ -590,14 +592,17 @@ croak("XPathContext: 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)); - av_push((AV *)SvRV(pfdr), SvREFCNT_inc(lookup_data)); - } else { - croak("XPathContext: 1st argument is not a CODE reference"); + if (SvOK(lookup_func)) { + 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)); + } else { + croak("XPathContext: 1st argument is not a CODE reference"); + } } if (ctxt->varLookupData != NULL) { + /* free previous lookup data */ if (SvTYPE(SvRV((SV *)ctxt->varLookupData)) == SVt_PVAV) { SvREFCNT_dec((SV *)ctxt->varLookupData); ctxt->varLookupData = NULL; @@ -607,10 +612,15 @@ } } PPCODE: - xmlXPathRegisterVariableLookup(ctxt, LibXML_generic_variable_lookup, pfdr); - if (ctxt->varLookupData==NULL || ctxt->varLookupData != pfdr) { - croak( "XPathContext: registration failure" ); - } + if (SvOK(lookup_func)) { + xmlXPathRegisterVariableLookup(ctxt, LibXML_generic_variable_lookup, pfdr); + if (ctxt->varLookupData==NULL || ctxt->varLookupData != pfdr) { + croak( "XPathContext: registration failure" ); + } + } else { + /* unregister */ + xmlXPathRegisterVariableLookup(ctxt, NULL, NULL); + } void registerFunctionNS( pxpath_context, name, uri, func) @@ -631,17 +641,25 @@ croak("XPathContext: missing xpath context"); } LibXML_configure_xpathcontext(ctxt); - if ( SvTYPE(SvRV(func)) == SVt_PVCV ) { + if ( !SvOK(func) || SvOK(func) && + ((SvROK(func) && SvTYPE(SvRV(func)) == SVt_PVCV ) || SvPOK(func))) { if (ctxt->funcLookupData == NULL) { - pfdr = newRV_inc((SV*) newHV()); - ctxt->funcLookupData = pfdr; + if (SvOK(func)) { + pfdr = newRV_inc((SV*) newHV()); + ctxt->funcLookupData = pfdr; + } else { + /* looks like no perl function was never registered, */ + /* nothing to unregister */ + warn("XPathContext: nothing to unregister"); + return; + } } else { if (SvTYPE(SvRV((SV *)ctxt->funcLookupData)) == SVt_PVHV) { /* good, it's a HV */ pfdr = (SV *)ctxt->funcLookupData; } else { croak ("XPathContext: cannot register: funcLookupData structure occupied"); - } + } } key = newSVpvn("",0); if (SvOK(uri)) { @@ -652,18 +670,25 @@ 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); + if (SvOK(func)) { + hv_store((HV *)SvRV(pfdr),strkey, len, SvREFCNT_inc(func), 0); + } else { + /* unregister */ + hv_delete((HV *)SvRV(pfdr),strkey, len, G_DISCARD); + } SvREFCNT_dec(key); } else { - croak("XPathContext: 3rd argument is not a CODE reference"); + croak("XPathContext: 3rd argument is not a CODE reference or function name"); } 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); + xmlXPathRegisterFuncNS(ctxt, name, SvPV(uri, len), + (SvOK(func) ? + LibXML_generic_extension_function : NULL)); } else { - /* warn("Registering function '%s'\n", name); */ - xmlXPathRegisterFunc(ctxt, name, LibXML_generic_extension_function); + xmlXPathRegisterFunc(ctxt, name, + (SvOK(func) ? + LibXML_generic_extension_function : NULL)); } void Index: XPathContext.pm =================================================================== RCS file: /cvsroot/perl-xml/XML-LibXML-XPathContext/XPathContext.pm,v retrieving revision 1.10 retrieving revision 1.11 diff -u -d -r1.10 -r1.11 --- XPathContext.pm 26 Mar 2003 11:47:32 -0000 1.10 +++ XPathContext.pm 26 Mar 2003 15:26:48 -0000 1.11 @@ -66,6 +66,24 @@ return; } +sub unregisterFunction { + my ($self, $name)=@_; + $self->registerFunctionNS($name,undef,undef); + return; +} + +sub unregisterFunctionNS { + my ($self, $name, $ns)=@_; + $self->registerFunctionNS($name,$ns,undef); + return; +} + +sub unregisterVarLookupFunc { + my ($self)=@_; + $self->registerVarLookupFunc(undef,undef); + return; +} + # extension function perl dispatcher # borrowed from XML::LibXSLT @@ -114,7 +132,7 @@ $xc->registerNs($prefix, $namespace_uri); $xc->registerFunction($name, sub { ... }); $xc->registerFunctionNS($name, $namespace_uri, sub { ... }); - $xc->registerVariableLookup(sub { ... }, $data); + $xc->registerVarLookupFunc(sub { ... }, $data); my @nodes = $xc->findnodes($xpath); my $nodelist = $xc->findnodes($xpath); @@ -157,7 +175,7 @@ $xc->registerNs('xhtml', 'http://www.w3.org/1999/xhtml'); my @nodes = $xc->findnodes('//xhtml:p'); -=head2 Find all nodes which names match a Perl regular expression +=head2 Find all nodes whose names match a Perl regular expression This example demonstrates I<registerFunction()> usage: @@ -168,7 +186,6 @@ unless defined $_[1]; my $nodelist = XML::LibXML::NodeList->new; - my $i = 0; while(my $node = $_[0]->get_node($i)) { $nodelist->push($node) if $node->nodeName =~ $_[1]; @@ -182,6 +199,30 @@ $xc->registerFunction('perlmatch', $perlmatch); my @nodes = $xc->findnodes('perlmatch(//*, "foo|bar")'); +=head2 Use XPath variables to recycle results of previous evaluations + +This example demonstrates I<registerVarLookup()> usage: + + sub var_lookup { + my ($varname,$ns,$data)=@_; + return $data->{$varname}; + } + + my $areas = XML::LibXML->new->parse_file('areas.xml'); + my $empl = XML::LibXML->new->parse_file('employees.xml'); + + my $xc = XML::LibXML::XPathContext->new($empl); + + my %results = + ( + A => $xc->find('/employees/employee[@salary>10000]'), + B => $areas->find('/areas/area[district='Brooklyn']/street'), + ); + + # get names of employees from $A woring in an area listed in $B + $xc->registerVarLookupFunc(\&var_lookup,\%results); + my @nodes = $xc->findnodes('$A[work_area/street = $B]/name'); + =head1 METHODS =over 4 @@ -212,6 +253,10 @@ Returns the data that have been associated with a variable lookup function during a previous call to I<registerVarLookupFunc>. +=item B<unregisterVarLookupFunc()> + +Unregisters variable lookup function and the associated lookup data. + =item B<registerFunctionNS($name, $uri, $callback)> Registers an extension function I<$name> in I<$uri> @@ -226,9 +271,19 @@ array references containing only XML::LibXML::Node objects can be used instead of a XML::LibXML::NodeList. +=item B<registerFunctionNS($name, $uri)> + +Unregisters extension function I<$name> in I<$uri> namespace. Has the +same effect as passing C<undef> as I<$callback> to registerFunctionNS. + =item B<registerFunction($name, $callback)> Same as I<registerFunctionNS> but without a namespace. + +=item B<unregisterFunction($name)> + +Same as I<unregisterFunctionNS> but without a namespace. + =item B<findnodes($xpath)> |