home *** CD-ROM | disk | FTP | other *** search
/ PC Welt 2006 November (DVD) / PCWELT_11_2006.ISO / casper / filesystem.squashfs / usr / share / doc / libxml-grove-perl / examples / my-html.pl < prev    next >
Encoding:
Perl Script  |  1999-10-23  |  2.2 KB  |  110 lines
  1. #
  2. # Copyright (C) 1997, 1998 Ken MacLeod
  3. # See the file COPYING for distribution terms.
  4. #
  5. # $Id: my-html.pl,v 1.5 1999/05/06 23:13:02 kmacleod Exp $
  6. #
  7.  
  8. # `my-html.pl' uses `accept_name' methods to generate calls back using
  9. # an element's name instead of the generic `visit_element'.  Because
  10. # we don't want to handle every single possible element name, Perl's
  11. # AUTOLOAD feature is used to pass through any elements we don't
  12. # handle.
  13.  
  14. use XML::Parser::PerlSAX;
  15. use XML::Grove;
  16. use XML::Grove::Builder;
  17. use XML::Grove::AsString;
  18. use Data::Grove::Visitor;
  19.  
  20. ($prog = $0) =~ s|.*/||g;
  21.  
  22. die "usage: $prog HTML-DOC\n"
  23.     if ($#ARGV != 0);
  24.  
  25. my $builder = XML::Grove::Builder->new;
  26. my $parser = XML::Parser::PerlSAX->new(Handler => $builder);
  27. my $grove = $parser->parse (Source => { SystemId => @ARGV[0] });
  28.  
  29. $grove->accept_name (MyHTML->new);
  30.  
  31. exit (0);
  32.  
  33. ######################################################################
  34. #
  35. # A Visitor package.
  36. #
  37.  
  38. package MyHTML;
  39.  
  40. use strict;
  41. use vars qw{$AUTOLOAD};
  42.  
  43. sub new {
  44.     my $class = shift;
  45.  
  46.     return bless {}, $class;
  47. }
  48.  
  49. sub visit_document {
  50.     my $self = shift;
  51.     my $grove = shift;
  52.  
  53.     $grove->children_accept_name ($self, @_);
  54. }
  55.  
  56. sub visit_element {
  57.     my $self = shift;
  58.     my $element = shift;
  59.     print "<$element->{Name}>";
  60.     $element->children_accept_name ($self, @_);
  61.     print "</$element->{Name}>";
  62. }
  63.  
  64. sub visit_entity {
  65.     my $self = shift;
  66.     my $entity = shift;
  67.  
  68.     warn "is entity?\n";
  69.     print "&" . $entity->{Name} . ";";
  70. }
  71.  
  72. sub visit_characters {
  73.     my $self = shift;
  74.     my $characters = shift;
  75.     my $data = $characters->{Data};
  76.  
  77.     # FIXME do we need to translate special chars here?
  78.     $data =~ tr/\r/\n/;
  79.     print $data;
  80. }
  81.  
  82. ######################################################################
  83. #
  84. # My special HTML tags
  85. #
  86.  
  87. sub visit_name_DATE {
  88.     my $time = localtime;
  89.  
  90.     # use only non-breaking spaces
  91.     $time =~ s/ /\ /g;
  92.  
  93.     print $time;
  94. }
  95.  
  96. sub visit_name_PERL {
  97.     my $self = shift;
  98.     my $element = shift;
  99.  
  100.     # doesn't grok entities, be sure to use CDATA marked sections
  101.     my $perl = $element->as_string;
  102.     $perl =~ tr/\r//d;
  103.     no strict;
  104.     eval $perl;
  105.     use strict;
  106.     warn $@ if $@;
  107. }
  108.  
  109. 1;
  110.