http://qs321.pair.com?node_id=109952
Category: HTML Utility
Author/Contact Info Briac 'OeufMayo' Pilpré
Description:

This is a small script that turns a valid XML file into a colorful HTML file! Yay!

Some handlers have not been used (most notably entities, notations), but they should be, eventually.

Update Tue Sep 4 07:46:13 UTC 2001: added mirod's suggestion. Thanks mirod!

 
#!/usr/bin/perl -w
use strict;
use XML::Parser;

my $parser = new XML::Parser(
    Handlers => {
        Init       => \&init,
        Start      => \&start,
        End        => \&end,
        Char       => \&char,
        Final      => \&final,
        Proc       => \&proc,
        Comment    => \&comment,
        CdataStart => \&cdstart,
        CdataEnd   => \&cdend,
        XMLDecl    => \&xmldecl,
        Doctype    => \&doctype,
    }
);

my $cdata;
my $style = <<'_CSS_';
.element {
    font-weight: bold;
    color: red;
}

.attrname {
    font-weight: bold;
    font-style: italic;
    color: green;
}

.attrvalue {
    font-style: italic;
    color: green;
}

.comment {
    color: blue;
}

.proc {
    color: green;
    font-weight: bold;
}

.cdata {
    color: violet;
}

.doctype {
    font-weight: bold;
    color: brown;
}


.xmldecl {
    font-weight: bold;
}

_CSS_

if( $ARGV[0]) { $parser->parsefile( $ARGV[0]); }
else          { $parser->parse( \*STDIN);      }

sub init  { print qq'<html><head><title></title><style type="text/css"
+>$style'
                  . '</style></head><body>' }
sub final { print '</body></html>' }

sub xmldecl {
    my ($p, $v, $e, $s) = @_;
    print qq'<p><span class="xmldecl">&lt;?xml version="$v" encoding="
+$e" '
        . qq'standalone="' .( $s ?  'yes' : 'no') . '"?&gt;</span></p>
+';
}

sub start {
    my ( $p, $e, %a ) = @_;
    print("<ul>");
    print(qq'&lt;<span class="element">$e</span>');
    foreach ( sort keys %a ) {
        print qq' <span class="attrname">$_=</span>'
            . qq'<span class="attrvalue">"$a{$_}"</span>';
    }
    print '&gt;';
}

sub end {
    my ( $p, $e ) = @_;
    print qq'&lt;/<span class="element">$e</span>&gt;';
    print '</ul>';
}

sub char {
    my ( $p, $s ) = @_;
    $s =~ s/\s+/ /g;

    if ($cdata){
        $s =~ s/&/&amp;/gs;
        $s =~ s/</&lt;/gs;
        $s =~ s/>/&gt;/gs;
        $s =~ s/"/&quot;/gs;
    }    
    print "$s";
}

sub proc {
    my ( $e, $t, $d ) = @_;
    print '<ul>';
    print qq'&lt;<span class="proc">?$t</b> $d<b>?</b>&gt;';
    print "</span></ul>";
}

sub comment {
    my ( $e, $d ) = @_;
    print '<ul><span class="comment">';
    print "&lt!-- $d --&gt;";
    print '</span></ul>';
}

sub cdstart { print '<ul>&lt;![CDATA[<span class="cdata">'; $cdata++ }
sub cdend   { print '</span>]]&gt;</ul>'; $cdata-- }

sub doctype {
    my ( $e, $n, $s, $p, $i ) = @_;
    print qq'<span class="doctype">';
    print qq'&lt;!DOCTYPE $n PUBLIC "$p" $i "$s" &gt;';
    print qq'</span>';

}

Back to Code Catacombs