Notes

There's quite a bit of functionality to that formatter, I haven't played around with line numbering yet but that is an option for those interested. Speedwise it's definitely not something you'd want to use in a realtime system (ie. editor) but I find the added perlmonk processing time to be acceptable. YMMV

The Code

Most of the proxy code is the same as the main program by nashdj, major changes are the additions of the subroutines for initialising the formatter and acutally formatting the text (which were wastly inproved by the afformentioned)..

#!/usr/bin/perl -w

######################
#
# PerlMonks' Proxy w/ Syntax Highlighting
# v2.0.1
#
# May 30, 2001
#
# Ever wanted to view perlmonks.org w/ your own formatting? Ever wante
+d to
# view all those code snippets in all the colours and fonts you use in
+ your
# editor? Ever wanted that incredible looking girl who sits near you i
+n Chem
# class to c... err.. Well the first two you can have!
#
#
# Change Log:
#
# v2.0.1 - May 30 2001 [arguile]
#           Added syntax highlighting to code segments
#           Added permanent cookie support (saves as .pmcookie)
#
# v2.0.0 - Apr 02 2001 [nashdj]
#            Cookie support added (doesn't store perm)
#            POST support added
#            Still no Error Control
#          See http://localhost:99/index.pl?node=pmproxy2 for details
#
# v1.0.0 - Dec 04 2000 [nashdj]
#            Createded, allows CSS replacement for viewing Perl Monks
#            No Error Control
#            No Cookie Support
#            No POST Support
#          See http://localhost:99/index.pl?node=pmproxy for details
#
######################


use strict;
use LWP::Simple;
use HTTP::Daemon;
use HTTP::Status;
use HTTP::Cookies;
use LWP::UserAgent;
use Syntax::Highlight::Perl;

# Address and port to run daemon on.

my ($addr, $port) = qw(localhost 99);

# Create a new user agent for fetches.

my $usr_agent = new LWP::UserAgent;

# Create a cookie jar and assign it for the user agents use. This stor
+es
# the perlmonk user login. For win32 systems that don't define HOME th
+e
# cookie is stored in the calling proccess dir. Very much meant for
# single user calling. :)

$ENV{HOME} = '.' if not defined $ENV{HOME};

my $cookie_jar = HTTP::Cookies->new(
    file => "$ENV{HOME}/.pmcookie",
    autosave => 1
);

$cookie_jar->load() || warn "The Cookie monster has eaten your cache.\
+n";
$usr_agent->cookie_jar($cookie_jar);

# Start the HTTP Daemon with specified bindings.

my $daemon = HTTP::Daemon->new(
    LocalAddr => $addr,
    LocalPort => $port,
    Reuse => '1'
) || die "Cant Spawn: $!";

# Create and init formatter.

my $formatter = new Syntax::Highlight::Perl;
&initFormatter();

# Grab the Cascading Style Sheet.

open(CSS,"style.css") || die "CSS Error: $!";
my $css = join("",<CSS>);
close(CSS);


# Main daemon process.

while(1)
{
    my $connection = $daemon->accept;
    my $r = $connection->get_request();
    my $url = $r->uri->as_string;
    my $content;

    if ($url !~ /style.css$/i) {
        print $url."\n\n";
        $url = 'http://localhost:99'.$url;
        my $req;

        if ($r->method eq 'GET') {
            $req = new HTTP::Request GET => $url;
        }
        else {
            $req = new HTTP::Request POST => $url;
            $req->content_type($r->content_type);
            $req->content($r->content);
        }
    
        my $result = $usr_agent->request($req);
        $content = $result->content;
        $content = &doSubs($content);
        $cookie_jar->save();
    }
    else {
        $content = $css;
    }

    my $response = HTTP::Response->new();
    $response->content($content);

    $connection->send_response($response);
    $connection->close;
}


sub doSubs
{
    # Given a perlmonks page; instert stylesheet, syntax highligh code
+,
    # and apply cosmetic changes.
    
    $_ = shift;
    
    # Redirect to proxy addr/port. I set up a DNS entry for the local 
+net
    # to do this invisibly. Much nicer if that's an option for you.
    
    s|www\.perlmonks\.org|$addr:$port|gi;
    
    # Insert stylesheet.
    
    s|<body|<link rel=stylesheet type="text/css" href="/style.css">\n<
+body|i;

    # Syntax highlight string between "code" tags (call subroutine).
    
    s|<PRE>(?:<TT>)?<FONT.*?>(.*?)</FONT>(?:</TT>)?</PRE>|'<PRE class=
+"code">'.&syntaxHighlight($1).'</PRE>'|geis;
    
    # Custom cosmetic changes (feel free to insert/update here).
    
    s|#?silver|silver|gi;
    s|||gi;
    s|("checkbox")|$1 class="noborder"|gi;
    s|(INPUT type=radio class="noborder")|$1 class="noborder"|gi;
    s|("radio")|$1 class="noborder"|gi;
    s|<font size=2|<font style="text"|gi;
    s|(<TEXTAREA.*?cols=)\d+|$1 120|gi;

    return $_;
}


sub syntaxHighlight
{
    # Given some text and a hash of special replacemendts, highlight t
+he Perl code
        
    my $text = pop;

    # Replace html special characters and any stray monestary tags. Th
+e formatter obj
    # will automatically throw html chars back in after format.
    
    my %reps = (
        '&amp;' => '&',
        '&lt;' => '<',
        '&gt;' => '>',
        '&#91;' => '[',
        '&#93;' => ']',
        '<FONT color="red">(?:.*?)</FONT>' => '+'
    );
    $text =~ s/$_/$reps{$_}/gis for keys %reps;
    
    # Format the string.
        
    $text = $formatter->format_string($text);

    # If the prev. code block ends in an unclosed string, POD, _DATA_,
+ or other
    # structure, the formatter carries over and will start as _still i
+n that block_.
    # So make sure to reset() the objects condition.

    $formatter->reset();
        
    return $text;
}


sub initFormatter
{
    # Initialise the formatter object
    
    # Run in stable mode. Stability means that the prev. state persist
+s such as in
    # HTML tags.

    $formatter->unstable(0);
    
    # Substitutions keys get replaced by values _before_ formatting bu
+t _after_ being
    # interpretted for meaning (so we still have to replace beforehand
+ manually).

    my %sub_html = (
        '&' => '&amp;',
        '<' => '&lt;',
        '>' => '&gt;'
    );
    $formatter->define_substitution(\%sub_html);
    
    # Using a list of all FORMAT elements supported by the object (I w
+ish it had a method
    # to return this), create the start/end tags to use for the output
+. The format names
    # become the CSS class names.    

    my @formats = qw(
        Comment_Normal     Comment_POD          Directive
        Label              Quote                String
        Subroutine         Variable_Scalar      Variable_Array
        Variable_Hash      Variable_Typeglob    Character
        Keyword            Builtin_Function     Builtin_Operator
        Operator           Bareword             Package
        Number             Symbol               CodeTerm
        DATA
    );

    # NS4.x doesn't like underscores in CSS class names, but I couldn'
+t get the s/_//
    # working properly (it kept renaming $formats($_) too). Not too wo
+rried as I use
    # a browser that supports it ;) Anyone who wants it please post an
+ update.
    
    my %formats; $formats{$_} = ['<font class="'.$_.'">', '</font>'] f
+or @formats;
    $formatter->set_format(%formats);
}
[download]

CSS Classes for Code

The following are syntactic elements the Syntax::Highlight::Perl offers rendered down into CSS classes. The entire overall code block (default font colour, background, etc.) is controlled by the "code" class.

Comment_Normal CommentPOD Directive Label Quote String Subroutine Variable_Scalar Variable_Array Variable_Hash Variable_Typeglob Char

Keyword Builtin_Function Builtin_Operator Operator Bareword Package Number Symbol Codeterm DATA Line

Sample Stylesheet

/* Inline code */
.Comment_Normal, .Comment_POD, .Directive { color: DarkGreen; font-sty
+le: italic;}
.Directive { font-style: normal; }

.Keyword, .Builtin_Function, .Builtin_Operator { color: #101030; }
.Package { color: Indigo; font-weight: bold;}
.Subroutine { color: DarkSlateGray; font-weight: bold; }

.Bareword, .Codeterm { color: Black; }
.Operator, .Symbol { color: Black; }

.Variable_Scalar, .Variable_Array, .Variable_Hash, .Variable_Typeglob,
+  { color: Navy; }
.Quote, .String { color: Teal; }
.Char { color: DimGray; }
.Number { color: Crimson; }

.Label { color: Black; font-weight: bold; }
.DATA { color: Navy; }
[download]