Chip 2000 May/Chip_2000-05_cd1.bin/zkuste/Perl/ActivePerl-5.6.0.613.msi/䆊䌷䈹䈙䏵-䞅䞆䞀㡆䞃䄦䠥/_a71d6e8221186ba77b9a939b412cb94d

Text File | 2000-03-15 | 9.1 KB | 345 lines

package HTML::TreeBuilder;

=head1 NAME

HTML::TreeBuilder - Parser that builds a HTML syntax tree

=head1 SYNOPSIS

 $h = new HTML::TreeBuilder;
 $h->parse($document);
 #...

 print $h->as_HTML;  # or any other HTML::Element method

=head1 DESCRIPTION

This is a parser that builds (and actually itself is) a HTML syntax tree.

Objects of this class inherit the methods of both C<HTML::Parser> and
C<HTML::Element>.  After parsing has taken place it can be regarded as
the syntax tree itself.

The following method all control how parsing takes place.  You can set
the attributes by passing a TRUE or FALSE value as argument.

=over 4

=item $p->implicit_tags

Setting this attribute to true will instruct the parser to try to
deduce implicit elements and implicit end tags.  If it is false you
get a parse tree that just reflects the text as it stands.  Might be
useful for quick & dirty parsing.  Default is true.

Implicit elements have the implicit() attribute set.

=item $p->ignore_unknown

This attribute controls whether unknown tags should be represented as
elements in the parse tree.  Default is true.

=item $p->ignore_text

Do not represent the text content of elements.  This saves space if
all you want is to examine the structure of the document.  Default is
false.

=item $p->warn

Call warn() with an appropriate message for syntax errors.  Default is
false.

=back


=head1 SEE ALSO

L<HTML::Parser>, L<HTML::Element>

=head1 COPYRIGHT

Copyright 1995-1998 Gisle Aas. All rights reserved.

This library is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

=head1 AUTHOR

Gisle Aas <[e-mail]>

=cut

use HTML::Entities ();

use strict;
use vars qw(@ISA $VERSION
            %isHeadElement %isBodyElement %isPhraseMarkup
            %isList %isTableElement %isFormElement
           );

require HTML::Element;
require HTML::Parser;
@ISA = qw(HTML::Element HTML::Parser);
$VERSION = sprintf("%d.%02d", q$Revision: 2.6 $ =~ /(\d+)\.(\d+)/);

# Elements that should only be present in the header
%isHeadElement = map { $_ => 1 } qw(title base link meta isindex script);

# Elements that should only be present in the body
%isBodyElement = map { $_ => 1 } qw(h1 h2 h3 h4 h5 h6
                    p div pre address blockquote
                    xmp listing
                    a img br hr
                    ol ul dir menu li
                    dl dt dd
                    cite code em kbd samp strong var dfn strike
                    b i u tt small big
                    table tr td th caption
                    form input select option textarea
                    map area
                    applet param
                    isindex script
                   ),
                          # Also known are some Netscape extentions elements
                                 qw(wbr nobr center blink font basefont);

# The following elements must be directly contained in some other
# element than body.

%isPhraseMarkup = map { $_ => 1 } qw(cite code em kbd samp strong var b i u tt
                     a img br hr
                     wbr nobr center blink
                     small big font basefont
                     table
                    );

%isList         = map { $_ => 1 } qw(ul ol dir menu);
%isTableElement = map { $_ => 1 } qw(tr td th caption);
%isFormElement  = map { $_ => 1 } qw(input select option textarea);


sub new
{
    my $class = shift;
    my $self = HTML::Element->new('html');  # Initialize HTML::Element part
    $self->{'_buf'} = '';  # The HTML::Parser part of us needs this

    # Initialize parser settings
    $self->{'_implicit_tags'}  = 1;
    $self->{'_ignore_unknown'} = 1;
    $self->{'_ignore_text'}    = 0;
    $self->{'_warn'}           = 0;

    # Parse attributes passed in as arguments
    my %attr = @_;
    for (keys %attr) {
    $self->{"_$_"} = $attr{$_};
    }

    # rebless to our class
    bless $self, $class;
}

sub _elem
{
    my($self, $elem, $val) = @_;
    my $old = $self->{$elem};
    $self->{$elem} = $val if defined $val;
    return $old;
}

sub implicit_tags  { shift->_elem('_implicit_tags',  @_); }
sub ignore_unknown { shift->_elem('_ignore_unknown', @_); }
sub ignore_text    { shift->_elem('_ignore_text',    @_); }
sub warn           { shift->_elem('_warn',           @_); }

sub warning
{
    my $self = shift;
    CORE::warn("HTML::Parse: $_[0]\n") if $self->{'_warn'};
}

sub start
{
    my($self, $tag, $attr) = @_;

    my $pos  = $self->{'_pos'};
    $pos = $self unless defined $pos;
    my $ptag = $pos->{'_tag'};
    my $e = HTML::Element->new($tag, %$attr);

    if (!$self->{'_implicit_tags'}) {
    # do nothing
    } elsif ($isBodyElement{$tag}) {

    # Ensure that we are within <body>
    if ($pos->is_inside('head')) {
        $self->end('head');
        $pos = $self->insert_element('body', 1);
        $ptag = $pos->tag;
    } elsif (!$pos->is_inside('body')) {
        $pos = $self->insert_element('body', 1);
        $ptag = $pos->tag;
    }

    # Handle implicit endings and insert based on <tag> and position
    if ($tag eq 'p' || $tag =~ /^h[1-6]/ || $tag eq 'form') {
        # Can't have <p>, <h#> or <form> inside these
        $self->end([qw(p h1 h2 h3 h4 h5 h6 pre textarea)], 'li');
    } elsif ($tag =~ /^[oud]l$/) {
        # Can't have lists inside <h#>
        if ($ptag =~ /^h[1-6]/) {
        $self->end($ptag);
        $pos = $self->insert_element('p', 1);
        $ptag = 'p';
        }
    } elsif ($tag eq 'li') {
        # Fix <li> outside list
        $self->end('li', keys %isList);
        $ptag = $self->pos->tag;
        $pos = $self->insert_element('ul', 1) unless $isList{$ptag};
    } elsif ($tag eq 'dt' || $tag eq 'dd') {
        $self->end(['dt', 'dd'], 'dl');
        $ptag = $self->pos->tag;
        # Fix <dt> or <dd> outside <dl>
        $pos = $self->insert_element('dl', 1) unless $ptag eq 'dl';
    } elsif ($isFormElement{$tag}) {
        return unless $pos->is_inside('form');
        if ($tag eq 'option') {
        # return unless $ptag eq 'select';
        $self->end('option');
        $ptag = $self->pos->tag;
        $pos = $self->insert_element('select', 1)
          unless $ptag eq 'select';
        }
    } elsif ($isTableElement{$tag}) {
        $self->end($tag, 'table');
        $pos = $self->insert_element('table', 1)
          if !$pos->is_inside('table');
    } elsif ($isPhraseMarkup{$tag}) {
        if ($ptag eq 'body') {
        $pos = $self->insert_element('p', 1);
        }
    }
    } elsif ($isHeadElement{$tag}) {
    if ($pos->is_inside('body')) {
        $self->warning("Header element <$tag> in body");
    } elsif (!$pos->is_inside('head')) {
        $pos = $self->insert_element('head', 1);
    }
    } elsif ($tag eq 'html') {
    if ($ptag eq 'html' && $pos->is_empty()) {
        # migrate attributes to origial HTML element
        for (keys %$attr) {
        $self->attr($_, $attr->{$_});
        }
        return;
    } else {
        $self->warning("Skipping nested <html> element");
        return;
    }
    } elsif ($tag eq 'head') {
    if ($ptag ne 'html' && $pos->is_empty()) {
        $self->warning("Skipping nested <head> element");
        return;
    }
    } elsif ($tag eq 'body') {
    if ($pos->is_inside('head')) {
        $self->end('head');
    } elsif ($ptag ne 'html') {
        $self->warning("Skipping nested <body> element");
        return;
    }
    } else {
    # unknown tag
    if ($self->{'_ignore_unknown'}) {
        $self->warning("Skipping unknown tag $tag");
        return;
    }
    }
    $self->insert_element($e);
}


sub end
{
    my($self, $tag, @stop) = @_;

    # End the specified tag, but don't move above any of the @stop tags.
    # The tag can also be a reference to an array.  Terminate the first
    # tag found.

    my $p = $self->{'_pos'};
    $p = $self unless defined($p);
    if (ref $tag) {
      PARENT:
    while (defined $p) {
        my $ptag = $p->{'_tag'};
        for (@$tag) {
        last PARENT if $ptag eq $_;
        }
        for (@stop) {
        return if $ptag eq $_;
        }
        $p = $p->{'_parent'};
    }
    } else {
    while (defined $p) {
        my $ptag = $p->{'_tag'};
        last if $ptag eq $tag;
        for (@stop) {
        return if $ptag eq $_;
        }
        $p = $p->{'_parent'};
    }
    }

    # Move position if the specified tag was found
    $self->{'_pos'} = $p->{'_parent'} if defined $p;
}


sub text
{
    my $self = shift;
    my $pos = $self->{'_pos'};
    my $ignore_text = $self->{'_ignore_text'};

    $pos = $self unless defined($pos);

    my $text = shift;
    return unless length $text;

    HTML::Entities::decode($text) unless $ignore_text;

    if ($pos->is_inside(qw(pre xmp listing))) {
    return if $ignore_text;
    $pos->push_content($text);
    } else {
    # return unless $text =~ /\S/;  # This is sometimes wrong

    my $ptag = $pos->{'_tag'};
    if (!$self->{'_implicit_tags'} || $text !~ /\S/) {
        # don't change anything
    } elsif ($ptag eq 'head') {
        $self->end('head');
        $self->insert_element('body', 1);
        $pos = $self->insert_element('p', 1);
    } elsif ($ptag eq 'html') {
        $self->insert_element('body', 1);
        $pos = $self->insert_element('p', 1);
    } elsif ($ptag eq 'body' ||
           # $ptag eq 'li'   ||
           # $ptag eq 'dd'   ||
         $ptag eq 'form') {
        $pos = $self->insert_element('p', 1);
    }
    return if $ignore_text;
    $text =~ s/\s+/ /g;  # canoncial space
    $pos->push_content($text);
    }
}

1;