home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / xampp / xampp-perl-addon-1.4.9-installer.exe / Visitor.pm < prev    next >
Encoding:
Text File  |  2001-07-17  |  5.7 KB  |  211 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.5 1999/12/22 21:15:00 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.07";
  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.  
  127. 1;
  128.  
  129. __END__
  130.  
  131. =head1 NAME
  132.  
  133. Data::Grove::Visitor - add visitor/callback methods to Data::Grove objects
  134.  
  135. =head1 SYNOPSIS
  136.  
  137.  use Data::Grove::Visitor;
  138.  
  139.  @results = $object->accept ($visitor, ...);
  140.  @results = $object->accept_name ($visitor, ...);
  141.  @results = $object->children_accept ($visitor, ...);
  142.  @results = $object->children_accept_name ($visitor, ...);
  143.  
  144. =head1 DESCRIPTION
  145.  
  146. Data::Grove::Visitor adds visitor methods (callbacks) to Data::Grove
  147. objects.  A ``visitor'' is a class (a package) you write that has
  148. methods (subs) corresponding to the objects in the classes being
  149. visited.  You use the visitor methods by creating an instance of your
  150. visitor class, and then calling `C<accept($my_visitor)>' on the
  151. top-most object you want to visit, that object will in turn call your
  152. visitor back with `C<visit_I<OBJECT>>', where I<OBJECT> is the type of
  153. object.
  154.  
  155. There are several forms of `C<accept>'.  Simply calling `C<accept>'
  156. calls your package back using the object type of the object you are
  157. visiting.  Calling `C<accept_name>' on an element object calls you
  158. back with `C<visit_name_I<NAME>>' where I<NAME> is the tag name of the
  159. element, on all other objects it's as if you called `C<accept>'.
  160.  
  161. All of the forms of `C<accept>' return a concatenated list of the
  162. result of all `C<visit>' methods.
  163.  
  164. `C<children_accept>' calls `C<accept>' on each of the children of the
  165. element.  This is generally used in element callbacks to recurse down
  166. into the element's children, you don't need to get the element's
  167. contents and call `C<accept>' on each item.  `C<children_accept_name>'
  168. does the same but calling `C<accept_name>' on each of the children.
  169. `C<attr_accept>' calls `C<accept>' on each of the objects in the named
  170. attribute.
  171.  
  172. Refer to the documentation of the classes you are visiting
  173. (XML::Grove, etc.) for the type names (`C<element>', `C<document>',
  174. etc.) of the objects it implements.
  175.  
  176. =head1 RESERVED NAMES
  177.  
  178. The hash keys `C<Contents>' and `C<Name>' are used to indicate objects
  179. with children (for `C<children_accept>') and named objects (for
  180. `C<accept_name>').
  181.  
  182. =head1 NOTES
  183.  
  184. These are random ideas that haven't been implemented yet:
  185.  
  186. =over 4
  187.  
  188. =item *
  189.  
  190. Several objects fall into subclasses, or you may want to be able to
  191. subclass a visited object and still be able to tell the difference.
  192. In SGML::Grove I had used the package name in the callback
  193. (`C<visit_SGML_Element>') instead of a generic name
  194. (`C<visit_element>').  The idea here would be to try calling
  195. `C<visit_I<PACKAGE>>' with the most specific class first, then try
  196. superclasses, and lastly to try the generic.
  197.  
  198. =back
  199.  
  200. =head1 AUTHOR
  201.  
  202. Ken MacLeod, ken@bitsko.slc.ut.us
  203.  
  204. =head1 SEE ALSO
  205.  
  206. perl(1), Data::Grove
  207.  
  208. Extensible Markup Language (XML) <http://www.w3c.org/XML>
  209.  
  210. =cut
  211.