So, I've got some web space that is not enough to hold my picture collection. As such, I'd like to have it become a cacheing proxy for my pictures which are housed at my home over a relatively slow dsl line. I've got some code that works, but if the file is too big, it causes a web timeout while it's going from my computer to the cache (roughly files that are over 1MB in size). I tried to make my system work with threading so that it could send the data as it was received, but I couldn't get that part to work. My code is below: 
#!/usr/bin/perl
#!/usr/bin/perl -I/kunden/homepages/23/d94990689/htdocs/perl

$version = 0.1;

use CGI;
use CGI::Carp qw(fatalsToBrowser);
use Cache::SizeAwareFileCache;
use LWP::UserAgent;
use threads;
use Thread::Semaphore;
use Thread::Queue;

$cachesize = 1000000;
$cachedir  = '/usr/lib/cgi-bin/cache/';
@goodhosts = ('denney.homeip.net');

my $q = CGI->new;
my %parm = $q->Vars;

$req = HTTP::Request->new(HEAD => $parm{'url'});

unless (grep {$_ eq $req->uri->host()} @goodhosts) {
    print $q->header(-status => 406).
        $q->h1("Invalid Host Name").
            $q->p("You requested an invalid host");
    exit;
}

my $ua = LWP::UserAgent->new;
$ua->agent("Bill's CGICache $version");

$res = $ua->request($req);

# check the current file to see if we need to get a new version of it
if ($res->is_error()) {
    print $r->error_as_HTML();
    die;
}
else {
    # setup the cache
    my $cache = new
      Cache::SizeAwareFileCache({'namespace' => 'gallerycache',
                                 'default_expires_in' => 'never',
                                 'cache_root' => $cachedir});

    #grab the cache object based on URL
    my $file = $cache->get($res->base);

    my $hit = 1;
    if (! defined $file) {
        $reqget = HTTP::Request->new(GET => $parm{'url'});
        $queue = Thread::Queue->new;

        print $res->headers->as_string."\n";
        $thr = threads->new(\&writer, $queue);
        #$queue->enqueue($res->headers->as_string."\n");
        $resget = $ua->request($reqget, {$queue->enqueue(@_)});
        $queue->enqueue(undef);
        $thr->join;

        if ($res->is_error()) {
            print $r->error_as_HTML();
            exit;
        }

        $file = $resget; # get the file from your server
        $cache->set($res->base, $resget, $resget->freshness_lifetime);

        $hit = 0;
        $file->push_header(Bill_cache => 'Miss');
    }
    $file->init_header(Bill_cache => 'Hit');

    if ($hit) {
        print $file->headers->as_string."\n". $file->content;

    }

    # clean up the cache if we wrote to it.
    unless($hit) {
        limit_size($cachesize);
    }
}

sub writer {
    my($queue) = @_;

    while(my $mesg = $queue->dequeue) {
        print "test\n";
        print $mesg;
    }
}

[download]

In reply to Creating a CGI Caching Proxy by wsloand

Title:
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, details, 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, summary, 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.