Subject: Fast HTML syntax checking package for CGI scripts
From: [email-masked] (Luke)
Date: 26 Jun 1995 13:50:55 GMT
Newsgroups: comp.lang.perl.announce,comp.lang.perl.misc,comp.lang.perl

Interactive chat/guestbook stuff are in chic now on the web.  But what I've
seen so far are all pathetic IRC emulations.  A prerequisite of a good web
chat/guestbook is allowing users to write directly in HTML.  Problem: what
if user posts unclosed <H1>, <FONT>, and ultimately <BLINK>?  if you just
include them in a dynamic HTML document, the result is unthinkable:).  Most
online chat/guestbook now escapes HTML tags, which diminishes the fun of
hypertext because of the trouble of real time HTML syntax checking.  The
existing HTML syntax checkers are all resource suckers and picky
complainers written by HTML/SGML cops and the likes, not suitable for real
time user input checking.  We really need a small and fast basic HTML
checking package for this purpose.  Here it comes.  The fastest HTML syntax
checking package in Perl.  It's 15-100 times faster than weblint, checking
150 KB HTML text (~1500 tags) in a fraction of a second (on an Alpha of
course;).  If it's not the fastest, prove it with source:) It supports HTML
2.0, HTML 3.0 (draft) and Netscape extensions (1.1).  Adding new support is
trivial.  Please read the attached pod and source for more information.  I
envision a revolutionized interactive web in the near future.  ;)

cheers,

__Luke

Encl. 

=head1 NAME

htmlchk.pl -- a simple and fast HTML syntax checking package for perl 4/5

=head1 SYNOPSIS
    
    require 'htmlchk.pl';

    &htmlchk'OK($html_text) || die "Bad HTML";

    or for perl 5:
    htmlchk::OK($html_text) || die "Bad HTML";

=head1 DESCRIPTION

The objective of the package is to provide a fast and essential HTML check
(esp. for CGI scripts where response time is important) to prevent a piece
of user input HTML code from messing up the rest of a file, i.e., to
minimize and localize any possible damage created by including a piece of
user input HTML text in a dynamic document.

htmlchk.pl checks for unmatched < and >, unmatched tags and improper
nesting, which could ruin the rest of the document.  Attributes and
elements with optional end tags are not checked, as they should not cause
disasters with any decent browsers (they should ignore any unrecognized
tags and attributes according to the standard).  A piece of HTML that
passes htmlchk may not necessarily be valid HTML. But it would be very
unlikely to screw others but itself.

htmlchk.pl currently supports HTML 2.0, 3.0 (draft) and netscape
extensions (1.1).

=head1 EXAMPLE

    htmlchk, a simple html checker:

    #!/usr/local/bin/perl
    require 'htmlchk.pl';

    if ($ARGV[0] eq '-d') { $htmlchk'Debug = 1; shift; }
    undef $/;
    print &htmlchk'OK(<>) ? "HTML OK\n" : "Bad HTML:\n", $htmlchk'Error;

    __END__

    Usage: 
    htmlchk [-d] [html_file]

=head1 AUTHOR

Luke Y. Lu <[email-masked]>

=head1 SEE ALSO

HTML docs at <URL:http://www.w3.org/hypertext/WWW/MarkUp/MarkUp.html>;
HTML validation service at <URL:http://www.halsoft.com/html/>;
perlSGML package at <URL:http://www.oac.uci.edu/indiv/ehood/perlSGML.html>;
weblint at <URL:http://www.khoros.unm.edu/staff/neilb/weblint.html>;
perl(1) of course.

=head1 BUGS

None by my definition. :)

=cut

#!/usr/local/bin/perl
# htmlchk.pl: a simple/fast html syntax checking package for perl 4 and 5
#
# $Id: htmlchk.pl,v 1.9 1995/5/31 09:33:52 ylu Exp ylu $
#
# Copyright 1995, Luke Y.  Lu <[email-masked]>
# may be copied under the terms of either the Perl Artistic License or the
# GNU General Public License.  Comments/suggestions/bugfixes/improvements
# welcome.

package htmlchk;

$Version = '1.0b';

# WARNING: The following (between # start-html-def and # end-html-def) is
# generated by dtd2pl from a html.dtd 3.0 (draft). Edit with caution.

# 5/12/95 ylu added netscape extensions: <font> <center> and <blink>

# start-html-def
# elements that _require_ closing tags.
%Pair = (
               'A',         1,
         'ADDRESS',         1,
               'B',         1,
           'BLINK',         1,  # mozilla 
      'BLOCKQUOTE',         1,
          'CENTER',         1,  # mozilla 
            'CITE',         1,
            'CODE',         1,
             'DFN',         1,
             'DIR',         1,
              'DL',         1,
              'EM',         1,
             'FIG',         1,
            'FONT',         1,  # mozilla 
            'FORM',         1,
              'H1',         1,
              'H2',         1,
              'H3',         1,
              'H4',         1,
              'H5',         1,
              'H6',         1,
            'HEAD',         1,
            'HTML',         1,
               'I',         1,
             'KBD',         1,
         'LISTING',         1,
            'MENU',         1,
              'OL',         1,
             'PRE',         1,
               'S',         1,
            'SAMP',         1,
          'SELECT',         1,
          'STRONG',         1,
           'STYLE',         1,
           'TABLE',         1,
        'TEXTAREA',         1,
           'TITLE',         1,
              'TT',         1,
               'U',         1,
              'UL',         1,
             'VAR',         1,
             'XMP',         1,
);

# Nestable elements
%Nestable = (
      'BLOCKQUOTE',         1,
              'DL',         1,
            'MENU',         1,
              'OL',         1,
           'TABLE',         1,
              'UL',         1,
);

# end-html-def

# htmlchk'OK($html_text);
# a quick check for html essentials.  return 1 for success, 0 for error,
# set $htmlchk'Error. 
 
sub OK
{
    local($_) = @_;
    local($tag, $isendtag, @tags, %tags, $tag1);
    local($*) = 0;
    
    $Error = "";

    unless (&anglematch) {
        $Error = "mismatched < and >\n";
        return 0;
    }

    for $tag (/<\s*([^\s>]+)[^>]*>/g) {
        $tag =~ y/a-z/A-Z/;
        $isendtag = $tag =~ s!^/!!;

        next unless $Pair{$tag};
        if ($isendtag) {
            print "</$tag>\n" if $Debug;   #XXX
            if ($tag1 = pop @tags) {
                $tag1 eq $tag || 
                    $Error .=  "<$tag1> does not match </$tag>\n";
            }
            else {
                $Error .=  "</$tag> appears without matching <$tag>\n";
            }
            $tags{$tag1} -= 1;
        }
        else {
            print "<$tag>\n" if $Debug;   #XXX
            push(@tags, $tag);
            $tags{$tag} += 1;
            $tags{$tag} <=1 || $Nestable{$tag} ||
                $Error .=  "<$tag> cannot be nested\n";
        }
    }

    for $tag (@tags) {
        $Error .= "missing required </$tag> for <$tag>\n";
    }

    return $Error ? 0 : 1;
}

# anglematch($html_text);
# return 1 if < and > matches

sub anglematch
{
    # in perl5 we can use s/<!--.*?-->//g to remove html comments.  Kinda
    # hairy and slow to do in perl4, don't bother.  So it will reject html
    # text with markups within comments -- hey, who types html with
    # comments anyway :).  some browsers also seem to be confused with
    # markups inside a comment.
    
    #eval 's/<!--.*?-->//g' if $] =~ /^5/; # uncomment to slow down if you want
    return 0 if /<[^>]*</;
    return 0 if />[^<]*>/;
    return 0 if /<[^>]*$/;
    return 0 if /^[^<]*>/;
    1;
}

1;

__END__