That is truly amazing. It looks fantastic with highlighting applied. Coloured Obfuscation either looks beautiful or downright horrible :)
I have an exam in about an hour, so rather than study I thought I'd play around with this for a bit. Just shortened your parsing code into a substitution, added support for the numbered pre sections (craft), and fixed up a slight problem with not resetting the formatter.
#!/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 = ( '['=>'[',
']'=>']',
'&'=>'&');
s/([|]|&)/$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 $_;
}