home *** CD-ROM | disk | FTP | other *** search
/ PC Welt 2006 November (DVD) / PCWELT_11_2006.ISO / casper / filesystem.squashfs / usr / share / perl5 / Data / Grove / Visitor.pm < prev   
Encoding:
Text File  |  2003-10-21  |  5.5 KB  |  213 lines
  1. #
  2. # Copyright (C) 1998,1999 Ken MacLeod
  3. # Data::Grove::Visitor is free software; you can redistribute it and/or
  4. # modify it under the same terms as Perl itself.
  5. #
  6. # $Id: Visitor.pm,v 1.6 2000/03/20 23:06:45 kmacleod Exp $
  7. #
  8.  
  9. use strict;
  10. use 5.005;
  11.  
  12. package Data::Grove::Visitor;
  13.  
  14. use vars qw{ $VERSION };
  15.  
  16. # will be substituted by make-rel script
  17. $VERSION = "0.08";
  18.  
  19. # The following methods extend Data::Grove
  20. package Data::Grove;
  21.  
  22. sub accept {
  23.     my $self = shift;
  24.     my $visitor = shift;
  25.  
  26.     my $type_name;
  27.     my $package = ref($self);
  28.     eval "\$type_name = \$${package}::type_name";
  29.     if (!defined $type_name) {
  30.     return (); # no action
  31.     }
  32.  
  33.     my $method_name = 'visit_' . $type_name;
  34.     if ($visitor->can($method_name)) {
  35.     return $visitor->$method_name ($self, @_);
  36.     } else {
  37.     return (); # no action
  38.     }
  39. }
  40.  
  41. sub accept_name {
  42.     my $self = shift;
  43.  
  44.     if (!defined $self->{Name}) {
  45.     return $self->accept (@_);
  46.     }
  47.  
  48.     my $visitor = shift;
  49.  
  50.     my $name = $self->{Name};
  51.     $name =~ s/\W/_/g;
  52.     my $name_method = "visit_name_$name";
  53.  
  54.     if (!$self->{'has'}{$name_method}) {
  55.     return if (defined $self->{'has'}{$name_method});
  56.     $self->{'has'}{$name_method} = $visitor->can($name_method);
  57.     return $self->accept($visitor, @_) if (!$self->{'has'}{$name_method});
  58.     }
  59.  
  60.     return $visitor->$name_method ($self, @_);
  61. }
  62.  
  63. sub attr_accept {
  64.     my $self = shift; my $attr = shift; my $visitor = shift;
  65.  
  66.     if (!defined $self->{Attributes}) {
  67.     return (); # no action
  68.     }
  69.  
  70.     my $attrs = $self->{Attributes}{$attr};
  71.     if (ref($attrs) eq 'ARRAY') {
  72.     return $self->_children_accept ($attrs, $visitor, @_);
  73.     } else {
  74.  
  75.     if (!$self->{has_visit_characters}) {
  76.         return if (defined $self->{has_visit_characters});
  77.         $self->{has_visit_characters} = $visitor->can('visit_characters');
  78.         return if (!$self->{has_visit_characters});
  79.     }
  80.     # FIXME should be some other generic than XML::Grove::Characters
  81.     return $visitor->visit_characters (XML::Grove::Characters->new(Data => $attrs), @_);
  82.     }
  83. }
  84.  
  85. sub children_accept {
  86.     my $self = shift;
  87.  
  88.     if (defined $self->{Contents}) {
  89.     return $self->_children_accept ($self->{Contents}, @_);
  90.     } else {
  91.     return (); # no action
  92.     }
  93. }
  94.  
  95. sub children_accept_name {
  96.     my $self = shift;
  97.  
  98.     if (defined $self->{Contents}) {
  99.     return $self->_children_accept_name ($self->{Contents}, @_);
  100.     } else {
  101.     return (); # no action
  102.     }
  103. }
  104.  
  105. sub _children_accept {
  106.     my $self = shift; my $array = shift; my $visitor = shift;
  107.  
  108.     my @return;
  109.     my $ii;
  110.     for ($ii = 0; $ii <= $#$array; $ii ++) {
  111.     push @return, $array->[$ii]->accept ($visitor, @_);
  112.     }
  113.  
  114.     return @return;
  115. }
  116.  
  117. sub _children_accept_name {
  118.     my $self = shift; my $array = shift; my $visitor = shift;
  119.  
  120.     my @return;
  121.     my $ii;
  122.     for ($ii = 0; $ii <= $#$array; $ii ++) {
  123.     push @return, $array->[$ii]->accept_name ($visitor, @_);
  124.     }
  125.  
  126.     return @return;
  127. }
  128.  
  129. 1;
  130.  
  131. __END__
  132.  
  133. =head1 NAME
  134.  
  135. Data::Grove::Visitor - add visitor/callback methods to Data::Grove objects
  136.  
  137. =head1 SYNOPSIS
  138.  
  139.  use Data::Grove::Visitor;
  140.  
  141.  @results = $object->accept ($visitor, ...);
  142.  @results = $object->accept_name ($visitor, ...);
  143.  @results = $object->children_accept ($visitor, ...);
  144.  @results = $object->children_accept_name ($visitor, ...);
  145.  
  146. =head1 DESCRIPTION
  147.  
  148. Data::Grove::Visitor adds visitor methods (callbacks) to Data::Grove
  149. objects.  A ``visitor'' is a class (a package) you write that has
  150. methods (subs) corresponding to the objects in the classes being
  151. visited.  You use the visitor methods by creating an instance of your
  152. visitor class, and then calling `C<accept($my_visitor)>' on the
  153. top-most object you want to visit, that object will in turn call your
  154. visitor back with `C<visit_I<OBJECT>>', where I<OBJECT> is the type of
  155. object.
  156.  
  157. There are several forms of `C<accept>'.  Simply calling `C<accept>'
  158. calls your package back using the object type of the object you are
  159. visiting.  Calling `C<accept_name>' on an element object calls you
  160. back with `C<visit_name_I<NAME>>' where I<NAME> is the tag name of the
  161. element, on all other objects it's as if you called `C<accept>'.
  162.  
  163. All of the forms of `C<accept>' return a concatenated list of the
  164. result of all `C<visit>' methods.
  165.  
  166. `C<children_accept>' calls `C<accept>' on each of the children of the
  167. element.  This is generally used in element callbacks to recurse down
  168. into the element's children, you don't need to get the element's
  169. contents and call `C<accept>' on each item.  `C<children_accept_name>'
  170. does the same but calling `C<accept_name>' on each of the children.
  171. `C<attr_accept>' calls `C<accept>' on each of the objects in the named
  172. attribute.
  173.  
  174. Refer to the documentation of the classes you are visiting
  175. (XML::Grove, etc.) for the type names (`C<element>', `C<document>',
  176. etc.) of the objects it implements.
  177.  
  178. =head1 RESERVED NAMES
  179.  
  180. The hash keys `C<Contents>' and `C<Name>' are used to indicate objects
  181. with children (for `C<children_accept>') and named objects (for
  182. `C<accept_name>').
  183.  
  184. =head1 NOTES
  185.  
  186. These are random ideas that haven't been implemented yet:
  187.  
  188. =over 4
  189.  
  190. =item *
  191.  
  192. Several objects fall into subclasses, or you may want to be able to
  193. subclass a visited object and still be able to tell the difference.
  194. In SGML::Grove I had used the package name in the callback
  195. (`C<visit_SGML_Element>') instead of a generic name
  196. (`C<visit_element>').  The idea here would be to try calling
  197. `C<visit_I<PACKAGE>>' with the most specific class first, then try
  198. superclasses, and lastly to try the generic.
  199.  
  200. =back
  201.  
  202. =head1 AUTHOR
  203.  
  204. Ken MacLeod, ken@bitsko.slc.ut.us
  205.  
  206. =head1 SEE ALSO
  207.  
  208. perl(1), Data::Grove
  209.  
  210. Extensible Markup Language (XML) <http://www.w3c.org/XML>
  211.  
  212. =cut
  213.