#!/usr/bin/perl
#
#===============================================================================
#         FILE:  tcy-meter.pl
#
#        USAGE:  На вход скрипта построчно подаются URL сайтов (без http://), для
#                которых нужно получить значение ТИЦ. На выходе - списко URL
#                с полученными значениями ТИЦ.
#                Для параллельной загрузки значений ТИЦ оставть использование
#                модуля LWP::Parallel::UserAgent (требует установки из CPAN);
#                для однопоточной - поменять на LWP::Parallel::UserAgent.
#
# REQUIREMENTS:  Perl 5.8.8 or highest;
#                Core lib: DBI, Carp, HTTP::Request
#                Non-core lib: LWP::Parallel::UserAgent,
#       AUTHOR:  Dimio (http://dimio.org)
#      VERSION:  0.0.1
#===============================================================================
#
use warnings;
use strict;
require 5.008_008;
use utf8;
use Carp;
#use LWP::UserAgent;
use LWP::Parallel::UserAgent;
use HTTP::Request;

our $VERSION = '0.0.1';

my $option = {
    yaca_url        => 'http://bar-navig.yandex.ru/u?ver=2&show=32&url=',
};

croak if !@ARGV;

# 1 - для однопоточной загрузки через LWP::UserAgent
#my $ua = set_useragent();
#
# 2 - для многопоточной загрузки через LWP::Parallel::UserAgent
my $ua = set_parallel_useargent();

my %uri_list;

# На вход скрипта построчно подаются URL, для которых нужно получить ТИЦ
while (my $uri = ) {
    chomp $uri;
    $uri_list{$uri} = get_tcy($option, $uri);
}

# Вывод списка URL с полученными значениями ТИЦ
foreach my $uri (keys %uri_list) {
    print $uri . ';' . $uri_list{$uri} . $/;
}

exit;

# для указанного URL получает с Яндекса значения Ранг и тИЦ,
# если получить не удалось - возвращает ошибку 0 (неверный
# адрес). Вывод: tCY (num), Rang (num)
sub get_tcy {
    my ($option, $uri) = @_;

    my $response = $ua->get( $option->{yaca_url}.'http://'.$uri );
        unless ($response->is_success) {
            carp "$uri -- can't load tcy page!";
            return undef;
        }

    my $src = $response->decoded_content;

    #
    # нет проверки на совпадение, т.к. Яндекс для неправильных
    # адресов всегда выдаёт параметры 0, 0
    $src =~ m//imsxo;

    #return $2, $1;
    return $2;
}


sub set_parallel_useargent {
    my $pua = LWP::Parallel::UserAgent->new();
    $pua->agent('Mozilla/5.0 (Windows; Windows NT 6.1; rv:2.0) Gecko');
    $pua->default_header(
        'Accept' => 'text/html, application/xml;q=0.9, application/xhtml+xml;q=0.1',
        'Accept-Charset'  => 'utf-8; *;q=0.1',
        'Accept-Language' => 'ru,en-us;q=0.7,en;q=0.3',
        'Accept-Encoding' => 'deflate, gzip, x-gzip, identity, *;q=0',
    );
    $pua->in_order  (1);  # handle requests in order of registration
    $pua->duplicates(0);  # ignore duplicates
    $pua->timeout   (2);  # in seconds
    $pua->redirect  (0);  # follow redirects - no
    $pua->max_req   (15); # max parallel requests per server (def 5)

    return $pua;
}

sub set_useargent {
    my $ua = LWP::UserAgent->new();
    $ua->agent('Mozilla/5.0 (Windows; Windows NT 6.1; rv:2.0) Gecko');
    $ua->default_header(
        'Accept' => 'text/html, application/xml;q=0.9, application/xhtml+xml;q=0.1',
        'Accept-Charset'  => 'utf-8; *;q=0.1',
        'Accept-Language' => 'ru,en-us;q=0.7,en;q=0.3',
        'Accept-Encoding' => 'deflate, gzip, x-gzip, identity, *;q=0',
    );
    $ua->timeout   (2);  # in seconds
    $ua->redirect  (0);  # follow redirects - no

    return $ua;
}