home *** CD-ROM | disk | FTP | other *** search
/ PC Welt 2006 November (DVD) / PCWELT_11_2006.ISO / casper / filesystem.squashfs / usr / share / perl5 / XML / Grove / Sub.pm < prev    next >
Encoding:
Text File  |  1999-10-23  |  2.8 KB  |  129 lines

  1. #
  2. # Copyright (C) 1998, 1999 Ken MacLeod
  3. # XML::Grove::Sub is free software; you can redistribute it
  4. # and/or modify it under the same terms as Perl itself.
  5. #
  6. # $Id: Sub.pm,v 1.3 1999/09/02 20:56:58 kmacleod Exp $
  7. #
  8.  
  9. use strict;
  10.  
  11. package XML::Grove::Sub;
  12.  
  13. use Data::Grove::Visitor;
  14.  
  15. sub new {
  16.     my $type = shift;
  17.     return (bless {}, $type);
  18. }
  19.  
  20. sub visit_document {
  21.     my $self = shift; my $document = shift; my $sub = shift;
  22.     return (&$sub($document, @_),
  23.         $document->children_accept ($self, $sub, @_));
  24. }
  25.  
  26. sub visit_element {
  27.     my $self = shift; my $element = shift; my $sub = shift;
  28.     return (&$sub($element, @_),
  29.         $element->children_accept ($self, $sub, @_));
  30. }
  31.  
  32. sub visit_entity {
  33.     my $self = shift; my $entity = shift; my $sub = shift;
  34.     return (&$sub($entity, @_));
  35. }
  36.  
  37. sub visit_pi {
  38.     my $self = shift; my $pi = shift; my $sub = shift;
  39.     return (&$sub($pi, @_));
  40. }
  41.  
  42. sub visit_comment {
  43.     my $self = shift; my $comment = shift; my $sub = shift;
  44.     return (&$sub($comment, @_));
  45. }
  46.  
  47. sub visit_characters {
  48.     my $self = shift; my $characters = shift; my $sub = shift;
  49.     return (&$sub($characters, @_));
  50. }
  51.  
  52. ###
  53. ### Extend the XML::Grove::Document and XML::Grove::Element packages with our
  54. ### new function.
  55. ###
  56.  
  57. package XML::Grove::Document;
  58.  
  59. sub filter {
  60.     my $self = shift; my $sub = shift;
  61.  
  62.     return ($self->accept(XML::Grove::Sub->new, $sub, @_));
  63. }
  64.  
  65. package XML::Grove::Element;
  66.  
  67. sub filter {
  68.     my $self = shift; my $sub = shift;
  69.  
  70.     return ($self->accept(XML::Grove::Sub->new, $sub, @_));
  71. }
  72.  
  73. 1;
  74.  
  75. __END__
  76.  
  77. =head1 NAME
  78.  
  79. XML::Grove::Sub - run a filter sub over a grove
  80.  
  81. =head1 SYNOPSIS
  82.  
  83.  use XML::Grove::Sub;
  84.  
  85.  # Using filter method on XML::Grove::Document or XML::Grove::Element:
  86.  @results = $grove_object->filter(\&sub [, ...]);
  87.  
  88.  # Using an XML::Grove::Sub instance:
  89.  $filterer = XML::Grove::Sub->new();
  90.  @results = $grove_object->accept($filterer, \&sub [, ...]);
  91.  
  92. =head1 DESCRIPTION
  93.  
  94. C<XML::Grove::Sub> executes a sub, the filter, over all objects in a
  95. grove and returns a list of all the return values from the sub.  The
  96. sub is called with the grove object as it's first parameter and
  97. passing the rest of the arguments to the call to `C<filter()>' or
  98. `C<accept()>'.
  99.  
  100. =head1 EXAMPLE
  101.  
  102. The following filter will return a list of all `C<foo>' or `C<bar>'
  103. elements with an attribute `C<widget-no>' beginning with `C<A>' or
  104. `C<B>'.
  105.  
  106.   @results = $grove_obj->filter(sub {
  107.       my $obj = shift;
  108.  
  109.       if ($obj->isa('XML::Grove::Element')
  110.       && (($obj->{Name} eq 'foo')
  111.           || ($obj->{Name} eq 'bar'))
  112.       && ($obj->{Attributes}{'widget-no'} =~ /^[AB]/)) {
  113.       return ($obj);
  114.       }
  115.       return ();
  116.   });
  117.  
  118. =head1 AUTHOR
  119.  
  120. Ken MacLeod, ken@bitsko.slc.ut.us
  121.  
  122. =head1 SEE ALSO
  123.  
  124. perl(1), XML::Grove(3), Data::Grove::Visitor(3)
  125.  
  126. Extensible Markup Language (XML) <http://www.w3c.org/XML>
  127.  
  128. =cut
  129.