in reply to pmproxy2

Well, now I don't have to bug vroom about allowing custom themes. ;)

I'm sort of new to this whole Perl game, so I love syntax highlighting. A CPAN search and came up w/ Syntax::Highlight::Perl so I tried it out and thought it would be very cool to view code on Perl Monk's w/ syntax highlighting in your own custom colours. So I wrote the following quick hack to nashdj's very cool proxy idea.


Quite a few changes to the overall code, broke some sections up and it's much nicer now. I slapped my head when I saw your regex solution nashdj, I didn't realise you could eval inside one. I caught the $formatter->reset() too but forgot to add it to the code on here initially. I also added perm cookie support so the proxy stores user info between sessions. I'd love to hear what you think of this updated hack of your code ;).


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 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/ 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/ 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); }

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; }

Replies are listed 'Best First'.
Re: Re: pmproxy2
by nashdj (Friar) on May 30, 2001 at 06:14 UTC
    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.