Beefy Boxes and Bandwidth Generously Provided by pair Networks
Keep It Simple, Stupid

comment on

( #3333=superdoc: print w/replies, xml ) Need Help??

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

In reply to pmproxy2.0.1? by Arguile
in thread pmproxy2 by nashdj

Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":

  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?

    What's my password?
    Create A New User
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others about the Monastery: (3)
    As of 2020-09-24 01:11 GMT
    Find Nodes?
      Voting Booth?
      If at first I donít succeed, I Ö

      Results (132 votes). Check out past polls.