Beefy Boxes and Bandwidth Generously Provided by pair Networks
more useful options
 
PerlMonks  

Re: Re: pmproxy2

by nashdj (Friar)
on May 30, 2001 at 06:14 UTC ( #84145=note: print w/ replies, xml ) Need Help??


in reply to pmproxy2.0.1?
in thread pmproxy2

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 = ( '&#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 $_; }


Comment on Re: Re: pmproxy2
Download Code

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://84145]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others wandering the Monastery: (5)
As of 2015-07-30 11:33 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (271 votes), past polls