#!/usr/bin/perl

# $Id: autoluba.pl,v 1.8 2001/09/13 11:54:01 den Exp $
# autoluba.pl (c) Yandex 1998-2001
# simple tool for search engine estimation

use strict;

use LWP::UserAgent;
use URI::URL;
use URI::Escape;
use HTTP::Request;
use HTTP::Response;

use HTML::Parse;
use HTML::FormatText;

use FileHandle;
use IPC::Open2;

my ($se);
my ($search, $engine, $reDoc, $reSiteMore, $reNextPage, $redir);
my %docs;

my $ua;

my %config = ();

sub read_config
{
    my $engines_cfg = shift;
    $engines_cfg = "engines.cfg" if $engines_cfg eq "";

    local $/ = "\n\n";
    open(CFG, $engines_cfg);
    while (<CFG>) {
        my ($key, $search, $engine, $reDoc, $reSiteMore, $reNextPage, $redir) = split('\n');
        $config{$key} = {
            search => $search,
            engine => $engine,
            doc    => $reDoc,
            site   => $reSiteMore,
            next   => $reNextPage,
            redir  => $redir
        }
    }
}

sub get_docs
{
    my ($response, $docs) = @_;
    my $num = 0;
    while ($response =~ m!$reDoc!g) {
        my $doc = $redir ? uri_unescape($1) : $1;
        $docs->{$doc} .= " $se" if ($docs->{$doc} !~ /$se/);
        $num++
    }
    return $num;
}

sub download
{
    my $url = shift;

    $url = $engine.$url if ($url !~ m!^http://!);
    $url =~ s/&amp;/&/g; # specially for rambler
    #print "[debug] download: $url\n";
    my $uriurl = new URI::URL($url);
    my $request = new HTTP::Request('GET', $uriurl);
    $request->push_header('Accept-Charset' => 'windows-1251');
    my $response = $ua->request($request);
    undef($uriurl);
    undef($request);
    #print "[debug] failure\n" if !$response->is_success;
    return ($response->is_success ? $response->content : "");
}

sub process_request
{
    my ($query, $docs) = @_;
    my ($response, $url, $more, $more_response);

    $url = $search.uri_escape($query);
    do {
        return if (($response = download($url)) eq "");
        get_docs($response, $docs);
        while ($response =~ m!$reSiteMore!g) {
            $more = $1;
            do {
                next if (($more_response = download($more)) eq "");
                get_docs($more_response, $docs);
            } while (($more) = ($more_response =~ m!$reNextPage!));
        }
    } while (($url) = ($response =~ m!$reNextPage!));
}

sub do_pipe
{
    my ($command, $input) = @_;
    my ($output);

    # create file; remember its name
    my $infile = `mktemp tempfile.XXXXXXX`;
    chomp($infile);

    # fill input file with provided $input
    open(IN, ">$infile");
    print IN $input;
    close(IN);

    # modify command and run it
    $command =~ s/IN/$infile/;
    $output = `$command`;

    unlink($infile);
    return $output;
}

sub strip_html
{
    my ($text) = @_;
    
    #strip comments
    $text =~ s{ 
        <!--          # Open comment
        (             # Middle
            [^-]|
            -[^-]|
            --+[^->]
        )*  
        --+>          # Close comment
    }{}gsx;

    #strip tags
    $text =~ s{ 
        <(\?|!|/?[a-zA-Z])    # Open tag: "<?" or "<!" or "</a" or "<a"
        (                     # Middle
            [^>\s=]|          #    [^>]
            [\s=](            #    [= ]
                ('[^']*')|    #      '..>..'
                ("[^"]*")|    #      "..>..
                (`[^`]*`)     #      `..>..`
            )?
        )*  
        >                     # Close tag
    }{}gsx;
    
    return $text;
}

my %cp_names = (
    W => 'windows-1251',
    K => 'koi8-r', 
    A => 'ibm866', 
    M => 'MacCyrillic', 
    I => 'iso-8859-5', 
    E => 'ascii', 
    w => 'win-win', 
    k => 'koi-koi',
    U => 'unknown'
);

sub process_url
{
    my ($rus_word, $eng_word, $url, $num) = @_;

    #print "[debug] process_url: $url";
    # 1. download url into $content; save content for the future use
    my $content = download($url);
    if ($content eq "") {
        #print " MISSED\n";
        return "MISSED";
    }

    # 2. normalize code page

    # 2a. determine the code page of the $content
    my $cp = do_pipe("./rcgtest IN", $content);
    $cp =~ m/\[(.)\]/;
    $cp = $cp_names{$1};
    
    if ($cp eq "") {
        #print " RCG FAIL\n";
    }

    # 2b. recode $content into windows-1251 if neccessary
    if ($cp ne "windows-1251" && $cp ne "ascii" && $cp ne "unknown") {
        $content = do_pipe("./recode $cp windows-1251 IN", $content);
    }

    # 3. remove HTML tags for the future
    my $plain_text = strip_html($content);

    # 4. look for shortened russian word in text
    #    if it's missing we suppose the document changed
    chop($rus_word);
    chop($rus_word);
    $rus_word =~ s{([\xC0-\xFF])}{
        sprintf("[%c%c]", ord($1), ord($1) < 224 ? ord($1) + 32 : ord($1) - 32)
    }gex;
    if ($plain_text !~ /$rus_word/) {
        #print " CHANGED\n";
        return "CHANGED";
    }

    # 5. calculate checksum of the 'normalized' & 'stripped' text
    $plain_text =~ s/\s\s+/ /g;
    
    my $md5 = do_pipe("md5 <IN", $plain_text);
    chomp($md5);

    #print " -- OK\n";
    return $md5;
}

sub make_stat
{
    my ($docs, $stat, $eng_word) = @_;
    my $engine_list = "";
    foreach my $e (keys %config) {
        $engine_list .= $e."|";
    }
    my $last_word;
    chop($engine_list);
    foreach my $u (keys %{$docs}) {
        while ($docs->{$u} =~ /($engine_list)/g) {
            my $e = $1;
            $docs->{$u} =~ m/([\w\d]+)$/; # `md5`, MISSED or CHANGED
            $last_word = $1;
            $stat->{$e}{url}++;
            $stat->{$e}{missed}++ if $last_word eq "MISSED";
            $stat->{$e}{changed}++ if $last_word eq "CHANGED";
            $stat->{$e}{md5}{$last_word}++ if ($last_word ne "CHANGED" && $last_word ne "MISSED");
        }
    }
    open(STAT, ">$eng_word.stat");
    foreach my $e (%{$stat}) {
        $stat->{$e}{url} = 0 if !$stat->{$e}{url};
        $stat->{$e}{missed} = 0 if !$stat->{$e}{missed};
        $stat->{$e}{changed} = 0 if !$stat->{$e}{changed};
        print STAT $e."\t".$stat->{$e}{url}."\t".$stat->{$e}{missed}."\t".$stat->{$e}{changed}."\t".scalar(keys(%{$stat->{$e}{md5}}))."\n";
    }
    close(STAT);
}

#print process_url("цивета", "civeta", "http://www.menu.ru/info/default.asp?output=do&&d1=9&d2=0&d3=0&d4=0&f1=3&f2=15&f3=0&f4=0&p=0&s=2&dir=0&sch=&txt=&id=747", 0)."\n";
#print process_url("цивета", "civeta", "http://www.filin.hut.ru/mammels/viverra.htm", 0)."\n";
#print process_url("цивета", "civeta", "http://rt.gena.lib.ru/win/design/classic/pages/1511/32.htm", 0)."\n";
#exit(0);

# void main(void) {
$SIG{"PIPE"} = 'IGNORE';
$ua = new LWP::UserAgent;
read_config($ARGV[0]);

while (<STDIN>) {
    chomp;
    my $filename = $_;
    my $word = $_;
    %docs = ();
    next if !$_;
    foreach my $k (keys %config) {
        $se = $k;
        # fill SE configuration
        $search = $config{$se}{search};
        $engine = $config{$se}{engine};
        $reDoc = $config{$se}{doc};
        $reSiteMore = $config{$se}{site};
        $reNextPage = $config{$se}{next};
        $redir = $config{$se}{redir};

        process_request($_, \%docs);
        #print $se." ".scalar(keys(%docs))."\n";
    }

    $filename =~ y/абвгдежзийклмнопрстуфхцчшщъыьэюя/abvgdejziyklmnoprstufhccss'y'eua/;
    open(OUT, ">$filename.log");
    OUT->autoflush(1);
    my $num = 0;
    foreach my $u (keys %docs) {
        my $status = process_url($word, $filename, $u, $num);
        print OUT $u."\t".$docs{$u}." $num $status\n";
        $docs{$u} .= " $status";
        $num++;
    }
    close(OUT);
    my %engines_stat = ();
    make_stat(\%docs, \%engines_stat, $filename);
}
# } // main()
