HTML Formatter

DESCRIPTION

SYNOPSIS

Perl

require( 'html_formatter.pl' );
# load html code
# ...
print "<pre>", html_format( $html_code ), "</pre>\n";

Perl-CGI

<?perl
App::require_pl( 'html_formatter.pl' );
# load html code
# ...
print "<pre>", html_format( $html_code ), "</pre>\n";

# format html with perl-cgi embeded
$BaseLanguage = 'Perl';
print "<pre>", html_format( $html_code ), "</pre>\n";
?>

COPYRIGHT

The library is free software. You may distribute under the terms of either the GNU General Public License or the Artistic License, as specified in the Perl README file.

SOURCE CODE

# *******************
# * file: html_formatter.pl
# * license: GPL or Artistic License
# * copyright: Christian Mueller <chrmue[at]cpan.org>
# ******************************************************

# uncomment for debugging
#use strict;

if( $PerlCGI::VERSION ) {
    App::require_pl( 'css_formatter.pl' );
    App::require_pl( 'perl_formatter.pl' );
}
else {
    require( 'css_formatter.pl' );
    require( 'perl_formatter.pl' );
}

our(
    $FmtHTML, $Formatter, $ReqFormatter, $BaseLanguage, $__want_fmt,
    $HTML_Tags, $HTML_Attributes, $HTML_SpecialChars
);

sub html_format {
    my( $code, $pre ) = @_;
    my( $out, $len, $space, $lf, $tab, $sub, $i, $type, $m, $l, $str );
    $pre = 1 unless defined $pre;
    $out = '';
    $code =~ s/\r//gs;
    $len = length( $code );
    if( $pre ) {
        $space = ' ';
        $lf = "\n";
        $tab = "&nbsp;&nbsp;&nbsp;&nbsp;";
    }
    else {
        $space = '&nbsp;';
        $lf = "<br />\n";
        $tab = "&nbsp;&nbsp;&nbsp;&nbsp;";
    }
    $FmtHTML = 1;
    $sub = $Formatter = 'HTML';
    for( $i = 0; $i < $len; ) {
        while( 1 ) {
            $m = substr( $code, $i, 1 );
            if( $m eq ' ' ) {
                $out .= $space;
            }
            elsif( $m eq "\n" ) {
                $out .= $lf;
            }
            elsif( $m eq "\t" ) {
                $out .= $tab;
            }
            else {
                last;
            }
            $i ++;
        }
        if( $Formatter eq 'HTML' ) {
            $l = html_get_token( $code, $i, $len, $type );
        }
        elsif( $Formatter eq 'CSS' ) {
            $l = css_get_token( $code, $i, $len, $type );
        }
        elsif( $Formatter eq 'Perl' ) {
            $l = perl_get_token( $code, $i, $len, $type );
        }
        $l = 1 if $l <= 0;
        $sub = $Formatter if $sub ne $Formatter;
        $str = substr( $code, $i, $l );
        $str =~ s/\&/&amp;/gs;
        $str =~ s/\</&lt;/gs;
        $str =~ s/\>/&gt;/gs;
        $str =~ s/\t/$tab/gs;
        $out .= '<span class="' . $sub . '_' . $type . '">' . $str . '</span>';
        if( $ReqFormatter ) {
            $Formatter = $ReqFormatter;
            $ReqFormatter = undef;
        }
        $i += $l;
        while( 1 ) {
            $m = substr( $code, $i, 1 );
            if( $m eq ' ' ) {
                $out .= $space;
            }
            elsif( $m eq "\n" ) {
                $out .= $lf;
            }
            elsif( $m eq "\t" ) {
                $out .= $tab;
            }
            else {
                last;
            }
            $i ++;
        }
    }
    undef $FmtHTML;
    return $out;
}

sub html_get_token {
    my( $str, $offset, $len, $type ) = @_;
    my( $i, $ch );
    $str = substr( $str, $offset );
    $i = 0;
    $ch = substr( $str, 0, 1 );
    if( $ch eq '<' ) {
        $ch = substr( $str, 1, 1 );
        if( $ch eq '?' ) {
            if( lc( substr( $str, 2, 4 ) ) eq 'perl' ) {
                $Formatter = 'Perl';
                $_[3] = 'CGI';
                return 6;
            }
            else {
                $Formatter = 'Perl';
                $_[3] = 'CGI';
                return 2;
            }
        }
        elsif( $ch eq '*' ) {
            $Formatter = 'Perl';
            $_[3] = 'CGI';
            return lc( substr( $str, 2, 4 ) ) eq 'perl' ? 6 : 2;
        }
        elsif( $ch eq '!' ) {
            if( substr( $str, 2, 1 ) eq '-' && substr( $str, 3, 1 ) eq '-' ) {
                $i = index( $str, '-->', 4 );
                $_[3] = 'CMT';
                return $i >= 0 ? $i + 3 : $len - $offset;
            }
        }
        elsif( $str =~ m/^\<\w+/ ) {
            $i = $&;
            if( $str =~ m/^\<script\s+language\=[\"\']*(\w+)[\"\']*\s*\>/i ) {
                $ch = lc( $1 );
                if( $ch eq 'perl' ) {
                    $__want_fmt = 2;
                }
            }
            $ch = uc( $i );
            if( index( $HTML_Tags, $ch ) >= 0 ) {
                if( $ch eq '<STYLE' ) {
                    $__want_fmt = 1;
                }
                $_[3] = 'TAG';
            }
            else {
                $_[3] = 'UTAG';
            }
            return length( $ch );
        }
        elsif( $str =~ m/^\<\/\w+?\>/ ) {
            $ch = uc( $& ) . ' ';
            if( index( $HTML_Tags, $ch ) >= 0 ) {
                $_[3] = 'TAG';
                return $+[0];
            }
        }
        $i = index( $str, '>', 1 );
        $_[3] = 'UTAG';
        return $i >= 0 ? $i + 1 : $len - $offset;
    }
    elsif( $ch eq '>' ) {
        if( $__want_fmt ) {
            if( $__want_fmt == 1 ) {
                $ReqFormatter = 'CSS';
            }
            elsif( $__want_fmt == 2 ) {
                $ReqFormatter = 'Perl';
            }
            undef $__want_fmt;
        }
        $_[3] = 'TAG';
        return 1;
    }
    elsif( $ch eq '/' ) {
        if( substr( $str, 1, 1 ) eq '>' ) {
            $_[3] = 'TAG';
            return 2;
        }
    }
    elsif( $ch eq '"' || $ch eq '\'' ) {
        $_[3] = 'TEXT';
        while( 1 ) {
            $i = index( $str, $ch, $i + 1 );
            if( $i < 0 || substr( $str, $i - 1, 1 ) ne '\\' ||
                substr( $str, $i - 2, 1 ) eq '\\'
            ) {
                last;
            }
        }
        return $i >= 0 ? $i + 1 : $len - $offset;
    }
    elsif( $ch eq '&' ) {
        if( $str =~ m/\&\w+?\;/ ) {
            $ch = substr( $&, 0, -1 );
            if( index( $HTML_SpecialChars, $ch ) >= 0 ) {
                $_[3] = 'SPEC';
                return $+[0];
            }
        }
    }
    else {
        if( $str =~ m/^\S+?\=/ ) {
            $ch = uc( $& );
            if( index( $HTML_Attributes, $ch ) >= 0 ) {
                $_[3] = 'ATTR';
                return $+[0];
            }
            $_[3] = 'UATTR';
            return $+[0];
        }
    }
    $_[3] = 'TEXT';
    return 1;
}

$HTML_Tags = q{
<A </A> <ABBR> <ABBR </ABBR> <ABOVE> <ACRONYM> <ACRONYM </ACRONYM> <ADDRESS>
<ADDRESS </ADDRESS>
<APPLET </APPLET> <AREA </AREA <ARRAY>
<B> <B </B> <BASE <BASEFONT <BDO> <BDO </BDO> <BGSOUND <BIG> <BIG </BIG>
<BLINK> <BLINK </BLINK>
<BLOCKQUOTE> <BLOCKQUOTE </BLOCKQUOTE> <BODY> <BODY </BODY> <BOX> <BR/> <BR>
<BR <BUTTON> </BUTTON>
<CAPTION> <CAPTION </CAPTION> <CENTER> <CENTER </CENTER> <CITE> <CITE </CITE>
<CODE> <CODE </CODE>
<COL> <COL <COLGROUP> <COLGROUP </COLGROUP> <COMMENT> </COMMENT>
<DD> <DD </DD> <DEL> <DEL </DEL> <DFN> <DFN </DFN> <DIR> <DIR </DIR> <DIV>
<DIV </DIV> <DL> <DL </DL>
<DT> <DT </DT>
<EM> <EM </EM> <EMBED
<FIELDSET> <FIELDSET </FIELDSET> <FIG> <FONT </FONT> <FORM> <FORM </FORM>
<FRAME <FRAMESET </FRAMESET>
<H1> <H1 </H1> <H2> <H2 </H2> <H3> <H3 </H3> <H4> <H4 </H4> <H5> <H5 </H5>
<H6> <H6 </H6> <HEAD> <HEAD
</HEAD> <HR/> <HR> <HR <HTML> <HTML </HTML>
<I> <I </I> <IFRAME> <IFRAME </IFRAME> <ILAYER> </ILAYER> <IMG <INPUT>
<INPUT <INS> <INS </INS> <ISINDEX> <ISINDEX
<KBD> <KBD </KBD>
<LABEL> <LABEL </LABEL> <LAYER> <LAYER </LAYER> <LEGEND> <LEGEND </LEGEND>
<LI> <LI </LI> <LINK <LISTING>
</LISTING>
<MAP </MAP> <MARQUEE </MARQUEE> <MENU> <MENU </MENU> <META <MULTICOL>
</MULTICOL>
<NEXTID <NOBR> </NOBR> <NOFRAMES> </NOFRAMES> <NOLAYER> </NOLAYER>
<NOSCRIPT> </NOSCRIPT> <NOTE> </NOTE>
<OBJECT> <OBJECT </OBJECT> <OL> <OL </OL> <OPTGROUP> <OPTGROUP </OPTGROUP>
<OPTION> <OPTION </OPTION>
<P> <P </P> <PARAM <PRE> <PRE </PRE>
<Q> <Q </Q> <QUOTE>
<RANGE> <ROOT>
<S> <S </S> <SAMP> <SAMP </SAMP> <SCRIPT> <SCRIPT </SCRIPT> <SELECT>
<SELECT </SELECT> <SMALL> <SMALL
</SMALL> <SOUND <SPACER> <SPAN> <SPAN </SPAN> <SQRT> <STRIKE> <STRIKE
</STRIKE> <STRONG> <STRONG </STRONG>
<STYLE> <STYLE </STYLE> <SUB> <SUB </SUB> <SUP> <SUP </SUP>
<TABLE> <TABLE </TABLE> <TBODY> <TBODY </TBODY> <TD> <TD </TD> <TEXT>
<TEXTAREA> <TEXTAREA </TEXTAREA>
<TFOOT> <TFOOT </TFOOT> <TH> <TH </TH> <THEAD> <THEAD </THEAD> <TITLE>
</TITLE> <TR> <TR </TR> <TT>
<TT </TT>
<U> <U </U> <UL> <UL </UL>
<VAR> <VAR </VAR>
<WBR>
<XMP> </XMP>
// />
>
};

$HTML_Attributes = q{
ABBR= ACCEPT-CHARSET= ACCEPT= ACCESSKEY= ACTION= ALIGN= ALINK= ALT= ARCHIVE=
AXIS=
BACKGROUND= BEHAVIOR BEHAVIOR> BELOW BELOW> BGCOLOR= BORDER=
CELLPADDING= CELLSPACING= CHAR= CHAROFF= CHARSET= CHECKED CHECKED> CITE=
CLASS= CLASSID= CLEAR= CODE=
CODEBASE= CODETYPE= COLOR= COLS= COLSPAN= COMPACT COMPACT> CONTENT= COORDS=
DATA= DATETIME= DECLARE DECLARE> DEFER DEFER> DIR= DISABLED DISABLED>
ENCTYPE=
FACE= FOR= FRAME= FRAMEBORDER= FRAMESPACING=
HEADERS= HEIGHT= HIDDEN= HREF= HREFLANG= HSPACE= HTTP-EQUIV=
ID= ISMAP=
LABEL= LANG= LANGUAGE= LINK= LONGDESC= LOOP=
MAILTO= MARGINHEIGHT= MARGINWIDTH= MAXLENGTH= MEDIA= METHOD= MULTIPLE MULTIPLE>
NAME= NOHREF NOHREF> NORESIZE NORESIZE> NOSHADE NOSHADE> NOWRAP NOWRAP>
OBJECT= ONBLUR= ONCHANGE= ONCLICK= ONDBLCLICK= ONFOCUS= ONKEYDOWN= ONKEYPRESS=
ONKEYUP= ONLOAD=
ONMOUSEDOWN= ONMOUSEMOVE= ONMOUSEOUT= ONMOUSEOVER= ONMOUSEUP= ONRESET=
ONSELECT= ONSUBMIT= ONUNLOAD=
PROFILE= PROMPT=
READONLY READONLY> REL= REV= ROWS= ROWSPAN= RULES=
SCHEME= SCOPE= SCROLLING= SELECTED SELECTED> SHAPE= SIZE= SPAN= SRC= STANDBY=
START= STYLE= SUMMARY=
TABINDEX= TARGET= TEXT= TITLE= TOPMARGIN= TYPE=
URL= USEMAP=
VALIGN= VALUE= VALUETYPE= VERSION= VLINK= VSPACE=
WIDTH=
=
};

$HTML_SpecialChars = q{
&aacute &acirc &acute &aelig &agrave &alefsym &alpha &amp &and &ang &aring
&asymp &atilde &auml
&bdquo &beta &brvbar &bull
&cap &ccedil &cedil &cent &chi &circ &clubs &cong &copy &crarr &cup &curren
&dagger &darr &deg &delta &diams &divide
&eacute &ecirc &egrave &empty &emsp &ensp &epsilon &equiv &eta &eth &euml
&euro &exist
&fnof &forall &frac12 &frac14 &frac34 &frasl
&gamma &ge &gt
&harr &hearts &hellip
&iacute &icirc &iexcl &igrave &image &infin &int &iota &iquest &isin &iuml
&kappa
&lambda &lang &laquo &larr &lceil &ldquo &le &lfloor &lowast &loz &lrm
&lsaquo &lsquo &lt
&macr &mdash &micro &middot &minus &mu
&nabla &nbsp &ndash &ne &ni &not &notin &nsub &ntilde &nu &oacute &ocirc
&oelig &ograve &oline &omega &omicron &oplus &or &ordf &ordm &oslash
&otilde &otimes &ouml
&para &part &permil &perp &phi &pi &piv &plusmn &pound &prime &prod &prop &psi
&quot
&radic &rang &raquo &rarr &rceil &rdquo &real &reg &rfloor &rho &rlm
&rsaquo &rsquo
&sbquo &scaron &sdot &sect &shy &sigma &sigmaf &sim &spades &sub &sube
&sum &sup &sup1 &sup2 &sup3 &supe &szlig
&tau &there4 &theta &thetasym &thinsp &thorn &tilde &times &trade
&uacute &uarr &ucirc &ugrave &uml &upsih &upsilon &uuml
&weierp
&xi
&yacute &yen &yuml
&zeta &zwj &zwnj
};

$HTML_Tags =~ tr/\n/ /;
$HTML_Attributes =~ tr/\n/ /;
$HTML_SpecialChars =~ tr/\n/ /;

1;

STYLESHEET FORMAT

The webpage uses the stylsheet settings below to highlight HTML code.

span.HTML_TAG {
    color: blue;
}
span.HTML_ATTR {
    color: red;
}
span.HTML_CMT {
    color: teal;
}
span.HTML_SPEC {
    color: orange;
}