#!/usr/bin/perl -w

use strict;

my $PORT      = 8018;
my $BYTE_RATE = 1000;

use HTTP::Daemon;
use LWP::UserAgent;

    # Falls der Browser plötzlich abbricht
$SIG{PIPE} = 'IGNORE';
    # Reaper für terminierte Kindprozesse
$SIG{CHLD} = sub { wait(); };

    # Neuen Dämon erzeugen
my $srv = HTTP::Daemon->new( LocalPort => $PORT, 
                             Reuse     => 1 );

    # Fehler aufgetreten?
die "Can't start server ($@)" unless defined $srv;

    # Erfolgsmeldung
print "Server listening at port $PORT\n";

my $ua = LWP::UserAgent->new();
$ua->agent("slowie/1.0");

while(my $conn = $srv->accept()) {

        # Parallelprozess abfeuern
    defined(my $pid = fork()) or die "Can't fork!";
        # Vater kehrt zurück zum accept()
    next if $pid;

        # Kind bearbeitet Requests der Verbindung
    while (my $request = $conn->get_request) {

        my $resp = $ua->simple_request($request);

        if($resp->is_success()) {
            my $subref = 
                get_slowsub($resp->content());
            $resp->content($subref);
        } 

        $conn->send_response($resp);
    }
    $conn->close;
        # Kind beendet sich
    exit(0);
}

##################################################
sub get_slowsub {
##################################################
    my ($content) = @_;

    my $start      = time() - 1;
    my $followup   = 0;

        # Closure erzeugen
    my $subref = sub {

            # Ende der Übertragung?
        if(0 == length($content)) {
            return undef;
        }

        sleep(1) if $followup++;

            # Maximal verfügbare Bytes
        my $max = (time() - $start) * $BYTE_RATE;

            # Timer zurücksetzen
        $start = time();
                      
            # Bereich aus $content ausschneiden
            # und zurückgeben
        my $chunk = substr($content, 0, $max, "");
        return($chunk);
    };

    return $subref;
}