#!/usr/bin/perl -w

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

# read in Cascading Style Sheet
open(CSS,"style2.css") || die "CSS Error: $!";
my $css = join("",<CSS>);
close(CSS);

# port to run daemon on
my $port = 99;

# create instances of of agents
my $ua = new LWP::UserAgent;
my $co = HTTP::Cookies->new();
$ua->cookie_jar($co);
my $d=HTTP::Daemon->new(LocalAddr=>'nashdj',
                        LocalPort=>$port,
                        Reuse => '1') || die "Cant Spawn: $!";

# init syntax formatter
my $formatter = new Syntax::Highlight::Perl;
my ($pre,$post) = ('<font class="', '">');
my $end = '</font>';
$formatter->set_format(
    'Comment_Normal'   => [$pre . 'commentNormal' . $post       ,$end]
+,
    'Comment_POD'      => [$pre . 'commentPOD' . $post          ,$end]
+,
    'Directive'        => [$pre . 'directive' . $post           ,$end]
+,
    'Label'            => [$pre . 'label' . $post               ,$end]
+,
    'Quote'            => [$pre . 'quote' . $post               ,$end]
+,
    'String'           => [$pre . 'string' . $post              ,$end]
+,
    'Subroutine'       => [$pre . 'sub' . $post                 ,$end]
+,
    'Variable_Scalar'  => [$pre . 'scalar' . $post              ,$end]
+,
    'Variable_Array'   => [$pre . 'array' . $post               ,$end]
+,
    'Variable_Hash'    => [$pre . 'hash' . $post                ,$end]
+,
    'Variable_Typeglob'=> [$pre . 'glob' . $post                ,$end]
+,
    'Whitespace'       => [''                                   ,''  ]
+,
    'Character'        => [$pre . 'char' . $post                ,$end]
+,
    'Keyword'          => [$pre . 'keyword' . $post             ,$end]
+,
    'Builtin_Function' => [$pre . 'builtinFunction' . $post     ,$end]
+,
    'Builtin_Operator' => [$pre . 'builtinOperator' . $post     ,$end]
+,
    'Operator'         => [$pre . 'operator' . $post            ,$end]
+,
    'Bareword'         => [$pre . 'bareword' . $post            ,$end]
+,
    'Package'          => [$pre . 'package' . $post             ,$end]
+,
    'Number'           => [$pre . 'number' . $post              ,$end]
+,
    'Symbol'           => [$pre . 'symbol' . $post              ,$end]
+,
    'CodeTerm'         => [$pre . 'codeterm' . $post            ,$end]
+,
    'DATA'             => [$pre . 'DATA' . $post                ,$end]
+,

    'Line'             => [$pre . 'line' . $post                ,$end]
+,
    'File_Name'        => [$pre . 'filename' . $post            ,$end]
);


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

    if ($url !~ /style.css$/i) {
        $url = "http://www.perlmonks.org$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 $res = $ua->request($req);
        $content = $res->content;
        $content = &dosubs($content);
    }
    else {
        $content = $css;
    }

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

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

sub dosubs
{
    $_ = shift;
    s|<body|<link rel=stylesheet type="text/css" href="/style.css">\n<
+body|i;
    
    #--- Define Substitutions Here ---#
    s|#FFFFFF|silver|gi;
    s|border=1||gi;
    s|("checkbox")|$1 class="noborder"|gi;
    s|(INPUT type=radio)|$1 class="noborder"|gi;
    s|("radio")|$1 class="noborder"|gi;
    s|www\.perlmonks\.org|localhost:$port|gi;
    s\<PRE>(<TT><FONT.*?>|<font size=2>)(.*?)</FONT>(</TT>|)</PRE>\'<p
+re class="code">'.&syntax_highlight($2).'</pre>'\geis;
    #---------------------------------#
    return $_;
}

sub syntax_highlight
{
    $_ = shift;

    my %reps = ( '&#91;'=>'[',
                 '&#93;'=>']',
                 '&amp;'=>'&');

    s/(&#91;|&#93;|&amp;)/$reps{lc($1)}/gei;# any stray monastary synt
+ax
    s|\n<FONT color="red">\+</FONT>||gi;    # bye carry over line tag

    $_ = $formatter->format_string($_);
    $formatter->reset(); #dont carry state across multiple code secion
+s
    s|<font class="sub">(&\w+)</font><font class="symbol">;</font>|<fo
+nt class="operator">$1;</font>|gi;
    return $_;
}
[download]