#!/usr/bin/perl
# Vypíše prezenční listinu turnaje.
# Copyright © 2006-2013 Dan Zeman <zeman@ufal.mff.cuni.cz>
# Licence: GNU GPL

use utf8; # říct Perlu, že konstantní řetězce ve zdrojáku jsou v UTF
use DBI; # spolupráce se serverem MySQL
use lib '/s/w/lib/dan'; # uživatel apache nemá Danovo prostředí a knihovny by nenašel
use csort; # české a anglické abecední řazení UTF znaků
use dancgi; # čtení parametrů z webu nebo z ARGV
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();

# Výchozí nastavení parametru. Muže být pořbito parametry z URL/ARGV.
mso::provest_vychozi_nastaveni_parametru(\%konfig, $databaze);
# 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 prihlaseni.pl akce=caroly).
dancgi::rozebrat_parametry($ARGV[0], \%konfig);
# Přímo tenhle skript sice není lokalizovaný, ale když nenastavíme jazyk, nebude fungovat mso::nacist_akce()!
if($konfig{jazyk} eq '')
{
    $konfig{jazyk} = 'cs';
}
$jazyky::jazyk = $konfig{jazyk};



# Poslat MIME záhlaví dokumentu.
print("Content-Type: text/html; charset=utf-8\n\n");
# Vypsat seznam akcí nebo prezenční listinu na vybranou akci.
if($konfig{rok} && $konfig{hra} && $konfig{turnaj})
{
    vypsat_prezencku($konfig{rok}, $konfig{hra}, $konfig{turnaj});
}
else
{
    vypsat_seznam($konfig{rok});
}



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



#------------------------------------------------------------------------------
# Vypíše seznam všech akcí v letošním roce.
#------------------------------------------------------------------------------
sub vypsat_seznam
{
    my $rok = shift;
    # Poslat začátek stránky.
    print <<EOF
<html>
  <head>
    <meta http-equiv="Content-Language" content="cs">
    <meta http-equiv="Content-Type" content="text/html; charset=utf-8">
    <title>Přehled akcí (odkazy na prezenční listiny)</title>
  </head>
  <body>
  [ <a href="osoby.pl">Seznam osob</a> | <a href="../prihlaska.pl">Přihláška</a> ]
  <h1>Přehled prezenčních listin</h1>

EOF
    ;
    print("  <ol>\n");
    # Načíst z databáze seznam akcí.
    my $akce = mso::nacist_akce($databaze, $rok);
    my @akce = sort
    {
        my $vysledek = $a->{_nazev_hry_tridici} cmp $b->{_nazev_hry_tridici};
        unless($vysledek)
        {
            $vysledek = $a->{_nazev_akce_tridici} cmp $b->{_nazev_akce_tridici};
        }
        return $vysledek;
    }
    (@{$akce});
    foreach my $a (@akce)
    {
        print("    <li>$a->{_nazev_hry}: <a href=\"prezencka.pl?rok=$a->{rok}&amp;hra=$a->{kod_hry}&amp;turnaj=$a->{kod_turnaje}\">$a->{nazev}</a></li>\n");
    }
    # Poslat konec stránky.
    print <<EOF
  </ol>
  </body>
</html>
EOF
    ;
}



#------------------------------------------------------------------------------
# Vypíše prezenčku na konkrétní akci.
#------------------------------------------------------------------------------
sub vypsat_prezencku
{
    my $rok = shift;
    my $hra = shift;
    my $turnaj = shift;
    # Poslat začátek stránky.
    print <<EOF
<html>
  <head>
    <meta http-equiv="Content-Language" content="cs">
    <meta http-equiv="Content-Type" content="text/html; charset=utf-8">
    <title>Prezenční listina: $rok $hra $turnaj</title>
  </head>
  <body>
  [ <a href="osoby.pl">Seznam osob</a> | <a href="../prihlaska.pl">Přihláška</a> | <a href="prezencka.pl">Prezenční listiny</a> ]
  Vyplňte prosím dotazník na <a href="http://www.dotaznik.deskohrani.cz/">http://www.dotaznik.deskohrani.cz/</a>.
EOF
    ;
    my $prihlasene_osoby = zjistit_osoby_prihlasene_na_akci($databaze, $rok, $hra, $turnaj);
    # Seřadit přihlášky podle příjmení a jména hráčů.
    foreach my $jmeno (keys(%{$prihlasene_osoby}))
    {
        my $prihlaska = $prihlasene_osoby->{$jmeno};
        $prihlaska->{_trid} = csort::zjistit_tridici_hodnoty($prihlaska->{prijmeni}.$prihlaska->{jmeno}, 'cs');
    }
    my @setridene_prihlasky = sort{$prihlasene_osoby->{$a}{_trid} cmp $prihlasene_osoby->{$b}{_trid}}(keys(%{$prihlasene_osoby}));
    # Zjistit podrobnosti o akci.
    my $akce = mso::dotazat_se_databaze($databaze, 'nazev', 'zacatek', 'konec', 'startovne', 'startovne_2', 'startovne_3', 'plus_vstup', "akce WHERE (rok = '$rok') AND (kod_hry = '$hra') AND (kod_turnaje = '$turnaj')")->[0];
    # Umazat z času začátku vteřiny.
    $akce->{zacatek} =~ s/(\s+\d+:\d+):\d+.*$/$1/;
    $akce->{konec} =~ s/(\s+\d+:\d+):\d+.*$/$1/;
    my $datum_zacatku;
    if($akce->{zacatek} =~ m/^(\d+\.\d+\.\d+)/)
    {
        $datum_zacatku = $1;
    }
    $akce->{konec} =~ s/^$datum_zacatku\s+//;
    # Vypsat přehled výše startovného na tento turnaj a vstupného na daný den (u vícedenních turnajů na první den).
    my $den;
    if($akce->{zacatek} =~ m/^(\d+)\./)
    {
        $den = $1;
    }
    my $lkod = sprintf('l%02d', $den);
    my $lakce = mso::dotazat_se_databaze($databaze, 'startovne', 'startovne_2', 'startovne_3', "akce WHERE (rok = '$rok') AND (kod_hry = 'lud') AND (kod_turnaje = '$lkod')")->[0];
    foreach my $polozka ('startovne', 'startovne_2', 'startovne_3')
    {
        if($akce->{polozka} !~ m/\d/)
        {
            $akce->{polozka} = 0;
        }
        if($lakce->{polozka} !~ m/\d/)
        {
            $lakce->{polozka} = 0;
        }
    }
    print("Startovné $akce->{startovne}/$akce->{startovne_2}/$akce->{startovne_3}");
    if($akce->{plus_vstup})
    {
        print(" + vstup $lakce->{startovne}/$lakce->{startovne_2}/$lakce->{startovne_3}");
        my ($c1, $c2, $c3) = ($akce->{startovne}+$lakce->{startovne}, $akce->{startovne_2}+$lakce->{startovne_2}, $akce->{startovne_3}+$lakce->{startovne_3});
        print(" = <b>$c1/$c2/$c3.</b>");
    }
    else
    {
        print(". Vstup není započítán.");
    }
    print("\n");
    ###!!!
    my $x;
#    for(my $i = 9771; $i<=10017; $i++)
#    {
#        $x .= sprintf("%X\t%d\t%s<br/>\n", $i, $i, chr($i));
#    }
    print("  <h1>Prezenční listina na $akce->{nazev} $akce->{zacatek} &ndash; $akce->{konec}</h1> $x\n"); ###!!!
    print("  <table cellpadding=\"4\" border=\"1\" bordercolor=black style='border-collapse:collapse;empty-cells:show'>\n");
    print("    <tr><th>Č.</th><th>Jméno</th><th>Obec</th><th>Země</th><th>E-mail</th><th>Kategorie</th><th colspan=\"2\">Datum a čas přihlášky</th><th>Má dáti</th><th>Dal</th><th>Způsob placení</th><th>Podpis</th></tr>\n");
    # Přidat na konec pár prázdných řádků pro osoby přihlášené na místě.
    for(my $i = 0; $i<=$#setridene_prihlasky+5; $i++)
    {
        my $prihlaska = $prihlasene_osoby->{$setridene_prihlasky[$i]};
        my $email = $prihlaska->{e_mail};
        $email = '&nbsp;' if($email eq ''); # kvůli vnitřnímu orámování buňky
        my $kategorie = $prihlaska->{kategorie};
        $kategorie = 'dospělý' if($kategorie eq 'normální');
        $kategorie = 'studuch' if($kategorie eq 'student, důchodce');
        # Údaje o členství v organizacích seskupit do jedné buňky.
        my @clenstvi = map
        {
            if($_ eq 'clen_paluba') { $_ = 'Paluba' }
            elsif($_ eq 'clen_scrabble') { $_ = 'ČAS' }
            elsif($_ eq 'clen_dama') { $_ = 'ČFD' }
            elsif($_ eq 'clen_dama2') { $_ = 'ČUD' }
            elsif($_ eq 'clen_go') { $_ = 'ČAGo' }
            elsif($_ eq 'clen_othello') { $_ = 'ČFO' }
            elsif($_ eq 'clen_hadanka') { $_ = 'SČHaK' }
        }
        (grep{m/^clen_/ && $prihlaska->{$_}}(keys(%{$prihlaska})));
        my $clenstvi;
        if(scalar(@clenstvi))
        {
            $clenstvi = " člen ".join(', ', @clenstvi);
        }
        my $datum = $prihlaska->{datum_prihlasky};
        my $cas;
        if($datum =~ m/^(\d+\.\d+\.\d+)(?:\s+(\d+:\d+:\d+))?$/)
        {
            $datum = $1;
            $cas = $2;
        }
        # Pokud zaplatil včas předem převodem, snížit částku "má dáti" o slevu 20 %.
        my $ma_dati = $prihlaska->{ma_dati};
        my $vcasne_prihlasky_do = mso::zjistit_datum_vcasneho_prihlaseni($databaze, $rok);
        if($prihlaska->{dal} == 0.8 * $prihlaska->{ma_dati} && $prihlaska->{zpusob_placeni} =~ m/^převodem (\d+)-(\d+)-(\d+)$/)
        {
            my $zaplatil_rok = $1;
            my $zaplatil_mesic = $2;
            my $zaplatil_den = $3;
            my $zaplatil = sprintf('%04d%02d%02d', $zaplatil_rok, $zaplatil_mesic, $zaplatil_den);
            $vcasne_prihlasky_do =~ m/(\d+)\.(\d+)\.(\d+)/;
            my $termin_den = $1;
            my $termin_mesic = $2;
            my $termin_rok = $3;
            my $termin = sprintf('%04d%02d%02d', $termin_rok, $termin_mesic, $termin_den);
            if($zaplatil<=$termin)
            {
                $ma_dati *= 0.8;
            }
        }
        # Pokud zatím nic nezaplatil, nepsat nulu, nechat prázdné políčko, aby se do něj dalo psát ručně.
        # Leda pokud víme, že má platit nulu (slevy, organizátoři), vyplnit nulu i do políčka dal.
        my $dal;
        if($prihlaska->{dal})
        {
            $dal = "$prihlaska->{dal}&nbsp;Kč";
            if($prihlaska->{dal}>=$ma_dati)
            {
                $dal .= '&nbsp;'.chr(10004); # zaškrtnutí
            }
            else
            {
                $dal .= '&nbsp;'.chr(9756); # ruka ukazující doleva
            }
        }
        elsif($prihlaska->{ma_dati} eq '0')
        {
            $dal = '0&nbsp;Kč&nbsp;'.chr(10004); # zaškrtnutí
        }
        else
        {
            $dal = '&nbsp;';
        }
        print("    <tr><td align=right>", $i+1, ". </td><td>$prihlaska->{cele_jmeno}</td><td>$prihlaska->{obec}</td><td>$prihlaska->{zeme}</td><td>$email</td><td>$kategorie$clenstvi</td><td align=right>$datum </td><td align=right>$cas</td><td align=right>$ma_dati&nbsp;Kč</td><td align=right>$dal</td><td>$prihlaska->{zpusob_placeni}</td><td>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;</td></tr>\n");
    }
    print("  </table>\n");
    # Poslat konec stránky.
    print <<EOF
  </body>
</html>
EOF
    ;
}



#------------------------------------------------------------------------------
# Získá údaje o osobách přihlášených na konkrétní akci ze všech tří tabulek
# (prihlasky, tj. ty, co už prošly Accessem; prihlasky_zmeny, tj. změny
# provedené přes toto webové rozhraní; a konečně prihlasky_auto, tj. nové
# přihlášky přes web; ty ještě nemají kód osoby).
#------------------------------------------------------------------------------
sub zjistit_osoby_prihlasene_na_akci
{
    my $databaze = shift;
    my $rok = shift;
    my $hra = shift; # kód hry
    my $turnaj = shift; # kód akce
    # Načíst osoby vyexportované z Klářina Accessu.
    my @nazvy = qw(kod jmeno prijmeni obec zeme e_mail kategorie clen_paluba clen_scrabble clen_dama clen_dama2 clen_go clen_othello clen_hadanka);
    my $osoby0 = mso::dotazat_se_databaze($databaze, @nazvy, 'osoby');
    # Přeskládat osoby, aby k nim bylo možné přistupovat přes kód.
    my @osoby;
    foreach my $osoba (@{$osoby0})
    {
        $osoby[$osoba->{kod}] = $osoba;
    }
    # Načíst změny osob provedené přes webové rozhraní.
    my $osoby1 = mso::dotazat_se_databaze($databaze, @nazvy, 'osoby_zmeny');
    # Přepsat v poli indexovaném kódy změněné osoby.
    foreach my $osoba (@{$osoby1})
    {
        $osoby[$osoba->{kod}] = $osoba;
    }
    # Načíst přihlášky vyexportované z Klářina Accessu.
    @nazvy = qw(rok kod_hry kod_turnaje kod_osoby datum_prihlasky ma_dati dal zpusob_placeni);
    my $filtr = "WHERE (rok = '$rok') AND (kod_hry = '$hra') AND (kod_turnaje = '$turnaj')";
    my $prihlasky0 = mso::dotazat_se_databaze($databaze, @nazvy, "prihlasky $filtr");
    # Nahashovat přihlášky podle jména osoby (případní jmenovci se ztratí, ale je to velmi nepravděpodobné a oni to pochopí).
    # Stejně budeme muset nakonec přidat nezpracované přihlášky osob, které nemají kódy, a nebudeme vědět, jestli jde
    # o duplikáty přihlášek, nebo o jmenovce.
    my %prihlasene_osoby;
    foreach my $prihlaska (@{$prihlasky0})
    {
        zkopirovat_osobu_do_prihlasky($prihlaska, \@osoby);
        $prihlasene_osoby{$prihlaska->{cele_jmeno}} = $prihlaska;
    }
    # Načíst přihlášky přidané do MySQL prostřednictvím webového rozhraní. Můžou tam být i odhlášení.
    @nazvy = ('rok', 'kod_hry', 'kod_turnaje', 'kod_osoby', 'datum_zmeny AS datum_prihlasky', 'odhlasit', 'ma_dati', 'dal', 'zpusob_placeni');
    my $prihlasky1 = mso::dotazat_se_databaze($databaze, @nazvy, "prihlasky_zmeny $filtr");
    # Přidat nové přihlášky do hashe a odstranit z něj osoby, které se zase odhlásily.
    foreach my $prihlaska (@{$prihlasky1})
    {
        zkopirovat_osobu_do_prihlasky($prihlaska, \@osoby);
        if($prihlaska->{odhlasit})
        {
            delete($prihlasene_osoby{$prihlaska->{cele_jmeno}});
        }
        else
        {
            $prihlasene_osoby{$prihlaska->{cele_jmeno}} = $prihlaska;
        }
    }
    # Načíst přihlášky uložené do MySQL přihlašovacím skriptem. Musíme je načíst rovnou i s osobami, protože tyto osoby nemusí mít kód.
    @nazvy = ('rok', 'kod_hry', 'kod_turnaje', 'prihlasky.datum_prihlasky AS datum_prihlasky',
              'jmeno', 'prijmeni', 'obec', 'zeme', 'email AS e_mail', 'kategorie',
              'clenpaluba AS clen_paluba', 'clenscrabble AS clen_scrabble', 'clendama AS clen_dama', 'clendama2 AS clen_dama2', 'clengo AS clen_go',
              'clenothello AS clen_othello', 'clenzatre AS clen_zatre', 'clenhadanka AS clen_hadanka',
              'ma_dati', 'dal', 'zpusob_placeni');
    my $tabulky = "prihlasky_auto AS prihlasky INNER JOIN osoby_auto ON prihlasky.datum_prihlasky = osoby_auto.datum_prihlasky";
    my $prihlasky2 = mso::dotazat_se_databaze($databaze, @nazvy, "$tabulky $filtr");
    # Přidat nové přihlášky do hashe. Případné duplikáty se přepíšou jeden druhým.
    foreach my $prihlaska (@{$prihlasky2})
    {
        $prihlaska->{cele_jmeno} = join(' ', ($prihlaska->{jmeno}, $prihlaska->{prijmeni}));
        # Jestliže osoba nezaplatila převodem, položky "dal" a "zpusob_placeni" v prihlasky_auto jsou prázdné.
        # Jestliže zaplatila v infu, mohou být tyto položky neprázdné v prihlasky_zmeny.
        # Než tedy přepíšeme případný existující záznam o přihlášce, musíme tyto údaje zachránit.
        # Předpokládáme, že buď jsou vyplněné obě položky, nebo žádná. Kombinovat "dal" z jednoho zdroje a "zpusob_placeni" ze druhého nedává smysl.
        if(exists($prihlasene_osoby{$prihlaska->{cele_jmeno}}) &&
           ($prihlasene_osoby{$prihlaska->{cele_jmeno}}{dal} ne '' || $prihlasene_osoby{$prihlaska->{cele_jmeno}}{zpusob_placeni} ne '') &&
           ($prihlaska->{dal} eq '' || $prihlaska->{zpusob_placeni} eq ''))
        {
            $prihlaska->{dal} = $prihlasene_osoby{$prihlaska->{cele_jmeno}}{dal};
            $prihlaska->{zpusob_placeni} = $prihlasene_osoby{$prihlaska->{cele_jmeno}}{zpusob_placeni};
        }
        $prihlasene_osoby{$prihlaska->{cele_jmeno}} = $prihlaska;
    }
    return \%prihlasene_osoby;
}



#------------------------------------------------------------------------------
# Zkopíruje informace o osobě přímo k přihlášce, aby byly při vypisování po
# ruce. Předpokládá, že přihláška už obsahuje kód osoby, nemůže jít tedy o
# prvotní přihlášku z webu, která ještě není propojena s databází osob jinak
# než jménem.
#------------------------------------------------------------------------------
sub zkopirovat_osobu_do_prihlasky
{
    my $prihlaska = shift;
    my $osoby = shift; # odkaz na pole záznamů o osobách
    my $osoba = $osoby->[$prihlaska->{kod_osoby}];
    foreach my $atribut (qw(jmeno prijmeni obec zeme e_mail kategorie clen_paluba clen_scrabble clen_dama clen_dama2 clen_go clen_othello clen_hadanka))
    {
        $prihlaska->{$atribut} = $osoba->{$atribut};
    }
    $prihlaska->{cele_jmeno} = join(' ', ($prihlaska->{jmeno}, $prihlaska->{prijmeni}));
}
