#!/usr/bin/perl
# Zobrazí nebo zpracuje hlasovací formulář.
# Copyright © 2011 Klára a Dan Zemanovi <zeman@ufal.mff.cuni.cz>
# Licence: GNU GPL

use utf8; # říct Perlu, že konstantní řetězce ve zdrojáku jsou v UTF
use Encode; # funkce pro překódování
use DBI; # spolupráce se serverem MySQL
# Říct Perlu, kde najde Danovy sdílené knihovny.
# CGI skripty běží pod uživatelem apache, který nemá tyto knihovny v cestě.
# Podle Ondry Bojara na tohle stačí use lib '/s/w/lib/dan';.
BEGIN {unshift(@INC, '/s/w/lib/dan') unless(grep {$_ eq '/s/w/lib/dan'} @INC)}
use dancgi; # čtení parametrů z webu nebo z ARGV
use cas; # práce s daty a časem
use jazyky; # jazykové verze textů
use csort; # jazykově závislé řazení podle abecedy
use mso; # funkce pro generování stránek o olympiádě
binmode(STDOUT, ":utf8"); # říct Perlu, že UTF chceme i na výstupu


# Připojit se k databázi.
$databaze = mso::pripojit_se_k_databazi();


# Načíst parametry z URL.
dancgi::cist_parametry(\%konfig);
# Umožnit volat skript z příkazového řádku a předat parametry tam (např. perl partie.pl zdroj=cas).
dancgi::rozebrat_parametry($ARGV[0], \%konfig);
# Načíst formulář.
if($konfig{co} eq "zpracuj")
{
    dancgi::cist_formular_post(\%konfig);
}
if($konfig{jazyk} eq "")
{
    $konfig{jazyk} = "cs";
}
$jazyky::jazyk = $konfig{jazyk};
# Vždy se lze přihlásit pouze na jeden ročník: ten nejbližší, který bude, případně
# ten, který právě probíhá. Zjistit, který ročník to je, a přepsat parametr rok,
# ať už tam měl uživatel cokoli.
$ted = cas::ted();
$roky = mso::dotazat_se_databaze($databaze, "rok", "konec", "vcasne_prihlasky_do", "rocniky ORDER BY rok");
for(my $i = 0; $i<=$#{$roky}; $i++)
{
    $konfig{rok} = $roky->[$i]{rok};
    $konfig{vcas} = $roky->[$i]{vcasne_prihlasky_do};
    if($ted->{eden} <= cas::datum2eden($roky->[$i]{konec}))
    {
        last;
    }
}



if($konfig{co} ne "zpracuj")
{
    zobrazit_hlasovani($databaze, \%konfig);
}
else
{
    zpracovat_hlasovani($databaze, \%konfig);
}



###############################################################################
# PODPROGRAMY
###############################################################################



#------------------------------------------------------------------------------
# Zobrazí hlasovací formulář.
#------------------------------------------------------------------------------
sub zobrazit_hlasovani
{
    my $databaze = shift;
    my $konfig = shift;
    mso::vypsat_stranku(
    {
        "nazev"  => "MSO: $konfig->{rok}: ".jazyky::zjistit("Hlasovani"),
        "nadpis" => jazyky::zjistit("hlasovani_nadpis", $konfig->{rok}),
        "telo"   => hlasovani($databaze, $konfig),
        "rok"    => $konfig->{rok}
    });
}



#------------------------------------------------------------------------------
# Vypíše hlasovací formulář.
#------------------------------------------------------------------------------
sub hlasovani
{
    my $databaze = shift;
    my $konfig = shift;
    my $stranka;
    # Přečíst tabulku akcí.
    my $akce = mso::nacist_akce($databaze, $konfig->{rok});
   # Vypsat formulář hlasování.
    my $parametry = dancgi::sestavit_parametry_odkaz($konfig, "telo=hlasovani.pl", "co=zpracuj");
    $stranka .= "<p>Vážení hráči, zde jste měli možnost hlasovat o turnajích podle Vaší preference do konce 10.8.2024. Hlasování je tedy ukončeno. Děkujeme všem 122 hráčům, kteří hlasovali a rozhodli takto: \n";

    $stranka .= "<h2>Výsledky hlasování o turnajích na Deskohraní 2024 </h2>\n";
    $stranka .= "<h3>Zařadíme tyto turnaje: </h3>\n";

    $stranka .= "<table>\n";
    $stranka .= "<b><tr><td><b>Hra</b></td><td><b>Počet bodů</b></td><td><b>Hlasovalo</b></td></tr>\n";
    $stranka .= "<tr><td><b><font color=green>Mars </font></b> </td><td> 80 </td><td> 36 </td></tr>\n";
    $stranka .= "<tr><td><b><font color=green>Azul </font></b></td><td> 54 </td><td> 28 </td></tr>\n";
    $stranka .= "<tr><td><b><font color=green>Dixit</font></b></td><td> 54 </td><td>25 </td></tr></b>\n";
    $stranka .= "<tr><td><b><font color=green>7 divů </font></b></td><td> 52 </td><td>28 </td></tr></b>\n";
    $stranka .= "<tr><td><b><font color=green>Na křídlech </font></b></td><td> 49 </td><td>22 </td></tr></b>\n";
    $stranka .= "<tr><td><b><font color=green>Kaskádie </font></b></td><td> 45 </td><td>26 </td></tr></b>\n";
    $stranka .= "<tr><td><b><font color=green>Příští stanice Londýn </font></b></td><td> 45 </td><td>21 </td></tr></b>\n";
    
    $stranka .= "</table>\n";

    $stranka .= "<h3>Z novinek zařadíme 3 nejlepší: </h3> \n";


    $stranka .= "<table>\n";
    $stranka .= "<b><tr><td><b>Hra</b></td><td><b>Počet bodů</b></td><td><b>Hlasovalo</b></td></tr>\n";
    $stranka .= "<tr><td><b><font color=green>Cirkus (Scout) </font></b> </td><td> 31 </td><td> 16 </td></tr>\n";
    $stranka .= "<tr><td><b><font color=green>Bílý hrad </font></b></td><td> 25 </td><td> 11 </td></tr>\n";
    $stranka .= "<tr><td><b><font color=green>Kutná Hora</font></b></td><td> 20 </td><td>10 </td></tr></b>\n";
 
    
    $stranka .= "</table>\n";



    my $parametry = dancgi::sestavit_parametry_odkaz($konfig, "telo=hlasovani.pl", "hra=pet", "turnaj=oly");

    return $stranka;
}



#==============================================================================
# Funkce pro zpracování vyplněného formuláře
#==============================================================================



#------------------------------------------------------------------------------
# Zkontroluje údaje z formuláře, uloží je do databáze, pošle je e-mailem
# organizátorům a uživateli vygeneruje odpověď.
#------------------------------------------------------------------------------
sub zpracovat_hlasovani
{
    my $databaze = shift;
    my $konfig = shift;
    # Údaje z formuláře jsou v hashi %{$konfig} pohromadě s případnými dalšími
    # parametry skriptu. Přidat mezi údaje datum a čas odeslání formuláře.
    $konfig->{casode} = cas::ted()->{rmdhms};
    # Zkontrolovat údaje.
    my $chyby = zkontrolovat_hlasovani($databaze, $konfig);
    # Pokud byla kontrola úspěšná, uložit údaje do databáze a odeslat je e-mailem organizátorům.
    unless(scalar(@{$chyby}))
    {
        ulozit_hlasovani_do_databaze($databaze, $konfig);
        odeslat_hlasovani_e_mailem($databaze, $konfig);
    }
    # Vygenerovat odpověď pro uživatele.
    zobrazit_potvrzovaci_stranku($databaze, $konfig, $chyby);
}



#------------------------------------------------------------------------------
# Zkontroluje údaje z formuláře a vrátí seznam chyb, které najde.
#------------------------------------------------------------------------------
sub zkontrolovat_hlasovani
{
    my $databaze = shift;
    my $konfig = shift;
    my @chyby;
    # Zkontrolovat platnost hlasovacího kódu.
    my $kod = $konfig->{kod_hlas} = $konfig->{hl_kod};
    # Kód se skládá z osmi číslic a je dělitelný jedenácti. První dvě číslice znamenají počet hlasů, který není vyšší než 10.
    my $kod_osoby;
    my $n_hlasu;
    my $kontrola;
    if($kod =~ m/^(\d\d)(\d\d\d\d)(\d\d)$/)
    {
        $konfig->{hlasu_celkem} = $n_hlasu = $1;
        $konfig->{kod_osoby} = $kod_osoby = $2;
        $kontrola = $3;
        if($n_hlasu > 10 || $kod % 11 != 0)
        {
            push(@chyby, 'chyba_neplatny_kod');
        }
        else
        {
            # Zjistit, zda už s tímto kódem někdo nehlasoval.
            my $drivejsi = mso::dotazat_se_databaze($databaze, 'kod_hlas', "hlasovani_2011 WHERE kod_osoby = '$kod_osoby'");
            if(scalar(@{$drivejsi}))
            {
                push(@chyby, 'chyba_pouzity_kod');
            }
        }
    }
    else
    {
        push(@chyby, 'chyba_neplatny_kod');
    }
    # Projít všechny parametry.
    # Jestliže jejich název jsou 4 písmena nebo číslice, první je 's' nebo 'n',
    # a jestliže hodnotou parametru je 0, 1, 2 nebo 3, považovat je za kód hry.
    my @stare_hry = grep {m/^s[a-z0-9]{3}$/ && $konfig->{$_} =~ m/^[0-3]$/} (keys(%{$konfig}));
    my @nove_hry = grep {m/^(n[a-z0-9]{3}|novinka[12])$/ && $konfig->{$_} =~ m/^[0-3]$/} (keys(%{$konfig}));
    $konfig->{stare} = \@stare_hry;
    $konfig->{nove} = \@nove_hry;
    # Zkontrolovat, že počet hlasů udělených starým hrám nepřekročil maximální počet hlasů, které má dotyčný uživatel k dispozici.
    my $soucet_stare = 0;
    foreach my $hra (@stare_hry)
    {
        $soucet_stare += $konfig->{$hra};
    }
    if($soucet_stare>$n_hlasu)
    {
        push(@chyby, 'chyba_moc_starych');
    }
    # Zkontrolovat, že počet hlasů udělených novým hrám nepřekročil maximální počet hlasů, které má dotyčný uživatel k dispozici.
    my $soucet_nove = 0;
    foreach my $hra (@nove_hry)
    {
        $soucet_nove += $konfig->{$hra};
    }
    if($soucet_nove>$n_hlasu)
    {
        push(@chyby, 'chyba_moc_novych');
    }
    # Jestliže novinka1 nebo novinka2 dostala hlas, nesmí zůstat prázdné pole s názvem hry.
    if($konfig->{novinka1}>0 && $konfig->{novinka1_nazev} =~ m/^\s*$/ ||
       $konfig->{novinka2}>0 && $konfig->{novinka2_nazev} =~ m/^\s*$/)
    {
        push(@chyby, 'chyba_prazdna_novinka');
    }
    # Zkontrolovat, že se dal hlas alespoň jedné hře.
    if($soucet_stare==0 && $soucet_nove==0)
    {
        push(@chyby, 'chyba_zadne_hlasy');
    }
    return \@chyby;
}



#------------------------------------------------------------------------------
# Uloží údaje z formuláře do databáze MySQL na serveru.
#------------------------------------------------------------------------------
sub ulozit_hlasovani_do_databaze
{
    my $databaze = shift;
    my $konfig = shift;
    my @nazvy = qw(kod_hlas kod_osoby hlasu_celkem kod_hry hlasu nazev_hry);
    my $seznam_poli = join(', ', @nazvy);
    foreach my $hra (@{$konfig->{stare}}, @{$konfig->{nove}})
    {
        next unless($konfig->{$hra}>0);
        my $kod_hry = $hra;
        $kod_hry =~ s/^[sn]// unless($kod_hry =~ m/^novinka/);
        # Řetězcové hodnoty musí být v apostrofech, číselné bez apostrofů.
        my @hodnoty =
        (
            "'$konfig->{kod_hlas}'",
            $konfig->{kod_osoby},
            $konfig->{hlasu_celkem},
            "'$kod_hry'",
            $konfig->{$hra}
        );
        if($hra =~ m/^novinka\d$/)
        {
            my $nazev = $konfig->{$hra.'_nazev'};
            push(@hodnoty, "'$nazev'");
        }
        else
        {
            push(@hodnoty, "''");
        }
        # The MySQL driver must get the data as a sequence of bytes, not of varying-width characters.
        my $seznam_hodnot = encode('utf8', join(', ', @hodnoty));
        my $dotaz = "INSERT INTO hlasovani_2011 ($seznam_poli) VALUES ($seznam_hodnot);";
        $databaze->do($dotaz);
    }
}



#------------------------------------------------------------------------------
# Odešle údaje z formuláře e-mailem organizátorům.
#------------------------------------------------------------------------------
sub odeslat_hlasovani_e_mailem
{
    my $databaze = shift;
    my $konfig = shift;
    my $sendmail;
    if(-e "/usr/lib/sendmail")
    {
        $sendmail = "|/usr/lib/sendmail -oi -t";
    }
    else
    {
        $sendmail = ">posledni-prihlaska.txt";
    }
    my $adresat = "klara\@hrejsi.cz, zeman\@ufal.mff.cuni.cz";
    my $mail;
    $mail .= "From: Robot Hrejsi <robot\@hrejsi.cz>\n";
    $mail .= "To: $adresat\n";
    $mail .= "Subject: MSO hlasovani\n";
    $mail .= "Content-Type: text/plain; charset=\"utf-8\"\n";
    $mail .= "Content-Transfer-Encoding: 8bit\n\n";
    # Sestavit tělo zprávy.
    $mail .= "kod = $konfig->{kod_hlas}\n";
    my @hry = grep {$konfig->{$_}>0} (@{$konfig->{stare}}, @{$konfig->{nove}});
    $mail .= join(', ', map {"$_=$konfig->{$_}"} (sort(@hry)))."\n\n";
    $mail .= "novinka1_nazev=$konfig->{novinka1_nazev}\n";
    $mail .= "novinka2_nazev=$konfig->{novinka2_nazev}\n";
    # Odeslat zprávu organizátorům.
    open(SENDMAIL, $sendmail) or print "Nemůžu najít sendmail: $!\n";
    print SENDMAIL ($mail);
    close(SENDMAIL);
    open(KOPIE, ">posledni_hlasovani.txt");
    print KOPIE ($mail);
    close(KOPIE);
    open(KOPIE, ">>archiv_hlasovani.txt");
    print KOPIE ("----------------------------------------------------------------------\n");
    print KOPIE ($mail);
    close(KOPIE);
}



#------------------------------------------------------------------------------
# Vygeneruje pro uživatele stránku se zprávou o úspěchu či neúspěchu jím
# odeslaného formuláře.
#------------------------------------------------------------------------------
sub zobrazit_potvrzovaci_stranku
{
    my $databaze = shift;
    my $konfig = shift;
    my $chyby = shift;
    my $nadpis;
    my $stranka;
    ###!!! Texty na potvrzovací stránce jsou zavádějící, protože se vztahují k přihlášce a ne k hlasování.
    ###!!! Teď se mi nechce ještě zadávat nové texty do jazyky.pm.
    # Pokud byly v přihlášce nalezeny chyby, upozornit uživatele, že přihláška nebyla přijata.
    if(scalar(@{$chyby}))
    {
        $nadpis = jazyky::zjistit("hlasovani_nadpis_chyba");
        $stranka .= "<h3>".jazyky::zjistit("hlasovani_nadpis2_chyba")."</h3>\n";
        $stranka .= "<ul>\n";
        foreach my $chyba (@{$chyby})
        {
            # Zatím rychlé řešení: vypíšeme jen kód chyby místo jejího podrobnějšího vysvětlení.
            $stranka .= "  <li>$chyba</li>\n";
            #$stranka .= "  <li>".jazyky::zjistit($chyba)."</li>\n";
        }
        $stranka .= "</ul>\n";
    }
    # Pokud byla přihláška bez chyb, ukázat uživateli přehled údajů a oznámit mu, že přihláška byla přijata.
    else
    {
        $nadpis = jazyky::zjistit("hlasovani_potvrzeni");
        $stranka .= jazyky::zjistit("hlasovani_potvrzeni_nadpis");
    }
    # Obalit stránku jednotným záhlavím a zápatím a poslat ji na výstup.
    mso::vypsat_stranku(
    {
        "nazev"  => "MSO: $konfig->{rok}: ".jazyky::zjistit("Hlasovani"),
        "nadpis" => $nadpis,
        "telo"   => $stranka,
        "rok"    => $konfig->{rok}
    });
}
