anyevent-http-client.pl

#!/usr/bin/perl -w
use common::sense;

# anyevent uses any earlier preloaded event library
# if it can't find any then it uses it's own pure-perl code
use EV;
use AnyEvent;
use AnyEvent::Handle;
use AnyEvent::Socket;

use Carp;
use Getopt::Long;

my $IN_PROCESS = 0;
my $fetched = 0;
my $last_req_length = 0;

my %hdr = ('User-Agent' => 'Mozilla/5.0 (compatible; U; AnyEvent example)');
my %opt;

GetOptions (
    'url|u=s'    => \$opt{url},
    'port|p'     => \$opt{port},
    'after|a'    => \$opt{after},
    'interval|i' => \$opt{interval},
    'http-timeout|t' => \$opt{timeout},
);

carp "Url is required\n" if ! $opt{url};

# request failed
my $req_failed = sub {
    my ($hdl, $reason) = @_;

    $IN_PROCESS = 0;
    $hdl->destroy;
        
    print "Request failed: $reason\n";
};

# request succeded 
my $req_success = sub {
    my ($body) = @_;

    $fetched++;
    print "Request succeded\n";
    
    if (length $body > $last_req_length) {
        $last_req_length = length $body;
        print "Body changed ($last_req_length)\n";
    }
};

my $w = AnyEvent->timer(after => $opt{after} || 0, interval => $opt{interval} || 5, cb => sub {
     # we don't want to create more
     # than one http request at a time
    return if $IN_PROCESS++;

    tcp_connect $opt{url}, ($opt{port} || 80), sub {
        my ($fh) = @_;

        # if you want to access $hdl inside any
        # of the construction closures, then
        # you need to predefine it first, here
        # it's not the case, but it's a nifty
        # technique to remember
        my $hdl; $hdl = AnyEvent::Handle->new(
            fh         => $fh,
            timeout    => $opt{timeout} || 5,
            on_timeout => sub { $req_failed->($_[0], "timeout") },
            on_error   => sub { $req_failed->($_[0], $_[2]) },
            on_eof     => sub { $req_failed->($_[0], "server unexpectedly closed the connection") }
        );

        # push http request data
        $hdl->push_write(
            ($opt{method} || 'GET') . " / HTTP/1.0\015\012" .
            (join "", map "\u$_: $hdr{$_}\015\012", grep defined $hdr{$_}, keys %hdr) .
            "\015\012"
        );
    
        # http response
        # start with asking for http response code
        $hdl->push_read(line => qr/\015?\012/, sub {
            my ($handle, $line, $eol) = @_;
            $line =~ /^HTTP\/([0-9\.]+) \s+ ([0-9]{3}) (?: \s+ ([^\015\012]*) )?/ix
                or $req_failed->($hdl, "invalid response from http server");
        
            # ... do something with captured values

            my %resp_hdr = ();
            # now if we have response we can continue with parsing headers
            $hdl->unshift_read(line => qr/(?<![^\012])\015?\012/, sub {
                my ($handle, $line, $eol) = @_;

                # remove all \015
                $line =~ s/\015//g;

                # capture all headers
                $resp_hdr{lc $1} = "$2" while $line =~ s/([^:]*):[\011\040]*([^\012]*)\012//;

                # we can't have anything left in $line
                ! $line or $req_failed->($hdl, "can't parse http response header");

                # now let's do the body
                my $cnt_len = $resp_hdr{"content-length"};
                if ($cnt_len) {
                    # we don't care for on_eof anymore, we need to
                    $hdl->on_eof(undef);

                    # reads the required amount of data, or gets
                    # killed by timeout
                    $hdl->on_read(sub {
                        my ($handle) = @_;
                        if ($cnt_len <= length $handle->{rbuf}) {
                            $req_success->(substr delete $handle->{rbuf}, 0, $cnt_len, "");
                            $hdl->destroy;
                            $IN_PROCESS = 0;
                        }
                    });
                } else {
                    # note if we have the response with redirection or
                    # some other not-having-body it won't work, you need
                    # to handle those cases explicitly, or use AnyEvent::HTTP
                    $req_failed($hdl, "only works with responses having some body");
                }
            });
        });
    };
    
});

my $s = AnyEvent->signal(signal => 'INT', cb => sub {
    undef $w;
    print "Total requests: $fetched\nBye!\n";
    exit;
});

EV::loop;

$req_failed($hdl, "only works with responses having some body");
=>
$req_failed->($hdl, "only works with responses having some body");