# 2nd demo of progressive script execution.
# Author: Kyle Scholz (http://www.kylescholz.com)
use HTTP::Daemon;
use HTTP::Status;
use strict;
my $CRLF = "\015\012";
$|=1; # Autoflush buffers
start_server(10000);
# Send a complete response
sub send_response {
my ($conn) = @_;
my $i = 0;
my $total = 0;
# Send Headers
my $response = HTTP::Response->new(200);
$response->header("Transfer-Encoding" => "chunked");
$conn->send_response($response);
# Start HTML Doc
my $content = "";
printf $conn "%x$CRLF%s$CRLF", length($content), $content;
$total += length($content); # Reported total length is at last chunk
# Send chunks at interval
while($i<50) {
my @contents = [];
my $chunk_size = 0;
# Determine next five interval outputs to get chunk size
for (my $j = 0; $j < 5; $j++) {
my $content = sprintf "", $i++, $total;
push @contents, $content;
$total += length($content);
$chunk_size += length($content);
}
# Output chunk
printf $conn "%x$CRLF", $chunk_size;
for (my $j = 1; $j < 6; $j++) {
my $content = $contents[$j];
printf $conn $content;
sleep(1);
}
printf $conn $CRLF;
}
# Finish Doc and terminate chunks
my $content = "";
printf $conn "%x$CRLF%s$CRLF", length($content), $content;
}
# Start the server
sub start_server {
my ($port) = @_;
my $daemon = HTTP::Daemon->new(LocalPort => $port) || die;
print "URL: ", $daemon->url, "\n";
while (my $conn = $daemon->accept) {
while (my $request = $conn->get_request) {
if ($request->method eq 'GET' and $request->url->path eq "/") {
send_response($conn);
} else {
$conn->send_error(RC_FORBIDDEN)
}
}
$conn->close;
undef($conn);
}
}