The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/env perl 
use strict;
use warnings;

use IO::Socket::INET;
use IO::EventMux;
use IO::Buffered::HTTP;
use Compress::Zlib;
use Compress::Bzip2;

# http://www.oreilly.com/openbook/webclient/ch03.html

#add_site(
#    url => 'http://www.google.com',
#    interval => 10 * 60,
#);

my $mux = IO::EventMux->new();

sub http_get {
    my ($host, $port, $document) = @_;
    print "GET $host:$port$document";
    
    my $fh = IO::Socket::INET->new(
        PeerAddr => $host,
        PeerPort => $port,
        Proto    => 'tcp',
        Blocking => 0,
    ) or die;
    $mux->add($fh, Buffered => new IO::Buffered::HTTP(HeaderOnly => 1));

    my $HTTP_HDR = 
        "GET $document HTTP/1.1\r\n".
        "Host: $host\r\n".
        "User-Agent: Mozilla/5.0 Gecko/20080325 Firefox/2.0.0.13\r\n".
        "Accept: text/xml,application/xml,application/xhtml+xml,".
            "text/html;q=0.9,text/plain;q=0.8,image/png,*/*;q=0.5\r\n".
        "Accept-Language: en-us,en;q=0.5\r\n".
        "Accept-Encoding: gzip,deflate\r\n".
        "Accept-Charset: ISO-8859-1,utf-8;q=0.7,*;q=0.7\r\n".
        "Keep-Alive: 300\r\n".
        "Connection: keep-alive\r\n\r\n";
    
    $mux->send($fh, $HTTP_HDR);
}

http_get("www.google.com", "80", "/");

while(1) {
    my $event = $mux->mux(10);
   
    print "$event->{type}\n"; 
    #use Data::Dumper; print Dumper($event);
    
    if($event->{type} eq 'ready') {
    
    } elsif($event->{type} eq 'read') {
        my $headers = parse_header($event->{data});

        if($headers->{status} eq '302') {
            if($headers->{Location} =~ m{
                (?:(http[s]?)://([^/]+))? # Match domain part if it exists
                (.*?) # Match document part if it exists
                (?:\r\n|$)}sx) {
                my ($port, $domain, $document) = ($1, $2, $3);
                
                http_get($domain, "80", $document);
            }

        } elsif ($event->{status} eq '200') {
            my $ce = ($options{'Content-Encoding'} or '');
            my $cl = ($headers{'Content-Length'} or -1);
            
            if ($ce eq "gzip" or $ce eq "x-gzip") {
                my $x = deflateInit()
                   or die "Cannot create a deflation stream\n" ;
                
                # Receive file of size Content-Length with Perl GZIP filter in 4K chunks
                $mux->recvfile("/tmp/httpfile", $event->{fh}, $cl, 4096, sub {
                    my ($output, $status) = $x->deflate($_[0]);
                    $status == Z_OK or die "deflation failed\n";
                    return $output;
                });
                
		    } elsif ($ce eq "x-bzip2") {
                # Receive file by forking a new bzip2 process a pipe data to it in 4K chunks
                #$mux->recvfile("/tmp/httpfile", $event->{fh}, $cl, 4096, 
                #    qw(bzip2 -d));
            
            } else {
                # Receive file directly to file
                $mux->recvfile("/tmp/httpfile", $event->{fh}, $cl);
            }

            # Receive as normal read events in chunks of 4K
            #$mux->recvevent('read', $event->{fh}, $cl, 4096);
        
        } else {
            print "Unknown status code $headers{status}\n";
        }
    }

}