Category: Utility Scripts
Author/Contact Info Brent Dax
Description: Okay, this one is pretty scary. This script reads in a (simple) chunk of Perl code (using normal filter behavior) and spits out an HTML file with certain things colorized. (You can see the list in the setup of the %config hash at the top.) It's extremely regexp-heavy. It's also pretty easy to confuse.

Notable bugs:
1. In a line like m#regexp#;  #comment, the comment won't be colorized. Sorry.
2. In a line like m{foo{1,2}bar}, the program will get confused and stop highlighting after the 2. I've really got to work on nesting...

For all that, however, there's a lot of cool things it /can/ do, like:
-recognizing and colorizing (most) heredocs
-colorizing statements like @{&{$foo{bar}}} nicely to show which curlies belong to which sigil
-actually working most of the time

Only the colors for sigils are well-thought-out--the rest were just temporary values I assigned on a whim.

Also note that this was a lot of monkeys and typewriters--I myself aren't quite sure how it all works correctly. Well, have fun with this chunk of code!

#!/usr/bin/perl -w

use strict;

our($text, %config, %complements);

    '$'    => '993333',
    '@'    => 'CC6633',
    '%'    => '660000',
    '&'    => '990033',
    '*'    => '990000',

    "'"    => '6699FF',
    '"'     => '3366CC',
    '`'     => '333399',
    'qw'     => '0000FF',

    'm'    => '000088',
    's'     => '0000CC',
    'y'     => '0000FF',
    'tr'    => '0000FF',

    '()'    => '880000',
    '[]'    => 'CC0000',
    '{}'    => 'FF0000',
    '<<'    => '00CC00',
    '#'    => '339999',

    '{' => '}',
    '(' => ')',
    '[' => ']',
    '<' => '>'

for(32..127) {
    $complements{chr($_)}=chr($_) unless exists $complements{chr($_)};



print <<"END";
<HTML><font face="Courier New">

sub fixit($) {
    local $_=shift;
    if(/qq/)    { '"' }
    elsif(/qx/) { '`' }
    elsif(/qw/) { 'qw'}
    elsif(/q/)  { "'" }
    else { die "$0: $_ is not a valid quoter\n" }

sub fix_it_up($) {
    local $_=shift;
    s/  /&nbsp; /g;
    #since I'm using null as an escape character, I have to get rid of
+ the ones that are left
    return $_;

sub highlight_quotes($) {
    local $_=shift;

    #heredocs: MUST BE DONE before '' and "" highlighting
    s|<<(['"]?)(.*)\1([^\n]*?)\n(.*?)\n\2\n|<<$1$2$1$3\n\0<font color=

    #normal quoted strings
    s|(?<!\0)(['"`])(.*?)(?<!\\)\1|$1\0<font color=\0"\0#$config{color

    # qX
+s{$2})})|qq($1$2\0<font color=\0"\0#).$config{colors}{fixit($1)}.qq(\

    return $_;

sub highlight_various($) {
    local $_=shift;

    #highlight subscripting and function args
+ont color=\0"\0#$config{colors}{$1.$complements{$1}}\0"\0>$2\0</font\

    #highlight comments--unless the sharp appears to be the delimiter 
+of a q, qq, qw, qx, tr, y, m, or s
    s|^([^#]+)(?<![qwxmsry\0])#(.*)$|$1\0<font color=\0"\0#$config{col
    s|^#(.*)$|\0<font color=\0"\0#$config{colors}{'#'}\0"\0>\0#$1\0</f

    return $_;

sub highlight_sigils($) {
    local $_=shift;

    #wrapped in {}
    1 while s|(?<!\0)([\$\@\%\&\*])(?<!\0)\{(.*?)(?<!\0)\}|\0<font col

    s[(?<!\0)([\$\@\%\&\*])((?:[\w:]|\0(?:\{|\}|\[|\]))*)][\0<font col

    return $_;

sub highlight_regexes($) {
    local $_=shift;

    #m//, m{}
     {m$1\0<font color=\0"\0#$config{colors}{m}\0"\0>$2\0</font\0>$com

    #s///, tr///
     {$1$2\0<font color=\0"\0#$config{colors}{$1}\0"\0>$3\0</font\0>$2
+\0<font color=\0"\0#$config{colors}{'"'}\0"\0>$4\0</font\0>$2}gs;

    #s{}{}, tr{}{}
+$5})})}{$1$2\0<font color=\0"\0#$config{colors}{$1}\0"\0>$3\0</font\0
+>$complements{$2}$4$5\0<font color=\0"\0#$config{colors}{'"'}\0"\0>$6

    return $_;