#!/usr/bin/perl

use strict;
use CGI;
use CGI::Carp qw(fatalsToBrowser);
use Cache::File;
use Data::Dumper;
use LWP::UserAgent;

my $cache_location = "/home/somewhere/writeable/by/httpd/";

my @mirrors = (
    # NOTE: I'd use more than one here, but have found that
    # causes problems
    "http://yourfavorite/mirror/",
);
my $mirror = $mirrors[ rand @mirrors ];

my $cgi   = new CGI;
my $pinfo = $ENV{PATH_INFO};
   $pinfo =~ s/^\///;
my $CK    = "PPC:$pinfo";
my $again = 0;

THE_TOP: # we regen the cache each time just in case things aren't flushed correctly...
         # probably don't need to though

my $cache = Cache::File->new(cache_root=>$cache_location, default_expires => '2 day' );
if( $cache->exists($CK) and $cache->exists("$CK.hdr") ) { our $VAR1;
    my $res = eval $cache->get( "$CK.hdr" ); die "problem finding cache entry\n" if $@;

    my $status = $res->status_line;

    print $cgi->header(-status=>$status, -type=>$res->header( 'content-type' ));

    my $fh  = $cache->handle( $CK, "<" ) or die "problem finding cache entry\n";

    if( $res->is_success ) {
        my $buf;
        while( read $fh, $buf, 4096 ) {
            print $buf;
        }

    } else {
        print $status;
    }

    close $fh;

    unless( $res->is_success ) {
        $cache->remove($CK);
    }

    exit 0;

} elsif( not $again ) {
    $again = 1;

    my $ua = new LWP::UserAgent;
       $ua->agent("PPC/0.1 (paul's proxy cache perlmonks-id=16186)");

    $cache->set($CK, 1); # doesn't seem like we should ahve to do this, but apparently we do

    my $fh = $cache->handle( $CK, ">" );
    my $request  = HTTP::Request->new(GET => "$mirror/$pinfo");
    my $response = $ua->request($request, sub { my $chunk = shift; print $fh $chunk });
    close $fh;

    $cache->set("$CK.hdr", Dumper($response));

    goto THE_TOP;
}

die "problem fetching $pinfo. :(\n";