home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / tsw / TSW_3.4.0.exe / Apache2 / perl / XPathContext.pm < prev    next >
Encoding:
Perl POD Document  |  2003-09-16  |  11.4 KB  |  402 lines
  1. # $Id: XPathContext.pm,v 1.2 2003/09/16 18:18:18 joker Exp $
  2.  
  3. package XML::LibXML::XPathContext;
  4.  
  5. use strict;
  6. use vars qw($VERSION @ISA $USE_LIBXML_DATA_TYPES);
  7.  
  8. use XML::LibXML::NodeList;
  9.  
  10. $VERSION = '0.04';
  11. require DynaLoader;
  12.  
  13. @ISA = qw(DynaLoader);
  14.  
  15. bootstrap XML::LibXML::XPathContext $VERSION;
  16.  
  17. # should LibXML XPath data types be used for simple objects
  18. # when passing parameters to extension functions (default: no)
  19. $USE_LIBXML_DATA_TYPES = 0;
  20.  
  21. sub findnodes {
  22.     my ($self, $xpath, $node) = @_;
  23.  
  24.     my @nodes = $self->_guarded_find_call('_findnodes', $xpath, $node);
  25.  
  26.     if (wantarray) {
  27.         return @nodes;
  28.     }
  29.     else {
  30.         return XML::LibXML::NodeList->new(@nodes);
  31.     }
  32. }
  33.  
  34. sub find {
  35.     my ($self, $xpath, $node) = @_;
  36.     my ($type, @params);
  37.  
  38.     ($type, @params) = $self->_guarded_find_call('_find', $xpath, $node);
  39.  
  40.     if ($type) {
  41.         return $type->new(@params);
  42.     }
  43.     return undef;
  44. }
  45.  
  46. sub findvalue {
  47.     my $self = shift;
  48.     return $self->find(@_)->to_literal->value;
  49. }
  50.  
  51. sub _guarded_find_call {
  52.     my ($self, $method, $xpath, $node) = @_;
  53.  
  54.     my $prev_node;
  55.     if (ref($node)) {
  56.         $prev_node = $self->getContextNode();
  57.         $self->setContextNode($node);
  58.     }
  59.     $self->_enter;
  60.     my @ret;
  61.     eval {
  62.         @ret = $self->$method($xpath);
  63.     };
  64.     $self->_leave;
  65.     $self->setContextNode($prev_node) if ref($node);
  66.  
  67.     if ($@) { die $@; }
  68.  
  69.     return @ret;
  70. }
  71.  
  72. sub registerFunction {
  73.     my ($self, $name, $sub) = @_;
  74.     $self->registerFunctionNS($name, undef, $sub);
  75.     return;
  76. }
  77.  
  78. sub unregisterNs {
  79.     my ($self, $prefix) = @_;
  80.     $self->registerNs($prefix, undef);
  81.     return;
  82. }
  83.  
  84. sub unregisterFunction {
  85.     my ($self, $name) = @_;
  86.     $self->registerFunctionNS($name, undef, undef);
  87.     return;
  88. }
  89.  
  90. sub unregisterFunctionNS {
  91.     my ($self, $name, $ns) = @_;
  92.     $self->registerFunctionNS($name, $ns, undef);
  93.     return;
  94. }
  95.  
  96. sub unregisterVarLookupFunc {
  97.     my ($self) = @_;
  98.     $self->registerVarLookupFunc(undef, undef);
  99.     return;
  100. }
  101.  
  102. # extension function perl dispatcher
  103. # borrowed from XML::LibXSLT
  104.  
  105. sub _perl_dispatcher {
  106.     my $func = shift;
  107.     my @params = @_;
  108.     my @perlParams;
  109.  
  110.     my $i = 0;
  111.     while (@params) {
  112.         my $type = shift(@params);
  113.         if ($type eq 'XML::LibXML::Literal' or
  114.             $type eq 'XML::LibXML::Number' or
  115.             $type eq 'XML::LibXML::Boolean')
  116.         {
  117.             my $val = shift(@params);
  118.             unshift(@perlParams, $USE_LIBXML_DATA_TYPES ? $type->new($val) : $val);
  119.         }
  120.         elsif ($type eq 'XML::LibXML::NodeList') {
  121.             my $node_count = shift(@params);
  122.             unshift(@perlParams, $type->new(splice(@params, 0, $node_count)));
  123.         }
  124.     }
  125.  
  126.     $func = "main::$func" unless ref($func) || $func =~ /(.+)::/;
  127.     no strict 'refs';
  128.     my $res = $func->(@perlParams);
  129.     return $res;
  130. }
  131.  
  132.  
  133. 1;
  134.  
  135. __END__
  136.  
  137. =head1 NAME
  138.  
  139. XML::LibXML::XPathContext - Perl interface to libxml2's xmlXPathContext
  140.  
  141. =head1 SYNOPSIS
  142.  
  143.     use XML::LibXML::XPathContext;
  144.  
  145.     my $xc = XML::LibXML::XPathContext->new;
  146.     my $xc = XML::LibXML::XPathContext->new($node);
  147.  
  148.     my $node = $xc->getContextNode;
  149.     $xc->setContextNode($node);
  150.  
  151.     $xc->registerNs($prefix, $namespace_uri);
  152.     $xc->registerFunction($name, sub { ... });
  153.     $xc->registerFunctionNS($name, $namespace_uri, sub { ... });
  154.     $xc->registerVarLookupFunc(sub { ... }, $data);
  155.  
  156.     $xc->unregisterNs($prefix);
  157.     $xc->unregisterFunction($name);
  158.     $xc->unregisterFunctionNS($name, $namespace_uri);
  159.     $xc->unregisterVarLookupFunc($name);
  160.  
  161.     my @nodes = $xc->findnodes($xpath);
  162.     my @nodes = $xc->findnodes($xpath, $context_node);
  163.     my $nodelist = $xc->findnodes($xpath);
  164.     my $nodelist = $xc->findnodes($xpath, $context_node);
  165.     my $result = $xc->find($xpath);
  166.     my $result = $xc->find($xpath, $context_node);
  167.     my $value = $xc->findvalue($xpath);
  168.     my $value = $xc->findvalue($xpath, $context_node);
  169.  
  170. =head1 DESCRIPTION
  171.  
  172. This module augments L<XML::LibXML|XML::LibXML> by providing Perl
  173. interface to libxml2's xmlXPathContext structure.  Besides just
  174. performing xpath statements on L<XML::LibXML|XML::LibXML>'s node trees
  175. it allows redefining certaint aspects of XPath engine.  This modules
  176. allows
  177.  
  178. =over 4
  179.  
  180. =item 1
  181.  
  182. registering namespace prefixes,
  183.  
  184. =item 2
  185.  
  186. defining XPath functions in Perl,
  187.  
  188. =item 3
  189.  
  190. defining variable lookup functions in Perl.
  191.  
  192. =back
  193.  
  194. =head1 EXAMPLES
  195.  
  196. =head2 Find all paragraph nodes in XHTML document
  197.  
  198. This example demonstrates I<registerNs()> usage:
  199.  
  200.     my $xc = XML::LibXML::XPathContext->new($xhtml_doc);
  201.     $xc->registerNs('xhtml', 'http://www.w3.org/1999/xhtml');
  202.     my @nodes = $xc->findnodes('//xhtml:p');
  203.  
  204. =head2 Find all nodes whose names match a Perl regular expression
  205.  
  206. This example demonstrates I<registerFunction()> usage:
  207.  
  208.     my $perlmatch = sub {
  209.         die "Not a nodelist"
  210.             unless $_[0]->isa('XML::LibXML::NodeList');
  211.         die "Missing a regular expression"
  212.             unless defined $_[1];
  213.  
  214.         my $nodelist = XML::LibXML::NodeList->new;
  215.         my $i = 0;
  216.         while(my $node = $_[0]->get_node($i)) {
  217.             $nodelist->push($node) if $node->nodeName =~ $_[1];
  218.             $i ++;
  219.         }
  220.  
  221.         return $nodelist;
  222.     };
  223.  
  224.     my $xc = XML::LibXML::XPathContext->new($node);
  225.     $xc->registerFunction('perlmatch', $perlmatch);
  226.     my @nodes = $xc->findnodes('perlmatch(//*, "foo|bar")');
  227.  
  228. =head2 Use XPath variables to recycle results of previous evaluations
  229.  
  230. This example demonstrates I<registerVarLookup()> usage:
  231.  
  232.     sub var_lookup {
  233.       my ($varname,$ns,$data)=@_;
  234.       return $data->{$varname};
  235.     }
  236.  
  237.     my $areas = XML::LibXML->new->parse_file('areas.xml');
  238.     my $empl = XML::LibXML->new->parse_file('employees.xml');
  239.  
  240.     my $xc = XML::LibXML::XPathContext->new($empl);
  241.  
  242.     my %results =
  243.       (
  244.        A => $xc->find('/employees/employee[@salary>10000]'),
  245.        B => $areas->find('/areas/area[district='Brooklyn']/street'),
  246.       );
  247.  
  248.     # get names of employees from $A woring in an area listed in $B
  249.     $xc->registerVarLookupFunc(\&var_lookup, \%results);
  250.     my @nodes = $xc->findnodes('$A[work_area/street = $B]/name');
  251.  
  252. =head1 METHODS
  253.  
  254. =over 4
  255.  
  256. =item B<new>
  257.  
  258. Creates a new XML::LibXML::XPathContext object without a context node.
  259.  
  260. =item B<new($node)>
  261.  
  262. Creates a new XML::LibXML::XPathContext object with the context node
  263. set to I<$node>.
  264.  
  265. =item B<registerNs($prefix, $namespace_uri)>
  266.  
  267. Registers namespace I<$prefix> to I<$namespace_uri>.
  268.  
  269. =item B<unregisterNs($prefix)>
  270.  
  271. Unregisters namespace I<$prefix>.
  272.  
  273. =item B<registerVarLookupFunc($callback, $data)>
  274.  
  275. Registers variable lookup function I<$prefix>. The registered function
  276. is executed by the XPath engine each time an XPath variable is
  277. evaluated. It takes three arguments: I<$data>, variable name, and
  278. variable ns-URI and must return one value: a number or string or any
  279. L<XML::LibXML|XML::LibXML> object that can be a result of findnodes:
  280. Boolean, Literal, Number, Node (e.g. Document, Element, etc.), or
  281. NodeList.  For convenience, simple (non-blessed) array references
  282. containing only L<XML::LibXML::Node|XML::LibXML::Node> objects can be
  283. used instead of a L<XML::LibXML::NodeList|XML::LibXML::NodeList>.
  284.  
  285. =item B<getVarLookupData()>
  286.  
  287. Returns the data that have been associated with a variable lookup
  288. function during a previous call to I<registerVarLookupFunc>.
  289.  
  290. =item B<unregisterVarLookupFunc()>
  291.  
  292. Unregisters variable lookup function and the associated lookup data.
  293.  
  294. =item B<registerFunctionNS($name, $uri, $callback)>
  295.  
  296. Registers an extension function I<$name> in I<$uri>
  297. namespace. I<$callback> must be a CODE reference. The arguments of the
  298. callback function are either simple scalars or
  299. L<XML::LibXML::NodeList|XML::LibXML::NodeList> objects depending on
  300. the XPath argument types. The function is responsible for checking the
  301. argument number and types. Result of the callback code must be a
  302. single value of the following types: a simple scalar (number,string)
  303. or an arbitrary L<XML::LibXML|XML::LibXML> object that can be a result
  304. of findnodes: Boolean, Literal, Number, Node (e.g. Document, Element,
  305. etc.), or NodeList. For convenience, simple (non-blessed) array
  306. references containing only L<XML::LibXML::Node|XML::LibXML::Node>
  307. objects can be used instead of a
  308. L<XML::LibXML::NodeList|XML::LibXML::NodeList>.
  309.  
  310. =item B<unregisterFunctionNS($name, $uri)>
  311.  
  312. Unregisters extension function I<$name> in I<$uri> namespace. Has the
  313. same effect as passing C<undef> as I<$callback> to registerFunctionNS.
  314.  
  315. =item B<registerFunction($name, $callback)>
  316.  
  317. Same as I<registerFunctionNS> but without a namespace.
  318.  
  319. =item B<unregisterFunction($name)>
  320.  
  321. Same as I<unregisterFunctionNS> but without a namespace.
  322.  
  323. =item B<findnodes($xpath, [ $context_node ])>
  324.  
  325. Performs the xpath statement on the current node and returns the
  326. result as an array. In scalar context returns a
  327. L<XML::LibXML::NodeList|XML::LibXML::NodeList> object. Optionally, a
  328. node may be passed as a second argument to set the context node for
  329. the query.
  330.  
  331. =item B<find($xpath, [ $context_node ])>
  332.  
  333. Performs the xpath expression using the current node as the context of
  334. the expression, and returns the result depending on what type of
  335. result the XPath expression had. For example, the XPath C<1 * 3 + 52>
  336. results in a L<XML::LibXML::Number|XML::LibXML::Number> object being
  337. returned. Other expressions might return a
  338. L<XML::LibXML::Boolean|XML::LibXML::Boolean> object, or a
  339. L<XML::LibXML::Literal|XML::LibXML::Literal> object (a string). Each
  340. of those objects uses Perl's overload feature to "do the right thing"
  341. in different contexts. Optionally, a node may be passed as a second
  342. argument to set the context node for the query.
  343.  
  344.  
  345. =item B<findvalue($xpath, [ $context_node ])>
  346.  
  347. Is exactly equivalent to:
  348.  
  349.     $node->find( $xpath )->to_literal;
  350.  
  351. That is, it returns the literal value of the results.  This enables
  352. you to ensure that you get a string back from your search, allowing
  353. certain shortcuts. This could be used as the equivalent of
  354. <xsl:value-of select="some_xpath"/>. Optionally, a node may be passed
  355. in the second argument to set the context node for the query.
  356.  
  357. =item B<getContextNode()>
  358.  
  359. Get the current context node.
  360.  
  361. =item B<setContextNode($node)>
  362.  
  363. Set the current context node.
  364.  
  365. =back
  366.  
  367. =head1 BUGS AND CAVEATS
  368.  
  369. XML::LibXML::XPathContext objects are not reentrant. It means you
  370. cannot register a Perl function with a XML::LibXML::XPathContext
  371. object if this Perl function uses itself the same
  372. XML::LibXML::XPathContext object internally.
  373.  
  374. For example, the following code will not work:
  375.  
  376.     my $xc = XML::LibXML::XPathContext->new($node);
  377.     $xc->registerFunction('func', sub { $xc->findvalue('1') });
  378.     my $result = $xc->findvalue('func()');
  379.  
  380. =head1 AUTHORS
  381.  
  382. Based on L<XML::LibXML|XML::LibXML> and L<XML::XSLT|XML::XSLT> code by
  383. Matt Sergeant and Christian Glahn.
  384.  
  385. Maintained by Ilya Martynov and Petr Pajas.
  386.  
  387. Copyright 2001-2003 AxKit.com Ltd, All rights reserved.
  388.  
  389. =head1 SUPPORT
  390.  
  391. For suggestions, bugreports etc. you may contact the maintainers
  392. directly (ilya@martynov.org and pajas@ufal.ms.mff.cuni.cz)
  393.  
  394. XML::LibXML::XPathContext issues can be discussed among other things
  395. on the perl XML mailing list (perl-xml@listserv.ActiveState.com).
  396.  
  397. =head1 SEE ALSO
  398.  
  399. L<XML::LibXML|XML::LibXML>, L<XML::XSLT|XML::XSLT>
  400.  
  401. =cut
  402.