quest6.pl

#!/usr/bin/env perl 

use Modern::Perl '2015';
use utf8;

use Carp qw/confess/;
use IO::Socket::IP;
use URI;

my $host  = 'www.perlmonks.org';
my $path  = '/';
my $query = {
    node_id => 1181364
};
my $timeout = 1.5;

my ( $code, $length ) = get_http( $host, $path, $query, $timeout );
printf "CODE %d\nLENGTH %d\n", $code, $length;

sub get_http {
    my ( $host, $path, $query, $timeout ) = @_;

    my $socket = IO::Socket::IP->new(
        PeerHost => $host,
        PeerPort => 'http',
        Type     => SOCK_STREAM,
    );

    _set_timeout( $socket, $timeout );
    my $uri = _get_uri( $path, $query );

    my $code           = 0;
    my $content_length = 0;

    print $socket "HEAD $uri HTTP/1.1\r\n";
    print $socket "Host: $host\r\n\r\n";
    my $response_status = <$socket>;
    if ($response_status) {
        ( undef, $code, undef ) = split /\s/, $response_status;
        Carp::confess $response_status unless $code == 200;

        while ( my $line = <$socket> ) {
            chomp $line;

            my ( $header, $data ) = split /\s+/, $line;
            if ( $header && $header eq 'Content-Length:' ) {
                $content_length = $data;
                last;
            }
        }
    }
    $socket->close();

    return $code, $content_length;
}

sub _get_uri {
    my ( $path, $query ) = @_;

    my $uri = URI->new($path);
    $uri->query_form($query) if $query;

    return $uri->as_string;
}

sub _set_timeout {
    my ( $socket, $timeout ) = @_;

    my $seconds = int($timeout);
    my $useconds = int( 1_000_000 * ( $timeout - $seconds ) );
    $timeout = pack( 'l!l!', $seconds, $useconds );
    $socket->setsockopt( SOL_SOCKET, SO_RCVTIMEO, $timeout );

    return;
}