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