Beefy Boxes and Bandwidth Generously Provided by pair Networks
go ahead... be a heretic
 
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 taking refuge in the Monastery: (18)
As of 2014-07-23 20:24 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My favorite superfluous repetitious redundant duplicative phrase is:









    Results (152 votes), past polls