CUFP
nashdj
<H4>Update:</H4>
<p>
See [Arguile]'s post below ([id://84019]) for a much more up to date/feature packed version. Or see a <a href="http://nashdj.perlmonk.org/images/pmproxy.png">screenshot</a> (1/6/2001).
<hr>
<p>
You may or may not have seen this before - [pmproxy], but its back and I think it's really getting somewhere :) Before I get into the details, go take a look at what I was able to achieve - <a href="http://t-o.hypermart.net/nashdj/pmproxy2.png">pmproxy2.png</a>.
<p>
This new version basically adds cookie and post support. In my haste I wasnt able to find a way to correctly save the cookies to the file. If anyone can help me with that I would be most greatfull.
<p>
It does still lack any form of error control, I guess I'll add to that as I come across things. But so far I havent had too many problems.
<p>
I used <a href="http://t-o.hypermart.net/nashdj/style.css">this stylesheet</a> to achieve whats displayed in the above screenshot.
<p>
As you can see at the bottom of the code I have added a simple sub in which to define some substitutions and other operations to be applied to the page. This is just to clean a few things up which I couldnt override in the css.
<p>
If you want to give it a go, grab the below code, save it to something like pmproxy2.pl. Get a stylesheet, try the one linked above (place that in the same directory). Then exec the script and connect to http://localhost:99/index.pl
<p>
Let me know what you think, or if I've done something strikingly bad with the code!
<p>
- nashdj
<READMORE>
<p>
<code>
use strict;
use LWP::Simple;
use HTTP::Daemon;
use HTTP::Status;
use HTTP::Cookies;
use LWP::UserAgent;
open(CSS,"style.css") || die "CSS Error: $!";
my $css = join("",<CSS>);
close(CSS);
my $ua = new LWP::UserAgent;
my $co = HTTP::Cookies->new();
$ua->cookie_jar($co);
my $d=HTTP::Daemon->new(LocalAddr=>'localhost',
LocalPort=>'99',
Reuse => '1') || die "Cant Spawn: $!";
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/#EEEEEE/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/<font size=2/<font style="text"/gi;
s/www\.perlmonks\.org/localhost:99/gi;
#################################
$_;
}
</code>