cp-http.pl

#!/usr/bin/perl

# Написать функцию http_get ($host, $path, $query, $timeout), которая
# делает http запрос на адрес http://$host/$path?$query с таймаутом $timeout.
# Реализация http должна быть примитивной, то есть мы расчитываем на ответ
# HTTP 200 OK с content-length.
# $query передают в функцию хешом.
# А также написать асинхронную версию этой функции, которая (для простоты
# задания) отличается тем, что пока ждет ответа занимается заполнением
# какого-нить массива числами и выводит на экран сколько элементов успела
# добавить пока ждала ответа удаленного сервера. Программа должна
# оставаться в рамках 1 процесса  и 1 потока (т.е. без fork и без threads).
# 
# P.S. Пожалуйста, не пользуйтесь LWP::*, он не поможет во втором пункте
# задания, да и задание это нужно, чтобы посмотреть как вы умеете работать
# с сокетами, а не как это умеют работать модули.
# В качестве решения второй части задания мы также готовы засчитать
# решение с помощью какого-либо модуля, однако вручную все же намного
# лучше, т.к., повторюсь, в реальной жизни конечно можно и не писать
# такие вещи в ручную, но знание этого и специфики асинхронной
# работы – очень важно.

use Modern::Perl;
use IO::Socket::INET;
use IO::Async::Stream;
use IO::Async::Loop;
use IO::Select;
use Time::HiRes();
use Carp qw/confess carp/;
use POSIX qw/:signal_h/;

# ------------------------------------------------------------------------------
# В качестве упрощения читаем всё целиком, с целью потом распарсить
# заголовки и тело. Хотя это и нехорошо.
# ------------------------------------------------------------------------------
my $rc = http_get( 'www.crazypanda.ru', '/', { 'a' => 'b', 'c' => 'd' } );
parse_http_answer($rc);
$rc = http_get_async( 'digital-direct.ru', '/', { 'e' => 'f', 'g' => 'h' } );
parse_http_answer($rc);
$rc = http_get_async_manual( 'www.perl.org', '/', { 'i' => 'j', 'k' => 'l' } );
parse_http_answer($rc);

# ------------------------------------------------------------------------------
sub parse_http_answer
{
    my ($rc) = @_;
    say $rc;
}

# ------------------------------------------------------------------------------
sub _make_get
{
    my ( $host, $path, $query ) = @_;
    $path ||= '/';

    # Квери бы закодировать...
    $path .= '?' . join( '&', map { $_ . '=' . $query->{$_} } keys %{$query} )
        if $query;
    return "GET $path HTTP/1.0\nHost: $host\n\n";
}

# ------------------------------------------------------------------------------
sub _call_with_timeout
{
    my ( $timeout, $coderef ) = @_;

    my $mask = POSIX::SigSet->new(SIGALRM);
    my $action
        = POSIX::SigAction->new( sub { die __PACKAGE__ . "- timeout!\n"; },
        $mask, );
    my $oldaction = POSIX::SigAction->new();
    sigaction( SIGALRM, $action, $oldaction );
    eval {
        eval {
            alarm($timeout);
            $coderef->();
        };
        alarm(0);
        die "$@" if $@;
    };
    sigaction( SIGALRM, $oldaction );
    if ($@) {
        my $error = $@;
        chomp $error;
        carp $error;
    }
}

# ------------------------------------------------------------------------------
# Самый простой вариант
# ------------------------------------------------------------------------------
sub http_get
{
    my ( $host, $path, $query, $timeout ) = @_;

    $timeout ||= 10;
    my $sock = IO::Socket::INET->new(
        PeerAddr => $host,
        PeerPort => 'http(80)',
        Proto    => 'tcp',
        Timeout  => $timeout,
    );

    confess 'Can not create socket!' unless $sock;
    my $get = _make_get( $host, $path, $query );
    $sock->syswrite($get);
    my $rc = '';

    _call_with_timeout(
        $timeout,
        sub {
            while ( $sock->sysread( my $data, 1024 ) ) {
                $rc .= $data;
            }
        }
    );
    $sock->close();
    return $rc;
}

# ------------------------------------------------------------------------------
# IO::Async::*
# ------------------------------------------------------------------------------
sub http_get_async
{
    my ( $host, $path, $query, $timeout ) = @_;

    $timeout ||= 10;
    my $sock = IO::Socket::INET->new(
        PeerAddr => $host,
        PeerPort => 'http(80)',
        Proto    => 'tcp',
        Timeout  => $timeout,
        Blocking => 0,
    );

    confess 'Can not create socket!' unless $sock;

    my $get      = _make_get( $host, $path, $query );
    my $counter  = 0;
    my $rc       = '';
    my $time_end = time() + $timeout;

    my $loop  = IO::Async::Loop->new();
    my $async = IO::Async::Stream->new(
        handle  => $sock,
        on_read => sub {
            my ( $self, $data, $eof ) = @_;
            if ($eof) {
                $loop->stop;
            }
            else {
                while ( ${$data} =~ s/^(.*\n)// ) {
                    $rc .= $1;
                    if ( time() > $time_end ) {
                        $loop->stop;
                        last;
                    }
                }
            }
        },
        on_outgoing_empty => sub {
            ++$counter;
        },
    );
    $loop->add($async);
    $async->write("GET $path HTTP/1.0\nHost: $host\n\n");
    $loop->run;
    $async->close;

    say "\n[[[$counter]]]";
    return $rc;
}

# ------------------------------------------------------------------------------
# Велосипед
# ------------------------------------------------------------------------------
sub http_get_async_manual
{
    my ( $host, $path, $query, $timeout ) = @_;

    $timeout ||= 10;
    my $sock = IO::Socket::INET->new(
        PeerAddr => $host,
        PeerPort => 'http(80)',
        Proto    => 'tcp',
    );

    confess 'Can not create socket!' unless $sock;
    my $select = IO::Select->new();
    $select->add($sock);

    my $get      = _make_get( $host, $path, $query );
    my $counter  = 0;
    my $time_end = time() + $timeout;
    $sock->syswrite($get);
    my $rc = '';

    local $SIG{ALRM} = sub {
        while ( $select->can_read(.1) ) {
            return if time() >= $time_end;
            if ( $sock->sysread( my $data, 1024 ) ) {
                $rc .= $data;
            }
            else {
                $time_end = time() - 1;
            }
        }
        Time::HiRes::alarm(.05);
    };

    Time::HiRes::alarm(.05);
    while ( time() < $time_end ) {
        ++$counter;
    }
    $sock->close;

    say "\n<<<$counter>>>";
    return $rc;
}

# ------------------------------------------------------------------------------