home *** CD-ROM | disk | FTP | other *** search
/ Acorn User 10 / AU_CD10.iso / Archived / Updates / Perl / libwww_for_perl_109 / site_perl / HTML / TreeBuilder.pm < prev   
Text File  |  1996-06-09  |  9KB  |  344 lines
  1. package HTML::TreeBuilder;
  2.  
  3. =head1 NAME
  4.  
  5. HTML::TreeBuilder - Parser that builds a HTML syntax tree
  6.  
  7. =head1 SYNOPSIS
  8.  
  9.  $h = new HTML::TreeBuilder;
  10.  $h->parse($document);
  11.  #...
  12.  
  13.  print $h->as_HTML;  # or any other HTML::Element method
  14.  
  15. =head1 DESCRIPTION
  16.  
  17. This is a parser that builds (and actually itself is) a HTML syntax tree.
  18.  
  19. Objects of this class inherit the methods of both C<HTML::Parser> and
  20. C<HTML::Element>.  After parsing has taken place it can be regarded as
  21. the syntax tree itself.
  22.  
  23. The following method all control how parsing takes place.  You can set
  24. the attributes by passing a TRUE or FALSE value as argument.
  25.  
  26. =over 4
  27.  
  28. =item $p->implicit_tags
  29.  
  30. Setting this attribute to true will instruct the parser to try to
  31. deduce implicit elements and implicit end tags.  If it is false you
  32. get a parse tree that just reflects the text as it stands.  Might be
  33. useful for quick & dirty parsing.  Default is true.
  34.  
  35. Implicit elements have the implicit() attribute set.
  36.  
  37. =item $p->ignore_unknown
  38.  
  39. This attribute controls whether unknown tags should be represented as
  40. elements in the parse tree.  Default is true.
  41.  
  42. =item $p->ignore_text
  43.  
  44. Do not represent the text content of elements.  This saves space if
  45. all you want is to examine the structure of the document.  Default is
  46. false.
  47.  
  48. =item $p->warn
  49.  
  50. Call warn() with an appropriate message for syntax errors.  Default is
  51. false.
  52.  
  53. =back
  54.  
  55.  
  56. =head1 SEE ALSO
  57.  
  58. L<HTML::Parser>, L<HTML::Element>
  59.  
  60. =head1 COPYRIGHT
  61.  
  62. Copyright 1995-1996 Gisle Aas. All rights reserved.
  63.  
  64. This library is free software; you can redistribute it and/or
  65. modify it under the same terms as Perl itself.
  66.  
  67. =head1 AUTHOR
  68.  
  69. Gisle Aas <aas@sn.no>
  70.  
  71. =cut
  72.  
  73. use HTML::Entities ();
  74.  
  75. use strict;
  76. use vars qw(@ISA
  77.             %isHeadElement %isBodyElement %isPhraseMarkup
  78.             %isList %isTableElement %isFormElement
  79.            );
  80.  
  81. require HTML::Element;
  82. require HTML::Parser;
  83. @ISA = qw(HTML::Element HTML::Parser);
  84.  
  85. # Elements that should only be present in the header
  86. %isHeadElement = map { $_ => 1 } qw(title base link meta isindex script);
  87.  
  88. # Elements that should only be present in the body
  89. %isBodyElement = map { $_ => 1 } qw(h1 h2 h3 h4 h5 h6
  90.                     p div pre address blockquote
  91.                     xmp listing
  92.                     a img br hr
  93.                     ol ul dir menu li
  94.                     dl dt dd
  95.                     cite code em kbd samp strong var dfn strike
  96.                     b i u tt small big
  97.                     table tr td th caption
  98.                     form input select option textarea
  99.                     map area
  100.                     applet param
  101.                     isindex script
  102.                    ),
  103.                           # Also known are some Netscape extentions elements
  104.                                  qw(wbr nobr center blink font basefont);
  105.  
  106. # The following elements must be directly contained in some other
  107. # element than body.
  108.  
  109. %isPhraseMarkup = map { $_ => 1 } qw(cite code em kbd samp strong var b i u tt
  110.                      a img br hr
  111.                      wbr nobr center blink
  112.                      small big font basefont
  113.                      table
  114.                     );
  115.  
  116. %isList         = map { $_ => 1 } qw(ul ol dir menu);
  117. %isTableElement = map { $_ => 1 } qw(tr td th caption);
  118. %isFormElement  = map { $_ => 1 } qw(input select option textarea);
  119.  
  120.  
  121. sub new
  122. {
  123.     my $class = shift;
  124.     my $self = HTML::Element->new('html');  # Initialize HTML::Element part
  125.     $self->{'_buf'} = '';  # The HTML::Parser part of us needs this
  126.  
  127.     # Initialize parser settings
  128.     $self->{'_implicit_tags'}  = 1;
  129.     $self->{'_ignore_unknown'} = 1;
  130.     $self->{'_ignore_text'}    = 0;
  131.     $self->{'_warn'}           = 0;
  132.  
  133.     # Parse attributes passed in as arguments
  134.     my %attr = @_;
  135.     for (keys %attr) {
  136.     $self->{"_$_"} = $attr{$_};
  137.     }
  138.  
  139.     # rebless to our class
  140.     bless $self, $class; 
  141. }
  142.  
  143. sub _elem
  144. {
  145.     my($self, $elem, $val) = @_;
  146.     my $old = $self->{$elem};
  147.     $self->{$elem} = $val if defined $val;
  148.     return $old;
  149. }
  150.  
  151. sub implicit_tags  { shift->_elem('_implicit_tags',  @_); }
  152. sub ignore_unknown { shift->_elem('_ignore_unknown', @_); }
  153. sub ignore_text    { shift->_elem('_ignore_text',    @_); }
  154. sub warn           { shift->_elem('_warn',           @_); }
  155.  
  156. sub warning
  157. {
  158.     my $self = shift;
  159.     warn "HTML::Parse: $_[0]\n" if $self->{'_warn'};
  160. }
  161.  
  162. sub start
  163. {
  164.     my($self, $tag, $attr) = @_;
  165.  
  166.     my $pos  = $self->{'_pos'};
  167.     $pos = $self unless defined $pos;
  168.     my $ptag = $pos->{'_tag'};
  169.     my $e = HTML::Element->new($tag, %$attr);
  170.  
  171.     if (!$self->{'_implicit_tags'}) {
  172.     # do nothing
  173.     } elsif ($isBodyElement{$tag}) {
  174.  
  175.     # Ensure that we are within <body>
  176.     if ($pos->is_inside('head')) {
  177.         $self->end('head');
  178.         $pos = $self->insert_element('body', 1);
  179.         $ptag = $pos->tag;
  180.     } elsif (!$pos->is_inside('body')) {
  181.         $pos = $self->insert_element('body', 1);
  182.         $ptag = $pos->tag;
  183.     }
  184.  
  185.     # Handle implicit endings and insert based on <tag> and position
  186.     if ($tag eq 'p' || $tag =~ /^h[1-6]/ || $tag eq 'form') {
  187.         # Can't have <p>, <h#> or <form> inside these
  188.         $self->end([qw(p h1 h2 h3 h4 h5 h6 pre textarea)], 'li');
  189.     } elsif ($tag =~ /^[oud]l$/) {
  190.         # Can't have lists inside <h#>
  191.         if ($ptag =~ /^h[1-6]/) {
  192.         $self->end($ptag);
  193.         $pos = $self->insert_element('p', 1);
  194.         $ptag = 'p';
  195.         }
  196.     } elsif ($tag eq 'li') {
  197.         # Fix <li> outside list
  198.         $self->end('li', keys %isList);
  199.         $ptag = $self->pos->tag;
  200.         $pos = $self->insert_element('ul', 1) unless $isList{$ptag};
  201.     } elsif ($tag eq 'dt' || $tag eq 'dd') {
  202.         $self->end(['dt', 'dd'], 'dl');
  203.         $ptag = $self->pos->tag;
  204.         # Fix <dt> or <dd> outside <dl>
  205.         $pos = $self->insert_element('dl', 1) unless $ptag eq 'dl';
  206.     } elsif ($isFormElement{$tag}) {
  207.         return unless $pos->is_inside('form');
  208.         if ($tag eq 'option') {
  209.         # return unless $ptag eq 'select';
  210.         $self->end('option');
  211.         $ptag = $self->pos->tag;
  212.         $pos = $self->insert_element('select', 1)
  213.           unless $ptag eq 'select';
  214.         }
  215.     } elsif ($isTableElement{$tag}) {
  216.         $self->end($tag, 'table');
  217.         $pos = $self->insert_element('table', 1)
  218.           if !$pos->is_inside('table');
  219.     } elsif ($isPhraseMarkup{$tag}) {
  220.         if ($ptag eq 'body') {
  221.         $pos = $self->insert_element('p', 1);
  222.         }
  223.     }
  224.     } elsif ($isHeadElement{$tag}) {
  225.     if ($pos->is_inside('body')) {
  226.         $self->warning("Header element <$tag> in body");
  227.     } elsif (!$pos->is_inside('head')) {
  228.         $pos = $self->insert_element('head', 1);
  229.     }
  230.     } elsif ($tag eq 'html') {
  231.     if ($ptag eq 'html' && $pos->is_empty()) {
  232.         # migrate attributes to origial HTML element
  233.         for (keys %$attr) {
  234.         $self->attr($_, $attr->{$_});
  235.         }
  236.         return;
  237.     } else {
  238.         $self->warning("Skipping nested <html> element");
  239.         return;
  240.     }
  241.     } elsif ($tag eq 'head') {
  242.     if ($ptag ne 'html' && $pos->is_empty()) {
  243.         $self->warning("Skipping nested <head> element");
  244.         return;
  245.     }
  246.     } elsif ($tag eq 'body') {
  247.     if ($pos->is_inside('head')) {
  248.         $self->end('head');
  249.     } elsif ($ptag ne 'html') {
  250.         $self->warning("Skipping nested <body> element");
  251.         return;
  252.     }
  253.     } else {
  254.     # unknown tag
  255.     if ($self->{'_ignore_unknown'}) {
  256.         $self->warning("Skipping unknown tag $tag");
  257.         return;
  258.     }
  259.     }
  260.     $self->insert_element($e);
  261. }
  262.  
  263.  
  264. sub end
  265. {
  266.     my($self, $tag, @stop) = @_;
  267.  
  268.     # End the specified tag, but don't move above any of the @stop tags.
  269.     # The tag can also be a reference to an array.  Terminate the first
  270.     # tag found.
  271.  
  272.     my $p = $self->{'_pos'};
  273.     $p = $self unless defined($p);
  274.     if (ref $tag) {
  275.       PARENT:
  276.     while (defined $p) {
  277.         my $ptag = $p->{'_tag'};
  278.         for (@$tag) {
  279.         last PARENT if $ptag eq $_;
  280.         }
  281.         for (@stop) {
  282.         return if $ptag eq $_;
  283.         }
  284.         $p = $p->{'_parent'};
  285.     }
  286.     } else {
  287.     while (defined $p) {
  288.         my $ptag = $p->{'_tag'};
  289.         last if $ptag eq $tag;
  290.         for (@stop) {
  291.         return if $ptag eq $_;
  292.         }
  293.         $p = $p->{'_parent'};
  294.     }
  295.     }
  296.  
  297.     # Move position if the specified tag was found
  298.     $self->{'_pos'} = $p->{'_parent'} if defined $p;
  299. }
  300.  
  301.  
  302. sub text
  303. {
  304.     my $self = shift;
  305.     my $pos = $self->{'_pos'};
  306.     my $ignore_text = $self->{'_ignore_text'};
  307.  
  308.     $pos = $self unless defined($pos);
  309.  
  310.     my $text = shift;
  311.     return unless length $text;
  312.  
  313.     HTML::Entities::decode($text) unless $ignore_text;
  314.  
  315.     if ($pos->is_inside(qw(pre xmp listing))) {
  316.     return if $ignore_text;
  317.     $pos->push_content($text);
  318.     } else {
  319.     # return unless $text =~ /\S/;  # This is sometimes wrong
  320.  
  321.     my $ptag = $pos->{'_tag'};
  322.     if (!$self->{'_implicit_tags'} || $text !~ /\S/) {
  323.         # don't change anything
  324.     } elsif ($ptag eq 'head') {
  325.         $self->end('head');
  326.         $self->insert_element('body', 1);
  327.         $pos = $self->insert_element('p', 1);
  328.     } elsif ($ptag eq 'html') {
  329.         $self->insert_element('body', 1);
  330.         $pos = $self->insert_element('p', 1);
  331.     } elsif ($ptag eq 'body' ||
  332.            # $ptag eq 'li'   ||
  333.            # $ptag eq 'dd'   ||
  334.          $ptag eq 'form') {
  335.         $pos = $self->insert_element('p', 1);
  336.     }
  337.     return if $ignore_text;
  338.     $text =~ s/\s+/ /g;  # canoncial space
  339.     $pos->push_content($text);
  340.     }
  341. }
  342.  
  343. 1;
  344.