#!/usr/bin/perl -w

use Net::HTTP;
use POSIX qw(strftime);
use POSIX qw(setlocale LC_ALL);

#
# получить $host, $port, $path из url, указанного в командной строке
# или использовать значения по умолчанию
#
if (($#ARGV == 0) && ($ARGV[0] =~ m#http://([^:]+):(\d+)(/.*)#i)) {
    $host = $1;
    $port = $2;
    $path = $3;
} else {
    $host = "kappa.cs.prv";
    $port = 80;
    $path = "/index.html.ru.koi8-r";
}


$user_agent = "Mozilla/5.0";
$version    = "1.0";
$referer    = "http://example.com/path/to/the/document.html";
$nosuchdoc  = "/zzz/zzz/zzz.html";

#
# Использовать traditional UNIX system locale
#
setlocale(LC_ALL, "C");

# ======================================================================
# вывод шапки и запроса
# ======================================================================
sub print_request {
    my ($text, $req) = @_;

    #
    # Шапка
    #
    print "=" x 60 . "\n";
    print $text . "\n";
    print "=" x 60 . "\n";

    #
    # Запрос 
    #
    print "\n";
    print "Запрос:\n"; 
    print "\n";
    print $req;

}    

# ======================================================================
# вывод заголовка и длины данных в ответе
# ======================================================================
sub print_response {
    my ($code, $msg, %header) = @_;

    # 
    # Строка статуса
    #
    printf "Ответ:\n";
    printf "\n";
    printf "HTTP/%s %s %s\n", $s->peer_http_version, $code, $msg;

    #
    # Вывод заголовка HTTP-ответа
    #
    foreach (keys %header) {
        printf "%s: %s\n", $_,  $header{$_};
    }

    #
    # Получить и посчитать данные HTTP-ответа
    #
    $length = 0;
    while($n = $s->read_entity_body(undef, 1024)) {
        $length += $n;
    }
    if(!defined($n)) {
        die "read failed: $!\n";
    }

    #
    # Вывод длины данных в ответе
    #
    printf "\n";
    printf "Данные: %d байт\n", $length;
    printf "\n";
}


use IO::Socket::INET;


# ======================================================================
# 1. HTTP/0.9
# ======================================================================

#
# Создать объект IO::Socket::INET
#
$sock = IO::Socket::INET->new(
    PeerAddr => $host,
    PeerPort => $port,
    Proto    => 'tcp')
    or die "Can't create IO::Socket::INET object: $@\n";

$req = "GET $path\r\n";

#
# Вывод шапки и запроса
#
print_request("1. HTTP/0.9", $req);

#
# Отправить запрос
#
$sock->print($req)
    or die "Can't send request: $!\n";

#
# Получить ответ
#
$resp = "";
while(<$sock>) {
    $resp .= $_;
}

#
# Вывод ответа (первые 5 строк)
#
printf "\n";
printf "Ответ:\n";
printf "\n";
$n = 1;
while(($resp =~ m/([^\r\n]*)\r*\n/g) && ($n < 6)) {
    print "$1\n";
    $n++;
}
if($n == 6) {
    print "....\n";
}

#
# Вывод длины данных в ответе
#
printf "\n";
printf "Данные: %d байт\n", length $resp;
printf "\n";


# ======================================================================
# 2. HTTP/0.9 + HEAD (Bad Request)
# ======================================================================

#
# Создать объект IO::Socket::INET
#
$sock = IO::Socket::INET->new(
    PeerAddr => $host,
    PeerPort => $port,
    Proto    => 'tcp')
    or die "Can't create IO::Socket::INET object: $@\n";

$req = "HEAD $path\r\n";

#
# Вывод шапки и запроса
#
print_request("2. HTTP/0.9 + HEAD (Bad Request)", $req);

#
# Отправить запрос
#
$sock->print($req)
    or die "Can't send request: $!\n";

#
# Получить ответ
#
$resp = "";
while(<$sock>) {
    $resp .= $_;
}

#
# Вывод ответа (первые 5 строк)
#
printf "\n";
printf "Ответ:\n";
printf "\n";
$n = 1;
while(($resp =~ m/([^\r\n]*)\r*\n/g) && ($n < 6)) {
    print "$1\n";
    $n++;
}
if($n == 6) {
    print "....\n";
}

#
# Вывод длины данных в ответе
#
printf "\n";
printf "Данные: %d байт\n", length $resp;
printf "\n";

# ======================================================================
# 3. HTTP/1.0 + relativeURI
#    Получение даты последней модификации (Last-Modified)
#    Дата должна быть в GMT
# ======================================================================

#
# Создать объект Net::HTTP
#
$s = Net::HTTP->new(Host => $host, PeerPort => $port, HTTPVersion => $version)
    or die "Can't create Net::HTTP object: $@\n";

#
# Вывод шапки и запроса
#
print_request("3. GET HTTP/1.0 + relativeURI + GMT",
    $s->format_request(GET => $path, 'User-Agent' => $user_agent));

#
# Отправить запрос
#
$s->write_request(GET => $path, 'User-Agent' => $user_agent)
    or die "Can't send request: $!\n";

#
# Получить заголовок ответа
#
($code, $msg, %header) = $s->read_response_headers()
    or die "Hmmm can't read response headers\n";

#
# Вывод ответа
#
print_response($code, $msg, %header);

#
# Получить Last-Modified
#
foreach (keys %header) {
    #
    # Last-Modified сохраняется 
    # для дальнейшего использования
    #
    if(m/last-modified/i) {
        $last_modified = $header{$_};
    } elsif (m/date/i) {
        $last_modified = $header{$_};
    }
}

#
# Или использовать текущее время
#
if(!defined($last_modified)) {
    $last_modified = strftime "%a, %e %b %Y %H:%M:%S GMT", gmtime();
}


# ======================================================================
# 4. HEAD
# ======================================================================

#
# Создать об[ект Net::HTTP
#
$s = Net::HTTP->new(Host => $host, PeerPort => $port, HTTPVersion => $version)
    or die "Can't create Net::HTTP object: $@\n";

#
# Вывод шапки и запроса
#
print_request("4. HEAD",
    $s->format_request(HEAD => $path, 'User-Agent' => $user_agent));

#
# Отправить запрос
#
$s->write_request(HEAD => $path, 'User-Agent' => $user_agent)
    or die "Can't send request: $!\n";

#
# Получить заголовок ответа
#
($code, $msg, %header) = $s->read_response_headers()
    or die "Hmmm can't read response headers\n";

# Вывод ответа
#
print_response($code, $msg, %header);


# ======================================================================
# 5. absoluteURI
# ======================================================================

#
# Создать об[ект Net::HTTP
#
$s = Net::HTTP->new(Host => $host, PeerPort => $port, HTTPVersion => $version)
    or die "Can't create Net::HTTP object: $@\n";

#
# Вывод шапки и запроса
#
print_request("5. absoluteURI",
    $s->format_request(GET => "http://" . $host . ":" . $port . $path,
        'User-Agent' => $user_agent));

#
# Отправить запрос
#
$s->write_request(GET => "http://" . $host . ":" . $port . $path, 
    'User-Agent' => $user_agent)
    or die "Can't send request: $!\n";

#
# Получить заголовок ответа
#
($code, $msg, %header) = $s->read_response_headers( laxed => 1)
    or die "Hmmm can't read response headers\n";

#
# Вывод ответа
#
print_response($code, $msg, %header);


# ======================================================================
# 6. If-Modified-Since
# ======================================================================

#
# Создать об[ект Net::HTTP
#
$s = Net::HTTP->new(Host => $host, PeerPort => $port, HTTPVersion => $version)
    or die "Can't create Net::HTTP object: $@\n";

#
# Вывод шапки и запроса
#
print_request("6.1 If-Modified-Since (не модиф.) + User-Agent + Referer ",
    $s->format_request(GET => $path, 'User-Agent' => $user_agent,
        'If-Modified-Since' => $last_modified));

#
# Отправить запрос
#
$s->write_request(GET => $path, 'User-Agent' => $user_agent,
    'If-Modified-Since' => $last_modified)
    or die "Can't send request: $!\n";

#
# Получить заголовок ответа
#
($code, $msg, %header) = $s->read_response_headers( laxed => 1)
    or die "Hmmm can't read response headers\n";

#
# Вывод ответа
#
print_response($code, $msg, %header);

#
# Найти в $last_modified что-нибудь похожее на год 
# и поменять на "что-нибудь - 1"
#
if($last_modified =~ m/ (\d\d\d\d) /) {
    $year          = $1;
    $previous_year = $1 - 1;
    $last_modified =~ s/$year/$previous_year/;
}

#
# Создать об[ект Net::HTTP
#
$s = Net::HTTP->new(Host => $host, PeerPort => $port, HTTPVersion => $version)
    or die "Can't create Net::HTTP object: $@\n";

#
# Вывод шапки и запроса
#
print_request("6.2 If-Modified-Since (модиф.) + User-Agent + Referer",
    $s->format_request(GET => $path, 
        'User-Agent'        => $user_agent,
        'Referer'           => $referer,
        'If-Modified-Since' => $last_modified));

#
# Отправить запрос
#
$s->write_request(GET => $path, 
    'User-Agent'        => $user_agent,
    'Referer'           => $referer,
    'If-Modified-Since' => $last_modified)
    or die "Can't send request: $!\n";

#
# Получить заголовок ответа
#
($code, $msg, %header) = $s->read_response_headers( laxed => 1)
    or die "Hmmm can't read response headers\n";

#
# Вывод ответа
#
print_response($code, $msg, %header);

# ======================================================================
# 7. 404 Not Found
# ======================================================================

#
# Создать об[ект Net::HTTP
#
$s = Net::HTTP->new(Host => $host, PeerPort => $port, HTTPVersion => $version)
    or die "Can't create Net::HTTP object: $@\n";

#
# Вывод шапки и запроса
#
print_request("7. 404 Not Found",
    $s->format_request(GET => $nosuchdoc, 'User-Agent' => $user_agent));

#
# Отправить запрос
#
$s->write_request(GET => $nosuchdoc, 'User-Agent' => $user_agent)
    or die "Can't send request: $!\n";

#
# Получить заголовок ответа
#
($code, $msg, %header) = $s->read_response_headers()
    or die "Hmmm can't read response headers\n";


# Вывод ответа
#
print_response($code, $msg, %header);

# ======================================================================
# 8. 501 Not Implemented
# ======================================================================

#
# Создать объект IO::Socket::INET
#
$sock = IO::Socket::INET->new(
    PeerAddr => $host,
    PeerPort => $port,
    Proto    => 'tcp')
    or die "Can't create IO::Socket::INET object: $@\n";

$req = 
    "ZZZ $path HTTP/1.0\r\n" .
    "Host: $host\r\n" .
    "User-Agent: $user_agent\r\n" .
    "Referer: $referer\r\n" .
    "\r\n";

#
# Вывод шапки и запроса
#
print_request("8. 501 Not Implemented", $req);

#
# Отправить запрос
#
$sock->print($req)
    or die "Can't send request: $!\n";

#
# Получить ответ
#
$resp = "";
while(<$sock>) {
    $resp .= $_;
}

#
# Вывод ответа (первые 5 строк)
#
printf "Ответ:\n";
printf "\n";
if ($resp =~ m/(.*?)(\r*\n){2}(.*)/s) {
    print "$1\n";
    $length = length $3;
} else {
    print "В ответе не найдена пустая строка (CR LF CR LF)\n";
}

#
# Вывод длины данных в ответе
#
printf "\n";
printf "Данные: %d байт\n", $length;
printf "\n";


