home *** CD-ROM | disk | FTP | other *** search
/ Chip 2000 May / Chip_2000-05_cd1.bin / zkuste / Perl / ActivePerl-5.6.0.613.msi / 䆊䌷䈹䈙䏵-䞅䞆䞀㡆䞃䄦䠥 / _a71d6e8221186ba77b9a939b412cb94d < prev    next >
Text File  |  2000-03-15  |  9KB  |  345 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-1998 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 $VERSION
  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. $VERSION = sprintf("%d.%02d", q$Revision: 2.6 $ =~ /(\d+)\.(\d+)/);
  85.  
  86. # Elements that should only be present in the header
  87. %isHeadElement = map { $_ => 1 } qw(title base link meta isindex script);
  88.  
  89. # Elements that should only be present in the body
  90. %isBodyElement = map { $_ => 1 } qw(h1 h2 h3 h4 h5 h6
  91.                     p div pre address blockquote
  92.                     xmp listing
  93.                     a img br hr
  94.                     ol ul dir menu li
  95.                     dl dt dd
  96.                     cite code em kbd samp strong var dfn strike
  97.                     b i u tt small big
  98.                     table tr td th caption
  99.                     form input select option textarea
  100.                     map area
  101.                     applet param
  102.                     isindex script
  103.                    ),
  104.                           # Also known are some Netscape extentions elements
  105.                                  qw(wbr nobr center blink font basefont);
  106.  
  107. # The following elements must be directly contained in some other
  108. # element than body.
  109.  
  110. %isPhraseMarkup = map { $_ => 1 } qw(cite code em kbd samp strong var b i u tt
  111.                      a img br hr
  112.                      wbr nobr center blink
  113.                      small big font basefont
  114.                      table
  115.                     );
  116.  
  117. %isList         = map { $_ => 1 } qw(ul ol dir menu);
  118. %isTableElement = map { $_ => 1 } qw(tr td th caption);
  119. %isFormElement  = map { $_ => 1 } qw(input select option textarea);
  120.  
  121.  
  122. sub new
  123. {
  124.     my $class = shift;
  125.     my $self = HTML::Element->new('html');  # Initialize HTML::Element part
  126.     $self->{'_buf'} = '';  # The HTML::Parser part of us needs this
  127.  
  128.     # Initialize parser settings
  129.     $self->{'_implicit_tags'}  = 1;
  130.     $self->{'_ignore_unknown'} = 1;
  131.     $self->{'_ignore_text'}    = 0;
  132.     $self->{'_warn'}           = 0;
  133.  
  134.     # Parse attributes passed in as arguments
  135.     my %attr = @_;
  136.     for (keys %attr) {
  137.     $self->{"_$_"} = $attr{$_};
  138.     }
  139.  
  140.     # rebless to our class
  141.     bless $self, $class; 
  142. }
  143.  
  144. sub _elem
  145. {
  146.     my($self, $elem, $val) = @_;
  147.     my $old = $self->{$elem};
  148.     $self->{$elem} = $val if defined $val;
  149.     return $old;
  150. }
  151.  
  152. sub implicit_tags  { shift->_elem('_implicit_tags',  @_); }
  153. sub ignore_unknown { shift->_elem('_ignore_unknown', @_); }
  154. sub ignore_text    { shift->_elem('_ignore_text',    @_); }
  155. sub warn           { shift->_elem('_warn',           @_); }
  156.  
  157. sub warning
  158. {
  159.     my $self = shift;
  160.     CORE::warn("HTML::Parse: $_[0]\n") if $self->{'_warn'};
  161. }
  162.  
  163. sub start
  164. {
  165.     my($self, $tag, $attr) = @_;
  166.  
  167.     my $pos  = $self->{'_pos'};
  168.     $pos = $self unless defined $pos;
  169.     my $ptag = $pos->{'_tag'};
  170.     my $e = HTML::Element->new($tag, %$attr);
  171.  
  172.     if (!$self->{'_implicit_tags'}) {
  173.     # do nothing
  174.     } elsif ($isBodyElement{$tag}) {
  175.  
  176.     # Ensure that we are within <body>
  177.     if ($pos->is_inside('head')) {
  178.         $self->end('head');
  179.         $pos = $self->insert_element('body', 1);
  180.         $ptag = $pos->tag;
  181.     } elsif (!$pos->is_inside('body')) {
  182.         $pos = $self->insert_element('body', 1);
  183.         $ptag = $pos->tag;
  184.     }
  185.  
  186.     # Handle implicit endings and insert based on <tag> and position
  187.     if ($tag eq 'p' || $tag =~ /^h[1-6]/ || $tag eq 'form') {
  188.         # Can't have <p>, <h#> or <form> inside these
  189.         $self->end([qw(p h1 h2 h3 h4 h5 h6 pre textarea)], 'li');
  190.     } elsif ($tag =~ /^[oud]l$/) {
  191.         # Can't have lists inside <h#>
  192.         if ($ptag =~ /^h[1-6]/) {
  193.         $self->end($ptag);
  194.         $pos = $self->insert_element('p', 1);
  195.         $ptag = 'p';
  196.         }
  197.     } elsif ($tag eq 'li') {
  198.         # Fix <li> outside list
  199.         $self->end('li', keys %isList);
  200.         $ptag = $self->pos->tag;
  201.         $pos = $self->insert_element('ul', 1) unless $isList{$ptag};
  202.     } elsif ($tag eq 'dt' || $tag eq 'dd') {
  203.         $self->end(['dt', 'dd'], 'dl');
  204.         $ptag = $self->pos->tag;
  205.         # Fix <dt> or <dd> outside <dl>
  206.         $pos = $self->insert_element('dl', 1) unless $ptag eq 'dl';
  207.     } elsif ($isFormElement{$tag}) {
  208.         return unless $pos->is_inside('form');
  209.         if ($tag eq 'option') {
  210.         # return unless $ptag eq 'select';
  211.         $self->end('option');
  212.         $ptag = $self->pos->tag;
  213.         $pos = $self->insert_element('select', 1)
  214.           unless $ptag eq 'select';
  215.         }
  216.     } elsif ($isTableElement{$tag}) {
  217.         $self->end($tag, 'table');
  218.         $pos = $self->insert_element('table', 1)
  219.           if !$pos->is_inside('table');
  220.     } elsif ($isPhraseMarkup{$tag}) {
  221.         if ($ptag eq 'body') {
  222.         $pos = $self->insert_element('p', 1);
  223.         }
  224.     }
  225.     } elsif ($isHeadElement{$tag}) {
  226.     if ($pos->is_inside('body')) {
  227.         $self->warning("Header element <$tag> in body");
  228.     } elsif (!$pos->is_inside('head')) {
  229.         $pos = $self->insert_element('head', 1);
  230.     }
  231.     } elsif ($tag eq 'html') {
  232.     if ($ptag eq 'html' && $pos->is_empty()) {
  233.         # migrate attributes to origial HTML element
  234.         for (keys %$attr) {
  235.         $self->attr($_, $attr->{$_});
  236.         }
  237.         return;
  238.     } else {
  239.         $self->warning("Skipping nested <html> element");
  240.         return;
  241.     }
  242.     } elsif ($tag eq 'head') {
  243.     if ($ptag ne 'html' && $pos->is_empty()) {
  244.         $self->warning("Skipping nested <head> element");
  245.         return;
  246.     }
  247.     } elsif ($tag eq 'body') {
  248.     if ($pos->is_inside('head')) {
  249.         $self->end('head');
  250.     } elsif ($ptag ne 'html') {
  251.         $self->warning("Skipping nested <body> element");
  252.         return;
  253.     }
  254.     } else {
  255.     # unknown tag
  256.     if ($self->{'_ignore_unknown'}) {
  257.         $self->warning("Skipping unknown tag $tag");
  258.         return;
  259.     }
  260.     }
  261.     $self->insert_element($e);
  262. }
  263.  
  264.  
  265. sub end
  266. {
  267.     my($self, $tag, @stop) = @_;
  268.  
  269.     # End the specified tag, but don't move above any of the @stop tags.
  270.     # The tag can also be a reference to an array.  Terminate the first
  271.     # tag found.
  272.  
  273.     my $p = $self->{'_pos'};
  274.     $p = $self unless defined($p);
  275.     if (ref $tag) {
  276.       PARENT:
  277.     while (defined $p) {
  278.         my $ptag = $p->{'_tag'};
  279.         for (@$tag) {
  280.         last PARENT if $ptag eq $_;
  281.         }
  282.         for (@stop) {
  283.         return if $ptag eq $_;
  284.         }
  285.         $p = $p->{'_parent'};
  286.     }
  287.     } else {
  288.     while (defined $p) {
  289.         my $ptag = $p->{'_tag'};
  290.         last if $ptag eq $tag;
  291.         for (@stop) {
  292.         return if $ptag eq $_;
  293.         }
  294.         $p = $p->{'_parent'};
  295.     }
  296.     }
  297.  
  298.     # Move position if the specified tag was found
  299.     $self->{'_pos'} = $p->{'_parent'} if defined $p;
  300. }
  301.  
  302.  
  303. sub text
  304. {
  305.     my $self = shift;
  306.     my $pos = $self->{'_pos'};
  307.     my $ignore_text = $self->{'_ignore_text'};
  308.  
  309.     $pos = $self unless defined($pos);
  310.  
  311.     my $text = shift;
  312.     return unless length $text;
  313.  
  314.     HTML::Entities::decode($text) unless $ignore_text;
  315.  
  316.     if ($pos->is_inside(qw(pre xmp listing))) {
  317.     return if $ignore_text;
  318.     $pos->push_content($text);
  319.     } else {
  320.     # return unless $text =~ /\S/;  # This is sometimes wrong
  321.  
  322.     my $ptag = $pos->{'_tag'};
  323.     if (!$self->{'_implicit_tags'} || $text !~ /\S/) {
  324.         # don't change anything
  325.     } elsif ($ptag eq 'head') {
  326.         $self->end('head');
  327.         $self->insert_element('body', 1);
  328.         $pos = $self->insert_element('p', 1);
  329.     } elsif ($ptag eq 'html') {
  330.         $self->insert_element('body', 1);
  331.         $pos = $self->insert_element('p', 1);
  332.     } elsif ($ptag eq 'body' ||
  333.            # $ptag eq 'li'   ||
  334.            # $ptag eq 'dd'   ||
  335.          $ptag eq 'form') {
  336.         $pos = $self->insert_element('p', 1);
  337.     }
  338.     return if $ignore_text;
  339.     $text =~ s/\s+/ /g;  # canoncial space
  340.     $pos->push_content($text);
  341.     }
  342. }
  343.  
  344. 1;
  345.