File Coverage

blib/lib/XML/Handler/HTMLWriter.pm

Criterion	Covered	Total	%
statement	96	108	88.8
branch	29	38	76.3
condition	13	15	86.6
subroutine	21	22	95.4
pod	1	1	100.0
total	160	184	86.9

# $Id: HTMLWriter.pm,v 1.7 2003/03/30 09:47:44 matt Exp $

package XML::Handler::HTMLWriter;

use strict;
use vars qw($VERSION @ISA);

$VERSION = '2.01';

use XML::SAX::Writer ();
use HTML::Entities ();
@ISA = ('XML::SAX::Writer');

sub new {
    my $class = shift;
    my $opt   = (@_ == 1)  ? { %{shift()} } : {@_};

    $opt->{Writer} = 'XML::SAX::Writer::HTML';

    return XML::SAX::Writer->new($opt);

    my $opt = XML::SAX::Writer->new(@_);

    @ISA = (ref($opt));

    return bless $opt, $class;
}

package XML::SAX::Writer::HTML;
use strict;
use XML::SAX::Writer::XML;
use vars qw(@ISA);
# NB: this only works because of how hacky XML::SAX::Writer is ;-)
@ISA = ('XML::SAX::Writer::XML');

sub print {
    my $self = shift;
    $self->{Consumer}->output($self->{Encoder}->convert(join('', @_)));
}

sub escape_attrib {
    my $self = shift;
    my $text = shift;
    $text =~ s/&(?!\{)/&/g;
    $text =~ s/"/"/g;
    return $text;
}

sub escape_url {
    my $self = shift;
    my $toencode = shift;
    $toencode =~ s/&(?!\{)/&/g;
    $toencode =~ s/([^a-zA-Z0-9_.&;-])/uc sprintf("%%%02x",ord($1))/eg;
    return $toencode;
}

sub escape_html {
    my $self = shift;
    return HTML::Entities::encode(join('', @_));
}

my @html_tags = qw(
    a abbr acronym address
    applet area b base
    basefont bdo big blockquote
    body br button caption
    center cite code col
    colgroup dd del dfn
    dir div dl dt
    em fieldset font form
    frame frameset h1 h2
    h3 h4 h5 h6
    head hr html i
    iframe img input ins
    isindex kbd label legend
    li link map menu
    meta noframes noscript object
    ol optgroup option p
    param pre q s
    samp script select small
    span strike strong style
    sub sup table tbody
    td textarea tfoot th
    thead title tr tt
    u ul var
    );

sub is_html_tag {
    my $self = shift;
    my $tag = lc(shift);

    return grep /^$tag$/, @html_tags;
}

my @empty_tags = qw(
    area base basefont
    br col frame hr img
    input isindex link
    meta param
    );

sub is_empty_tag {
    my $self = shift;
    my $tag = lc(shift);

    return grep /^$tag$/, @empty_tags;
}

my @uri_attribs = qw(
    form/action
    body/background
    blockquote/cite
    q/cite
    del/cite
    ins/cite
    object/classid
    object/codebase
    applet/codebase
    object/data
    a/href
    area/href
    link/href
    base/href
    img/longdesc
    frame/longdesc
    iframe/longdesc
    head/profile
    script/src
    input/src
    frame/src
    iframe/src
    img/src
    img/usemap
    input/usemap
    object/usemap
    );

sub is_url_attrib {
    my $self = shift;
    my $test = lc(shift);

    return grep /^$test$/, @uri_attribs;
}

my @bool_attribs = qw(
    input/checked
    dir/compact
    dl/compact
    menu/compact
    ol/compact
    ul/compact
    object/declare
    script/defer
    button/disabled
    input/disabled
    optgroup/disabled
    option/disabled
    select/disabled
    textarea/disabled
    img/ismap
    input/ismap
    select/multiple
    area/nohref
    frame/noresize
    hr/noshade
    td/nowrap
    th/nowrap
    textarea/readonly
    input/readonly
    option/selected
    );

sub is_boolean_attrib {
    my $self = shift;
    my $test = lc(shift);

    return grep /^$test$/, @bool_attribs;
}

sub start_document {
    my ($self, $doc) = @_;

    undef $self->{FirstElement};

    $self->SUPER::start_document($doc);
}

sub start_element {
    my ($self, $element) = @_;

    $element->{Parent} = $self->{Current_Element};
    $self->{Current_Element} = $element;

    if (!$self->{FirstElement}) {
        $self->{FirstElement}++;

        if (lc($element->{Name}) ne 'html' || $element->{NamespaceURI}) {
            die "First element has to be ";
        }

        if ($self->{DoctypePublic}) {
            $self->print(qq({DoctypePublic}"));
            if ($self->{DoctypeSystem}) {
                $self->print(qq( "$self->{DoctypeSystem}"));
            }
            $self->print(">\n");
        }
        elsif ($self->{DoctypeSystem}) {
            $self->print(qq({DoctypeSystem}">\n));
        }
        else {
            $self->print(
qq(
      "http://www.w3.org/TR/html4/strict.dtd">\n)
                );
        }
    }

    if (!$element->{NamespaceURI} && $self->is_html_tag($element->{Name})) {
        # HTML special cases...
        $self->print("<$element->{Name}");

        foreach my $attr (values %{$element->{Attributes}}) {
            my $test = "$element->{LocalName}/$attr->{Name}";
            if ($self->is_boolean_attrib($test)) {
                $self->print(" $attr->{Name}");
            }
            elsif ($self->is_url_attrib($test)) {
                $self->print(" $attr->{Name}=\"", $self->escape_url($attr->{Value}), "\"");
            }
            else {
                $self->print(" $attr->{Name}=\"",
                    $self->escape_attrib($attr->{Value}),
                    "\"");
            }
        }

        $self->print(">");

        if (lc($element->{LocalName}) eq 'script') {
            $self->print("\n") unless $self->{NoScriptComment};
        }
        $self->print("{Name}>");
    }
    else {
        $self->SUPER::end_element($element);
    }
}

sub characters {
    my ($self, $chars) = @_;

    my $element = $self->{Current_Element};

    if (!$element->{NamespaceURI} && $self->is_html_tag($element->{LocalName})) {
        if (lc($element->{LocalName}) =~ /^(script|style)$/) {
            $self->print($chars->{Data});
        }
        else {
            $self->print($self->escape_html($chars->{Data}));
        }
    }
    else {
        $self->SUPER::characters($chars);
    }
}

sub processing_instruction {
    my ($self, $pi) = @_;

    if (length $pi->{Data}) {
        $self->print("{Target}, " ", $pi->{Data}, ">");
    }
    else {
        $self->print("{Target}, ">");
    }
}

sub comment {
    my ($self, $comment) = @_;
    # strip comments?
}

1;
__END__