#!/usr/bin/perl
# Pomocí POP3 stahuje z účtu paluba@hrejsi.cz zprávy se žádostí o informace o Deskohraní.
# Copyright © 2010 Dan Zeman <zeman@ufal.mff.cuni.cz>
# Licence: GNU GPL

use utf8;
use open ":utf8";
binmode(STDIN, ":utf8");
binmode(STDOUT, ":utf8");
binmode(STDERR, ":utf8");
use Encode;
use Net::POP3;
use dzsys;
use access;

dzsys::autoflush(*STDOUT);
dzsys::autoflush(*STDERR);
# Načíst z databáze seznam již známých osob.
print STDERR ("Cte se tabulka ../osoby.txt\n");
$osoby = access::cist_tabulku('../osoby.txt');
print STDERR ("Precteno ", scalar(@{$osoby}), " zaznamu, hasuji se e-mailove adresy.\n");
# Nahashovat známé e-maily, budeme vyhledávat pouze podle nich.
foreach my $osoba (@{$osoby})
{
    my @emaily = split(/\s*,\s*/, $osoba->{'e-mail'});
    foreach my $email (@emaily)
    {
        $emaily{lc($email)}++;
    }
}
# Zkonstruovat rozhraní pro komunikaci s POP3 serverem.
print STDERR ("Navazuje se spojeni se serverem kub.cz.\n");
$pop = Net::POP3->new('kub.cz', Debug => 1);
if(!defined($pop))
{
    die("Nepodarilo se inicializovat komunikaci protokolem pop3 se serverem kub.cz.\n");
}
$nmsg = $pop->login('paluba@hrejsi.cz', 'zab9t');
print STDERR ("Schranka paluba\@hrejsi.cz obsahuje $nmsg zprav.\n");
# Získat odkaz na hash, klíče jsou čísla nesmazaných zpráv, hodnoty jsou jejich velikosti v bajtech.
print STDERR ("Stahuje se seznam nesmazanych zprav.\n");
$seznam = $pop->list();
@seznam = sort(keys(%{$seznam}));
print STDERR ("Seznam stazen, nalezeno ", scalar(@seznam), " nesmazanych zprav.\n");
# Projít předměty zpráv a vybrat ty, které nás zajímají.
$nfil = 0;
foreach my $imsg (@seznam)
{
    print STDERR ('.');
    # Následující funkce vrátí odkaz na pole řádků.
    my $zahlavi = $pop->top($imsg);
    # Najít řádek s předmětem zprávy.
    my @predmet = grep {m/^Subject:/i} (@{$zahlavi});
    next unless(scalar(@predmet)>0);
    my $predmet = $predmet[0];
    # Zjistit, zda má zpráva předmět, který hledáme.
    # Poznámka: Předmět obsahuje diakritiku v "Deskohraní", zpráva by měla být v UTF-8, ale zatím nemáme jistotu, zda to Perl ví.
    next unless($predmet =~ m/^Subject: Zadost o( ODHLASENI)? Deskohran/);
    $nfil++;
    # Přečíst celou zprávu. Funkce vrátí odkaz na pole řádků.
    my $radky = $pop->get($imsg);
    # Projít řádky zprávy.
    my %zaznam;
    foreach $radek (@{$radky})
    {
        # Říct Perlu, že řádek je kódován v UTF-8.
        $radek = decode('utf8', $radek);
        # Odstranit znaky konce řádku.
        $radek =~ s/\r?\n$//;
        # Rozeznat řádky s informacemi (některé mohou být ze záhlaví zprávy!)
        if($radek =~ m/^Date: (.*)$/)
        {
            $zaznam{datum} = $1;
            # Rozebrat datum a čas na jednotlivé složky a vytvořit z nich tříditelný řetězec čísel.
            if($zaznam{datum} =~ m/^(?:Mon|Tue|Wed|Thu|Fri|Sat|Sun),\s+(\d+)\s+(Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec)\s+(\d+)\s+(\d+):(\d+):(\d+)\s/)
            {
                my $den = $1;
                my $mesic_slovne = $2;
                my $rok = $3;
                my $hodina = $4;
                my $minuta = $5;
                my $vterina = $6;
                my %mesice = ('Jan'=>1, 'Feb'=>2, 'Mar'=>3, 'Apr'=>4, 'May'=>5, 'Jun'=>6, 'Jul'=>7, 'Aug'=>8, 'Sep'=>9, 'Oct'=>10, 'Nov'=>11, 'Dec'=>12);
                my $mesic = $mesice{$mesic_slovne};
                $zaznam{cas} = sprintf("%04d%02d%02d%02d%02d%02d", $rok, $mesic, $den, $hodina, $minuta, $vterina);
            }
        }
        elsif($radek =~ m/^Email: (.*)$/)
        {
            $zaznam{email} = lc($1);
        }
        elsif($radek =~ m/^Jmeno: (.*)$/)
        {
            $zaznam{jmeno} = $1;
        }
        elsif($radek =~ m/^Prijmeni: (.*)$/)
        {
            $zaznam{prijmeni} = $1;
        }
        elsif($radek =~ m/^Akce: (.*)$/)
        {
            $zaznam{akce} = $1;
        }
        elsif($radek =~ m/^Jazyk: (.*)$/)
        {
            $zaznam{jazyk} = $1;
        }
        elsif($radek =~ m/^ODHLASIT\s+(\S+)\s+(\S+)\s+<(.+?@.+?)>/)
        {
            $zaznam{jmeno} = $1;
            $zaznam{prijmeni} = $2;
            $zaznam{email} = lc($3);
            $zaznam{akce} = 'Odhlásit';
        }
    }
    # Zjistit, zda už v databázi máme někoho se stejnou e-mailovou adresou.
    $zaznam{znamy} = $zaznam{email} ne '' && exists($emaily{$zaznam{email}}) ? 'známý' : 'neznámý';
    # Vypsat záznam na standardní výstup.
    print("$zaznam{jmeno}\t$zaznam{prijmeni}\t$zaznam{email}\t$zaznam{znamy}\t$zaznam{jazyk}\t$zaznam{akce}\t$zaznam{datum}\t$zaznam{cas}\n");
}
print STDERR ("\n");
print STDERR ("Bylo nalezeno $nfil zprav s pozadovanym predmetem.\n");