#!/usr/bin/perl
# Umožní vyhledat osobu, zobrazí informace o ní a umožní je změnit a uložit do databáze.
# Copyright © 2006, 2011 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 Encode; # knihovna pro překódování ne-ASCII znaků
use DBI; # spolupráce se serverem MySQL
use lib '/s/w/lib/dan';
use lib '/s/w/lib/cgi/mso';
use lib '/s/w/lib/cgi/mso/vnitro';
use dancgi; # čtení parametrů z webu nebo z ARGV
use dzsql; # sestavování a provádění dotazů SQL
use csort; # české a anglické abecední řazení UTF znaků
use mso; # funkce pro generování stránek o olympiádě
binmode(STDOUT, ':utf8'); # říct Perlu, že UTF chceme i na výstupu
binmode(STDERR, ':utf8');

# 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);
if($konfig{jazyk} eq "")
{
    $konfig{jazyk} = "cs";
}
$jazyky::jazyk = $konfig{jazyk};



# Vypsat seznam osob nebo vybranou osobu.
# Osoby identifikujeme dvojím způsobem:
# Osoby z databáze (mohou a nemusí být letos přihlášeny) identifikujeme databázovým kódem osoby.
# Osoby z přihlášek (mohou a nemusí mít také starší záznam v databázi) identifikujeme variabilním symbolem přihlášky.
if(exists($konfig{ulozit}))
{
    if($konfig{vs})
    {
        ulozit_osobu_vs(\%konfig);
    }
    else
    {
        ulozit_osobu(\%konfig);
    }
}
elsif($konfig{osoba})
{
    vypsat_osobu($konfig{osoba}, $konfig{rok});
}
elsif($konfig{vs})
{
    vypsat_osobu_vs($konfig{vs}, $konfig{rok});
}
else
{
    vypsat_seznam();
}



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



#------------------------------------------------------------------------------
# Vypíše seznam všech osob.
#------------------------------------------------------------------------------
sub vypsat_seznam
{
    vypsat_zahlavi("Databáze osob a přihlášek");
    # Poslat začátek stránky.
    print <<EOF
  [ <a href="../prihlaska.pl">Přihláška</a> | <a href="prezencka.pl">Prezenční listiny</a> ]
  <h1>Přehled osob</h1>
  <p>Tento seznam zatím neumožňuje měnit osoby, které se nově přihlásily na webu a nebyly ještě trvale uloženy do databáze.</p>
  <p>Kliknutím na jméno osoby zobrazíte její údaje a budete je moci měnit.</p>
EOF
    ;
    # Vypsat abecedu s rychlými odkazy na příslušné místo v seznamu.
    print("  <p>");
    print(join(" | ", map{"<a href=\"\#$_\">$_</a>"}(qw(A B C Č D E F G H Ch I J K L M N O P Q R Ř S Š T U V W X Y Z Ž))));
    print("  </p>\n");
    print("  <ol>\n");
    # Načíst z databáze seznam osob.
    my $osoby = mso::dotazat_se_databaze($databaze, "kod", "jmeno", "prijmeni", "osoby ORDER BY prijmeni, jmeno");
    # Načíst nově přihlášené osoby, které zatím nemají kód v databázi.
    my @nazvy = ("osoby_auto.jmeno AS jmeno", "osoby_auto.prijmeni AS prijmeni", "vs");
    my $tabulky = "osoby_auto LEFT JOIN osoby ON (osoby_auto.jmeno = osoby.jmeno) AND (osoby_auto.prijmeni = osoby.prijmeni)";
    my $filtr = "WHERE osoby.kod IS NULL";
    my $nove_osoby = mso::dotazat_se_databaze($databaze, @nazvy, "$tabulky $filtr");
    # Přidat nové osoby do hlavního seznamu osob, a ten znova seřadit.
    push(@{$osoby}, @{$nove_osoby});
    map{$_->{_trid} = csort::zjistit_tridici_hodnoty($_->{prijmeni}.$_->{jmeno}, 'cs')}(@{$osoby});
    @{$osoby} = sort{$a->{_trid} cmp $b->{_trid}}(@{$osoby});
    my $posledni_pismeno;
    foreach my $osoba (@{$osoby})
    {
        # Zapamatovat si počáteční písmeno, u nového počátečního písmene udělat záložku.
        my $pismeno = substr($osoba->{prijmeni}, 0, 2) eq "Ch" ? "Ch" : substr($osoba->{prijmeni}, 0, 1);
        my $kotva = $pismeno ne $posledni_pismeno ? " name=\"$pismeno\"" : "";
        # Na bezejmenné osoby by se nedalo kliknout.
        if($osoba->{jmeno} =~ m/^\s*$/ && $osoba->{prijmeni} =~ m/^\s*$/)
        {
            $osoba->{jmeno} = "&lt;BEZEJMENNÝ&gt;";
        }
        if($osoba->{kod})
        {
            print("    <li><a$kotva href=\"osoby.pl?osoba=$osoba->{kod}\">$osoba->{jmeno} $osoba->{prijmeni}</a></li>\n");
        }
        else
        {
            print("    <li><a$kotva href=\"osoby.pl?vs=$osoba->{vs}\">$osoba->{jmeno} $osoba->{prijmeni}</a></li>\n");
        }
        $posledni_pismeno = $pismeno;
    }
    # Poslat konec stránky.
    print <<EOF
  </ol>
  </body>
</html>
EOF
    ;
}



#------------------------------------------------------------------------------
# Vypíše údaje jedné osoby.
#------------------------------------------------------------------------------
sub vypsat_osobu
{
    my $kod = shift;
    my $rok = shift;
    # Načíst údaje o osobě z databáze.
    # Nejdřív hledat v tabulce změn, teprve když tam nic není, podívat se do hlavní tabulky.
    my $osoby = mso::dotazat_se_databaze($databaze, "kod", "jmeno", "prijmeni", "obec", "zeme", "pohlavi", "kategorie", "clen_paluba", "clen_scrabble", "clen_dama", "clen_dama2", "clen_go", "clen_othello", "clen_zatre", "clen_hadanka", "e_mail", "osoby_zmeny WHERE kod = $kod");
    my $osoba_byla_zmenena = 1;
    unless(scalar(@{$osoby}))
    {
        $osoba_byla_zmenena = 0;
        # V exportu od Kláry zatím chybí pole clen_dama2, proto ho z dotazu musíme vynechat!
        $osoby = mso::dotazat_se_databaze($databaze, "kod", "jmeno", "prijmeni", "obec", "zeme", "pohlavi", "kategorie", "clen_paluba", "clen_scrabble", "clen_dama", "clen_go", "clen_othello", "clen_zatre", "clen_hadanka", "e_mail", "osoby WHERE kod = '$kod'");
    }
    my $osoba = $osoby->[0];
    # Načíst údaje o přihláškách dané osoby z databáze.
    my $akce = zjistit_akce_rok_osoba($databaze, $rok, $osoba, 'ARRAY');
    vypsat_formular($osoba, $rok, $akce, $osoba_byla_zmenena || $osoba->{zmena} ? 1 : 0);
}



#------------------------------------------------------------------------------
# Vypíše údaje nově přihlášené osoby.
#------------------------------------------------------------------------------
sub vypsat_osobu_vs
{
    my $vs = shift;
    my $rok = shift;
    # Načíst údaje o osobě z databáze.
    my $osoba = mso::dotazat_se_databaze($databaze, "datum_prihlasky", "vs", "jmeno", "prijmeni", "obec", "zeme", "pohlavi", "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", "email AS e_mail", "osoby_auto WHERE vs = '$vs'")->[0];
    # Načíst údaje o přihláškách dané osoby z databáze.
    # Nejdřív načíst seznam všech letošních akcí (kvůli názvu hry a akce a kvůli tomu, že později stejně budeme vypisovat i ty nepřihlášené).
    my $akce = mso::nacist_akce($databaze, $rok);
    # Nahashovat si odkazy na akce.
    my %akce;
    foreach my $a (@{$akce})
    {
        $akce{$a->{kod_hry}}{$a->{kod_turnaje}} = $a;
    }
    # Načíst přihlášky z tabulky prihlasky_auto.
    @nazvy = ("kod_hry", "kod_turnaje", "prihlasky_auto.datum_prihlasky AS datum_prihlasky", "ma_dati", "dal", "zpusob_placeni");
    $prihlasky = mso::dotazat_se_databaze($databaze, @nazvy, "prihlasky_auto INNER JOIN osoby_auto ON prihlasky_auto.datum_prihlasky = osoby_auto.datum_prihlasky WHERE (jmeno = '$osoba->{jmeno}') AND (prijmeni = '$osoba->{prijmeni}')");
    # Přepsat si přihlášky přímo k akcím.
    foreach my $prihlaska (@{$prihlasky})
    {
        my $a = $akce{$prihlaska->{kod_hry}}{$prihlaska->{kod_turnaje}};
        $a->{prihlasen} = 1;
        foreach my $atribut (qw(datum_prihlasky ma_dati dal zpusob_placeni))
        {
            $a->{$atribut} = $prihlaska->{$atribut};
        }
    }
    vypsat_formular($osoba, $rok, $akce, 2);
}



#------------------------------------------------------------------------------
# Vypíše formulář s předvyplněnými údaji o osobě.
#------------------------------------------------------------------------------
sub vypsat_formular
{
    my $osoba = shift; # odkaz na hash
    my $rok = shift;
    my $akce = shift; # odkaz na pole akcí (k akcím, na které se osoba přihlásila, je to připsáno)
    my $zmena = shift;
    vypsat_zahlavi("Databáze: $osoba->{jmeno} $osoba->{prijmeni}");
    my $hlaseni_o_zmene;
    if($zmena==0)
    {
        $hlaseni_o_zmene = "Záznam o této osobě <b>se neliší</b> od posledního exportu z&nbsp;Klářiny databáze.";
    }
    elsif($zmena==1)
    {
        $hlaseni_o_zmene = "Záznam o této osobě <b>se liší</b> od posledního exportu z&nbsp;Klářiny databáze.";
    }
    elsif($zmena==2)
    {
        $hlaseni_o_zmene = "Toto je <b>nově přihlášená osoba,</b> kterou Klára zatím nemá v&nbsp;databázi.";
    }
    # Poslat začátek stránky.
    print <<EOF
  [ <a href="osoby.pl">Seznam osob</a> | <a href="../prihlaska.pl">Přihláška</a> | <a href="prezencka.pl">Prezenční listiny</a> ]
  <form method=get action="osoby.pl">
  <h1>$osoba->{jmeno} $osoba->{prijmeni}</h1>
  <p>$hlaseni_o_zmene Provedete-li v&nbsp;údajích jakékoli změny, nezapomeňte pak stisknout tlačítko <a href="\#ulozit">Uložit</a>, jinak se změny ztratí!</p>
  <table>
EOF
    ;
    if($osoba->{kod})
    {
        print("    <tr><td align=right>kód:</td><td>$osoba->{kod}<input type=hidden name=kod value=\"$osoba->{kod}\"></td></tr>\n");
    }
    if($osoba->{vs})
    {
        print("    <tr><td align=right>vs:</td><td>$osoba->{vs}<input type=hidden name=vs value=\"$osoba->{vs}\"></td></tr>\n");
    }
    print("    <tr><td align=right>jméno:</td><td><input type=text name=jmeno value=\"$osoba->{jmeno}\"></td></tr>\n");
    print("    <tr><td align=right>příjmení:</td><td><input type=text name=prijmeni value=\"$osoba->{prijmeni}\"></td></tr>\n");
    print("    <tr><td align=right>obec:</td><td><input type=text name=obec value=\"$osoba->{obec}\"></td></tr>\n");
    print("    <tr><td align=right>země:</td>\n");
    print("      <td>\n");
    print("        <select name=zeme>\n");
    # Sestavit seznam zemí na výběr.
    my $pole_zemi = mso::dotazat_se_databaze($databaze, "kod", "nazev", "zeme");
    # Seřadit země podle abecedy.
    foreach my $z (@{$pole_zemi})
    {
        $z->{trid} = csort::zjistit_tridici_hodnoty($z->{nazev}, "cs");
    }
    @{$pole_zemi} = sort{$a->{trid} cmp $b->{trid}}(@{$pole_zemi});
    # Zařídit, aby byla vybrána země, kterou má dotyčná osoba momentálně uvedenou v databázi.
    my @options = map
    {
        my $sel = $_->{kod} eq $osoba->{zeme} ? " selected" : "";
        "          <option$sel value=$_->{kod}>$_->{nazev}</option>\n";
    }
    (@{$pole_zemi});
    print(join("", @options));
    print("        </select>\n");
    print("      </td>\n");
    print("    </tr>\n");
    print("    <tr><td align=right>pohlaví:</td>\n");
    print("      <td>\n");
    print("        <select name=pohlavi>\n");
    foreach my $pohlavi ("muž", "žena")
    {
        my $sel = $pohlavi eq $osoba->{pohlavi} ? " selected" : "";
        print("          <option$sel value=\"$pohlavi\">$pohlavi</option>\n");
    }
    print("        </select>\n");
    print("      </td>\n");
    print("    </tr>\n");
    print("    <tr><td align=right>kategorie:</td>\n");
    print("      <td>\n");
    print("        <select name=kategorie>\n");
    foreach my $kategorie ("normální", "student, důchodce", "dítě")
    {
        my $sel = $kategorie eq $osoba->{kategorie} ? " selected" : "";
        print("          <option$sel value=\"$kategorie\">$kategorie</option>\n");
    }
    print("        </select>\n");
    print("      </td>\n");
    print("    </tr>\n");
    print("    <tr><td align=right>členství:</td>\n");
    print("      <td>\n");
    my %organizace =
    (
        "paluba" => "Paluba",
        "scrabble" => "ČAS",
        "dama" => "ČFD",
        "dama2" => "ČUD",
        "go" => "ČAGo",
        "othello" => "ČFO",
        "zatre" => "ČFZ",
        "hadanka" => "SČHaK"
    );
    foreach my $organizace ("paluba", "scrabble", "dama", "dama2", "go", "othello", "zatre", "hadanka")
    {
        my $sel = $osoba->{"clen_$organizace"} ? " checked" : "";
        print("        <input$sel type=checkbox name=clen_$organizace value=\"1\"> $organizace{$organizace}\n");
    }
    print("      </td>\n");
    print("    </tr>\n");
    print <<EOF
    <tr><td align=right>e-mail:</td><td><input type=text name=e_mail value="$osoba->{e_mail}"></td></tr>
  </table>
EOF
    ;
    # Seřadit akce podle názvu hry a akce.
    @{$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});
    # Vypsat seznam akcí, na které se tato osoba letos přihlásila.
    print("  <h2>Přihlášky v&nbsp;roce $rok</h2>\n");
    print("  <p>Chcete-li odhlásit osobu z&nbsp;akce, zrušte zaškrtnutí vedle příslušné přihlášky. Obdobně můžete osobu přihlásit na další akce tím, že je zaškrtnete. Nezapomeňte pak stisknout tlačítko <a href=\"\#ulozit\">Uložit</a>!</p>\n");
    print("  <table>\n");
    print("    <tr><th></th><th align=left>Hra</th><th align=left>Turnaj</th><th colspan=\"2\">Datum a čas přihlášky</th><th>Má dáti</th><th>Dal</th><th>Způsob placení</th></tr>\n");
    my $n_prihlasek;
    foreach my $a (@{$akce})
    {
        if($a->{prihlasen})
        {
            my $datum = $a->{datum_prihlasky};
            my $cas;
            if($datum =~ m/^(\d+\.\d+\.\d+)(?:\s+(\d+:\d+:\d+))?$/)
            {
                $datum = $1;
                $cas = $2;
            }
            my $checkbox_name = "turn".$rok.$a->{kod_hry}.$a->{kod_turnaje};
            print("    <tr>\n");
            print("      <td align=right><input type=checkbox name=$checkbox_name checked></td>\n");
            print("      <td>$a->{_nazev_hry}</td>\n");
            print("      <td>$a->{\"akce.nazev\"}</td>\n");
            print("      <td align=right>$datum </td>\n");
            print("      <td align=right>$cas</td>\n");
            print("      <td align=right>$a->{ma_dati}&nbsp;Kč</td>\n");
            print("      <td align=right><input type=text name=\"prihl-$a->{kod_hry}-$a->{kod_turnaje}-dal\" value=\"$a->{dal}\" size=\"3\" align=right>&nbsp;Kč</td>\n");
            print("      <td><input type=text name=\"prihl-$a->{kod_hry}-$a->{kod_turnaje}-zpusob_placeni\" value=\"$a->{zpusob_placeni}\"></td>\n");
            print("    </tr>\n");
            $n_prihlasek++;
        }
    }
    # Připsat seznam akcí, na které se ještě může přihlásit.
    # Odsadit nepřihlášené akce v tabulce prázdným řádkem.
    if($n_prihlasek)
    {
        print("    <tr><td>&nbsp;</td></tr>\n");
    }
    foreach my $a (@{$akce})
    {
        unless($a->{prihlasen})
        {
            my $datum = $a->{datum_prihlasky};
            my $cas;
            if($datum =~ m/^(\d+\.\d+\.\d+)(?:\s+(\d+:\d+:\d+))?$/)
            {
                $datum = "<strike>$1</strike>";
                $cas = "<strike>$2</strike>";
            }
            my $checkbox_name = "turn".$rok.$a->{kod_hry}.$a->{kod_turnaje};
            print("    <tr><td align=right><input type=checkbox name=$checkbox_name></td><td>$a->{_nazev_hry}</td><td>$a->{\"akce.nazev\"}</td><td align=right>$datum</td><td align=right>$cas</td></tr>\n");
        }
    }
    print("  </table>\n");
    print("  <p><a name=ulozit><input type=submit name=ulozit value=\"Uložit\"></a></p>\n");
    print("  </form>\n");
    # Poslat konec stránky.
    print <<EOF
    <p>Návrhy na vylepšení tohoto formuláře posílejte <a href="mailto:zeman\@ufal.mff.cuni.cz">Danovi Zemanovi</a>.</p>
  </body>
</html>
EOF
    ;
}



#------------------------------------------------------------------------------
# Uloží údaje o osobě z formuláře a potom tyto údaje vypíše.
#------------------------------------------------------------------------------
sub ulozit_osobu
{
    my $osoba = shift;
    # Zkontrolovat, že byl zadán nenulový kód osoby. Jinak nevíme, co měnit.
    unless($osoba->{kod})
    {
        fatalni_chyba('Nelze uložit osobu s&nbsp;neznámým kódem.');
    }
    # Doplnit chybějící údaje. Prázdné řetězce by nabouraly syntaxi SQL.
    foreach my $pole (qw(clen_paluba clen_scrabble clen_dama clen_dama2 clen_go clen_othello clen_zatre clen_hadanka))
    {
        if($osoba->{$pole} eq "")
        {
            $osoba->{$pole} = 0;
        }
    }
    # Zjistit, zda tato osoba už byla měněna a má záznam v tabulce osoby_zmeny.
    my $radek = dzsql::select($databaze, 'osoby_zmeny', { 'values' => $osoba, 'wfields' => ['kod'], 'sfields' => ['kod'] });
    my $uz_existuje = scalar(@{$radek})>0;
    # Uložit údaje do databáze.
    my @tfields = qw(jmeno prijmeni obec zeme pohlavi kategorie e_mail);
    my @nfields = qw(kod clen_paluba clen_scrabble clen_dama clen_dama2 clen_go clen_othello clen_zatre clen_hadanka);
    my @fields = (@tfields, @nfields);
    if($uz_existuje)
    {
        dzsql::update($databaze, 'osoby_zmeny', { 'values' => $osoba, 'wfields' => ['kod'], 'ufields' => \@fields, 'nfields' => \@nfields })
            or chyba("Nepodařilo se změnit záznam v&nbsp;tabulce osoby_zmeny: $DBI::errstr<br/>$dzsql::dotaz");
    }
    else
    {
        dzsql::insert($databaze, 'osoby_zmeny', { 'values' => $osoba, 'ifields' => \@fields, 'nfields' => \@nfields })
            or chyba("Nepodařilo se přidat záznam do tabulky osoby_zmeny: $DBI::errstr<br/>$dzsql::dotaz");
    }
    # Zjistit datum a čas změn přihlášek.
    my $ted = cas::ted();
    my $cas = "$ted->{datum} $ted->{cas}";
    # Porovnat seznam přihlášek z formuláře se seznamem přihlášek v databázi.
    # Vymazat všechny dřívější změny přihlášek této osoby, budou uloženy znova.
    dzsql::delete($databaze, 'prihlasky_zmeny', { 'values' => {'kod_osoby'=>$osoba->{kod}}, 'wfields' => ['kod_osoby'], 'nfields' => ['kod_osoby'] })
        or chyba("Nepodařilo se odstranit změny přihlášek z&nbsp;tabulky prihlasky_zmeny: $DBI::errstr<br/>$dzsql::dotaz");
    debug("Odstraňujeme z prihlasky_zmeny všechny dřívější změny osoby $osoba->{kod}, změny u této osoby budeme zadávat nanovo.<br/>$dzsql::dotaz");
    # Sestavit seznam přihlášek z databáze.
    my $rok = $osoba->{rok};
    my $prihlasky_z_databaze = zjistit_akce_rok_osoba($databaze, $rok, $osoba, 'HASH');
    # Sestavit seznam přihlášek z formuláře (hash má klíče prihlasen, dal, zpusob_placeni).
    my $prihlasky_z_formulare = posbirat_prihlasky($osoba);
    # Ty, které nejsou v databázi nebo se u nich některý údaj liší od databáze, rovnou ukládat do databáze.
    foreach my $hra (keys(%{$prihlasky_z_formulare}))
    {
        foreach my $turnaj (keys(%{$prihlasky_z_formulare->{$hra}}))
        {
            my $pzf = $prihlasky_z_formulare->{$hra}{$turnaj};
            my $pzd = $prihlasky_z_databaze->{$hra}{$turnaj};
            # Existence dvojice klíčů pro hru a turnaj ještě nutně neznamená, že příslušné políčko formuláře bylo zaškrtnuto.
            next unless($pzf->{prihlasen});
            # Máme už takovou přihlášku v databázi?
            # Pokud ano, shodují se údaje o placení?
            if(!$pzd->{prihlasen} ||
               $pzf->{dal} != $prihlasky_z_databaze->{$hra}{$turnaj}{dal} ||
               $pzf->{zpusob_placeni} ne $prihlasky_z_databaze->{$hra}{$turnaj}{zpusob_placeni})
            {
                # Doplnit do záznamu údaje, které se mají zapsat do databáze a které tam zatím chybějí.
                my @nazvy = qw(kod_osoby rok kod_hry kod_turnaje datum_zmeny ma_dati dal zpusob_placeni);
                my @nfields = qw(kod_osoby rok ma_dati dal);
                $pzf->{kod_osoby} = $osoba->{kod};
                $pzf->{rok} = $rok;
                $pzf->{kod_hry} = $hra;
                $pzf->{kod_turnaje} = $turnaj;
                $pzf->{datum_zmeny} = $cas;
                # Vypočítat požadovanou výši startovného.
                $pzf->{ma_dati} = mso::zjistit_startovne($databaze, $rok, $hra, $turnaj, $osoba->{kategorie}, $osoba);
                # Číselná hodnota nesmí být prázdný řetězec, protože by narušila syntaxi SQL.
                $pzf->{ma_dati} = 0 if($pzf->{ma_dati} eq '');
                $pzf->{dal} = 0 if($pzf->{dal} eq '');
                dzsql::insert($databaze, 'prihlasky_zmeny', { 'values' => $pzf, 'ifields' => \@nazvy, 'nfields' => \@nfields })
                    or chyba("Nepodařilo se přidat změnu přihlášky do tabulky prihlasky_zmeny: $DBI::errstr<br/>$dzsql::dotaz");
                debug("Přidáváme do prihlasky_zmeny akci $hra/$turnaj, která je zaškrtnutá ve formuláři, ale v databázi zatím nebyla.<br/>$dzsql::dotaz");
            }
        }
    }
    # Uložit odstranění přihlášek z databáze, které nejsou ve formuláři.
    foreach my $hra (keys(%{$prihlasky_z_databaze}))
    {
        foreach my $turnaj (keys(%{$prihlasky_z_databaze->{$hra}}))
        {
            my $pzd = $prihlasky_z_databaze->{$hra}{$turnaj};
            my $pzf = $prihlasky_z_formulare->{$hra}{$turnaj};
            # Existence dvojice klíčů pro hru a turnaj ještě nutně neznamená, že příslušné políčko formuláře bylo zaškrtnuto.
            next unless($pzd->{prihlasen});
            unless($pzf->{prihlasen})
            {
                # Doplnit do záznamu údaje, které se mají zapsat do databáze a které tam zatím chybějí.
                my @nazvy = qw(kod_osoby rok kod_hry kod_turnaje odhlasit datum_zmeny ma_dati dal zpusob_placeni);
                my @nfields = qw(kod_osoby rok odhlasit ma_dati dal);
                $pzf->{kod_osoby} = $osoba->{kod};
                $pzf->{rok} = $rok;
                $pzf->{odhlasit} = 1;
                $pzf->{kod_hry} = $hra;
                $pzf->{kod_turnaje} = $turnaj;
                $pzf->{datum_zmeny} = $cas;
                # Číselná hodnota nesmí být prázdný řetězec, protože by narušila syntaxi SQL.
                $pzf->{ma_dati} = $pzd->{ma_dati};
                $pzf->{ma_dati} = 0 if($pzf->{ma_dati} eq '');
                $pzf->{dal} = 0 if($pzf->{dal} eq '');
                dzsql::insert($databaze, 'prihlasky_zmeny', { 'values' => $pzf, 'ifields' => \@nazvy, 'nfields' => \@nfields })
                    or chyba("Nepodařilo se přidat storno přihlášky do tabulky prihlasky_zmeny: $DBI::errstr<br/>$dzsql::dotaz");
                debug("Přidáváme do prihlasky_zmeny <b>storno</b> akce $hra/$turnaj, která byla v databázi, ale ve formuláři chybí.<br/>$dzsql::dotaz");
            }
        }
    }
    # Osoba je uložena, nyní znova vypsat její formulář pro případné další úpravy.
    vypsat_osobu($osoba->{kod}, $osoba->{rok});
}



#------------------------------------------------------------------------------
# Uloží údaje o osobě z formuláře a potom tyto údaje vypíše.
#------------------------------------------------------------------------------
sub ulozit_osobu_vs
{
    my $osoba = shift;
    # Zkontrolovat, že byl zadán nenulový variabilní symbol. Jinak nevíme, co měnit.
    unless($osoba->{vs})
    {
        fatalni_chyba('Nelze uložit přihlášku s&nbsp;neznámým variabilním symbolem.');
    }
    # Doplnit chybějící údaje. Prázdné řetězce by nabouraly syntaxi SQL.
    # V tabulce osoby_auto jsou jinak pojmenovaná pole (např. "clenpaluba"), proto ty hrátky s podtržítky.
    foreach my $pole (qw(clen_paluba clen_scrabble clen_dama clen_dama2 clen_go clen_othello clen_zatre clen_hadanka))
    {
        my $pole_bez_podtrzitka = $pole;
        $pole_bez_podtrzitka =~ s/_//;
        if($osoba->{$pole} eq "")
        {
            $osoba->{$pole_bez_podtrzitka} = 0;
        }
        else
        {
            $osoba->{$pole_bez_podtrzitka} = $osoba->{$pole};
        }
    }
    $osoba->{email} = $osoba->{e_mail};
    # Uložit údaje do databáze.
    my @tfields = qw(vs jmeno prijmeni obec zeme pohlavi kategorie email);
    my @nfields = qw(clenpaluba clenscrabble clendama clendama2 clengo clenothello clenzatre clenhadanka);
    my @fields = (@tfields, @nfields);
    dzsql::update($databaze, 'osoby_auto', { 'values' => $osoba, 'wfields' => ['vs'], 'ufields' => \@fields, 'nfields' => \@nfields })
        or chyba("Nepodařilo se změnit záznam v&nbsp;tabulce osoby_auto: ", $DBI::errstr, "<br/>$dzsql::dotaz");
    # Zjistit datum a čas změn přihlášek.
    my $cas = mso::dotazat_se_databaze($databaze, "datum_prihlasky", "osoby_auto WHERE vs = '$osoba->{vs}'")->[0]{datum_prihlasky};
    # Vymazat všechny dřívější akce u této přihlášky, budou uloženy znova.
    dzsql::delete($databaze, 'prihlasky_auto', { 'values' => {'datum_prihlasky'=>$cas}, 'wfields' => ['datum_prihlasky'] })
        or chyba("Nepodařilo se odstranit akce z tabulky prihlasky_auto: $DBI::errstr<br/>$dzsql::dotaz");
    # Sestavit seznam přihlášek z formuláře (hash má klíče prihlasen, dal, zpusob_placeni).
    my $prihlasky_z_formulare = posbirat_prihlasky($osoba);
    # Uložit přihlášky do databáze.
    foreach my $hra (keys(%{$prihlasky_z_formulare}))
    {
        foreach my $turnaj (keys(%{$prihlasky_z_formulare->{$hra}}))
        {
            my $pzf = $prihlasky_z_formulare->{$hra}{$turnaj};
            next unless($pzf->{prihlasen});
            my @nazvy = qw(datum_prihlasky rok kod_hry kod_turnaje ma_dati dal zpusob_placeni);
            my @nfields = qw(rok ma_dati dal);
            # Vypočítat požadovanou výši startovného.
            $pzf->{ma_dati} = mso::zjistit_startovne($databaze, $osoba->{rok}, $hra, $turnaj, $osoba->{kategorie}, $osoba);
            $pzf->{datum_prihlasky} = $cas;
            $pzf->{rok} = $osoba->{rok};
            $pzf->{kod_hry} = $hra;
            $pzf->{kod_turnaje} = $turnaj;
            dzsql::insert($databaze, 'prihlasky_auto', { 'values' => $pzf, 'ifields' => \@nazvy, 'nfields' => \@nfields })
                or chyba("Nepodařilo se přidat přihlášky do tabulky prihlasky_auto: $DBI::errstr<br/>$dzsql::dotaz");
            debug("Přidáváme do prihlasky_auto akci $hra/$turnaj, která je zaškrtnutá ve formuláři.<br/>$dzsql::dotaz");
        }
    }
    # Osoba je uložena, nyní znova vypsat její formulář pro případné další úpravy.
    vypsat_osobu_vs($osoba->{vs}, $osoba->{rok});
}



#------------------------------------------------------------------------------
# Posbírá mezi hodnotami z formuláře ty, které se vztahují ke konkrétním akcím
# (mají jména ve specifickém tvaru, ale neznáme dopředu jejich seznam) a
# nahashuje je podle kódu hry a turnaje.
#------------------------------------------------------------------------------
sub posbirat_prihlasky
{
    my $osoba = shift; # odkaz na hash
    my %prihlasky;
    foreach my $klic (keys(%{$osoba}))
    {
        # Zaškrtávátka akcí, na které se osoba přihlásila, mají název začínající na "turn".
        if($klic =~ m/^turn$osoba->{rok}(...)(...)$/)
        {
            $prihlasky{$1}{$2}{prihlasen} = 1;
        }
        # Textová pole s doplňujícími údaji k přihláškám na akce mají název začínající na "prihl".
        elsif($klic =~ m/^prihl-(...)-(...)-dal$/)
        {
            $prihlasky{$1}{$2}{dal} = $osoba->{$klic};
        }
        elsif($klic =~ m/^prihl-(...)-(...)-zpusob_placeni$/)
        {
            $prihlasky{$1}{$2}{zpusob_placeni} = $osoba->{$klic};
        }
    }
    return \%prihlasky;
}



#------------------------------------------------------------------------------
# Získá seznam všech akcí v daném roce a pro danou osobu k nim vyznačí, na
# které z nich je osoba přihlášená. Údaje o přihláškách získává 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, ale hledáme shodné jméno a
# příjmení).
#------------------------------------------------------------------------------
sub zjistit_akce_rok_osoba
{
    my $databaze = shift;
    my $rok = shift;
    my $osoba = shift; # odkaz na hash (potřebujeme kód, jméno a příjmení; kromě toho můžeme nastavit změna=1)
    my $typ = shift; # ARRAY|HASH ... v jaké formě chceme seznam akcí dostat? Odkaz na pole, nebo na hash?
    my $kod_osoby = $osoba->{kod};
    # Nejdřív načíst seznam všech letošních akcí (kvůli názvu hry a akce a kvůli tomu, že později stejně budeme vypisovat i ty nepřihlášené).
    my $akce = mso::nacist_akce($databaze, $rok);
    # Nahashovat si odkazy na akce.
    my %akce;
    foreach my $a (@{$akce})
    {
        $akce{$a->{kod_hry}}{$a->{kod_turnaje}} = $a;
    }
    # Načíst přihlášky z databáze z tabulky prihlasky (Klářin export).
    my @nazvy = qw(kod_hry kod_turnaje datum_prihlasky ma_dati dal zpusob_placeni);
    my $prihlasky = mso::dotazat_se_databaze($databaze, @nazvy, "prihlasky WHERE (rok = '$rok') AND (kod_osoby = '$kod_osoby')");
    # Přepsat si přihlášky přímo k akcím.
    foreach my $prihlaska (@{$prihlasky})
    {
        my $a = $akce{$prihlaska->{kod_hry}}{$prihlaska->{kod_turnaje}};
        $a->{prihlasen} = 1;
        foreach my $atribut (qw(datum_prihlasky ma_dati dal zpusob_placeni))
        {
            $a->{$atribut} = $prihlaska->{$atribut};
        }
    }
    # Načíst dosud nezpracované webové přihlášky z tabulky prihlasky_auto.
    @nazvy = ('kod_hry', 'kod_turnaje', 'prihlasky_auto.datum_prihlasky AS datum_prihlasky', 'ma_dati', 'dal', 'zpusob_placeni');
    $prihlasky = mso::dotazat_se_databaze($databaze, @nazvy, "prihlasky_auto INNER JOIN osoby_auto ON prihlasky_auto.datum_prihlasky = osoby_auto.datum_prihlasky WHERE (jmeno = '$osoba->{jmeno}') AND (prijmeni = '$osoba->{prijmeni}')");
    # Přepsat si přihlášky přímo k akcím.
    foreach my $prihlaska (@{$prihlasky})
    {
        $osoba->{zmena} = 1;
        my $a = $akce{$prihlaska->{kod_hry}}{$prihlaska->{kod_turnaje}};
        $a->{prihlasen} = 1;
        $a->{datum_prihlasky} = $prihlaska->{datum_prihlasky};
        $a->{ma_dati} = $prihlaska->{ma_dati};
        $a->{dal} = $prihlaska->{dal};
        $a->{zpusob_placeni} = $prihlaska->{zpusob_placeni};
    }
    # Načíst přihlášky z databáze z tabulky prihlasky_zmeny (změny přes webové rozhraní).
    @nazvy = ('kod_hry', 'kod_turnaje', 'odhlasit', 'datum_zmeny AS datum_prihlasky', 'ma_dati', 'dal', 'zpusob_placeni');
    $prihlasky = mso::dotazat_se_databaze($databaze, @nazvy, "prihlasky_zmeny WHERE (rok = '$rok') AND (kod_osoby = '$kod_osoby')");
    # Přepsat si přihlášky přímo k akcím a zohlednit, odkud se osoba odhlásila.
    foreach my $prihlaska (@{$prihlasky})
    {
        $osoba->{zmena} = 1;
        my $a = $akce{$prihlaska->{kod_hry}}{$prihlaska->{kod_turnaje}};
        if($prihlaska->{odhlasit})
        {
            $a->{prihlasen} = 0;
        }
        else
        {
            $a->{prihlasen} = 1;
            # Hodnoty načtené z Klářiny databáze se přepíšou hodnotami z webového rozhraní.
            foreach my $atribut (qw(datum_prihlasky ma_dati dal zpusob_placeni))
            {
                $a->{$atribut} = $prihlaska->{$atribut};
            }
        }
    }
    return (($typ =~ m/^ARRAY$/i) ? $akce : \%akce);
}



#------------------------------------------------------------------------------
# Vypíše záhlaví MIME a HTML.
#------------------------------------------------------------------------------
sub vypsat_zahlavi
{
    my $title = shift;
    my $redir = shift; # chceme-li přesměrovat na sebe sama bez parametrů
    my $metaredir = $redir ? "    <meta http-equiv=\"Refresh\" content=\"5; URL=$redir\">\n" : '';
    # Poslat MIME záhlaví dokumentu.
    print("Content-Type: text/html; charset=utf-8\n\n");
    # Poslat záhlaví HTML a počáteční značku těla, abychom mohli vypisovat i ladící a chybová hlášení.
    # Na druhou stranu to znamená, že nemůžeme přizpůsobit <title> parametrům a obsahu stránky (např. přidat do něj jméno osoby).
    print <<EOF
<html>
  <head>
$metaredir    <meta http-equiv="Content-Language" content="cs">
    <meta http-equiv="Content-Type" content="text/html; charset=utf-8">
    <title>$title</title>
  </head>
  <body>
EOF
    ;
    # Když už je vypsáno záhlaví, můžeme vypsat i případná ladící hlášení,
    # která se do této chvíle nashromáždila.
    vyprazdnit_schranku();
}



#------------------------------------------------------------------------------
# Vypíše barevné ladící hlášení na právě generované webové stránce.
# Pokud ještě nebylo odesláno záhlaví MIME a HTML, uloží hlášení do schránky,
# aby se mohlo vypsat, jakmile to bude možné.
#------------------------------------------------------------------------------
sub debug
{
    my $zprava = join('', @_);
    my $hlaseni = "<p><font color=magenta>$zprava</font></p>\n";
    if($global_zahlavi_vypsano)
    {
        print($hlaseni);
    }
    else
    {
        $global_buffer .= $hlaseni;
    }
}



#------------------------------------------------------------------------------
# Ohlásí chybu barevným nápisem na právě generované webové stránce.
# Pokud ještě nebylo odesláno záhlaví MIME a HTML, uloží hlášení do schránky,
# aby se mohlo vypsat, jakmile to bude možné.
#------------------------------------------------------------------------------
sub chyba
{
    my $chyba = join('', @_);
    debug("Chyba: $chyba");
}



#------------------------------------------------------------------------------
# Vypíše všechna ladící hlášení, která se nashromáždila v době, kdy ještě
# nebylo odesláno záhlaví MIME a HTML.
#------------------------------------------------------------------------------
sub vyprazdnit_schranku
{
    print($global_buffer);
    $global_buffer = '';
    $global_zahlavi_vypsano = 1;
}



#------------------------------------------------------------------------------
# Ohlásí chybu a skončí. Používá se pro fatální chyby při ukládání změn, kvůli
# kterým nelze pokračovat v ukládání. Nahrazuje funkci Perlu die(), kterou
# nechceme použít, protože by klient nedostal chybové hlášení.
#------------------------------------------------------------------------------
sub fatalni_chyba
{
    my $chyba = shift;
    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 osob: Chyba při ukládání změn</title>
  </head>
  <body>
    <h1>Chyba</h1>
    <p>$chyba</p>
  </body>
</html>
EOF
    ;
    exit;
}