#!/usr/bin/perl
# Umožní zobrazit akce.
# Copyright © 2006, 2011 Dan Zeman <zeman@ufal.mff.cuni.cz>, 2020 Petr Gašparík <petr@gasparik.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/devmso';
use lib '/s/w/lib/cgi/devmso/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 akcí nebo vybranou akci.
# Akce identifikujeme trojklíčem rok-kod_hry-kod_turnaje
if(exists($konfig{ulozit}))
{
    ulozit_akci(\%konfig);
}
elsif($konfig{kod_hry})
{
    vypsat_akci($konfig{rok}, $konfig{kod_hry}, $konfig{kod_turnaje});
}
else
{
    vypsat_seznam();
}



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



#------------------------------------------------------------------------------
# Vypíše seznam všech akcí.
#------------------------------------------------------------------------------
sub vypsat_seznam
{
    vypsat_zahlavi("Databáze akcí");
    # Poslat začátek stránky.
    print <<EOF
  <h1>Přehled akcí</h1>
  <p>Kliknutím na název akce 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 akcí.
    my $akce = mso::dotazat_se_databaze($databaze, "rok", "kod_hry", "kod_turnaje", "nazev", "akce ORDER BY rok, nazev");
    # Seřadit seznam akcí
    map{$_->{_trid} = csort::zjistit_tridici_hodnoty($_->{nazev}.$_->{rok}, 'cs')}(@{$akce});
    @{$akce} = sort{$a->{_trid} cmp $b->{_trid}}(@{$akce});
    my $posledni_pismeno;
    # Zapamatovat si aktuální akci, chceme vypsat název a za ní jednotlivé roky
    my $akce_aktualni = "~</li>";
    foreach my $akcicka (@{$akce})
    {
        # Zapamatovat si počáteční písmeno, u nového počátečního písmene udělat záložku.
        my $pismeno = substr($akcicka->{nazev}, 0, 2) eq "Ch" ? "Ch" : substr($akcicka->{nazev}, 0, 1);
        my $kotva = $pismeno ne $posledni_pismeno ? " name=\"$pismeno\"" : "";
        # Na bezejmenné akce by se nedalo kliknout.
        if($akcicka->{rok} =~ m/^\s*$/ && $akcicka->{nazev} =~ m/^\s*$/)
        {
            $akcicka->{nazev} = "&lt;BEZEJMENNÁ&gt;";
        }
        # Zjistit, zda je to nová akce
        if($akce_aktualni ne ($akcicka->{nazev})) {
            # </li> tisknout jen před neprvním <li>
            if($akce_aktualni ne "~</li>") {
                print("</li>\n");
            }
            print("    <li>$akcicka->{nazev}");
        }
        print(" - <a$kotva href=\"akce.pl?rok=$akcicka->{rok}&kod_hry=$akcicka->{kod_hry}&kod_turnaje=$akcicka->{kod_turnaje}\">$akcicka->{rok}</a>");
        $posledni_pismeno = $pismeno;
        $akce_aktualni = ($akcicka->{nazev});
    }
    # Poslat konec stránky.
    print <<EOF
  </ol>
  </body>
</html>
EOF
    ;
}



#------------------------------------------------------------------------------
# Vypíše údaje jedné akce.
#------------------------------------------------------------------------------
sub vypsat_akci
{
    my $rok = shift;
    my $hra = shift;
    my $turnaj = shift;
    # Načíst údaje o akci z databáze.
    my $akce = mso::dotazat_se_databaze($databaze, 
        "rok", "kod_turnaje", "kod_hry", "nazev", "nazev_en", "nazev_ru", 
        "zacatek", "konec", "poznamka", "poznamka_en", 
        "akce WHERE rok = $rok AND kod_turnaje = '$turnaj' AND kod_hry = '$hra'");
    my $akcicka = $akce->[0];
    vypsat_formular($akcicka, $rok, $hra, $turnaj);
}



#------------------------------------------------------------------------------
# Vypíše formulář s předvyplněnými údaji o akci.
#------------------------------------------------------------------------------
sub vypsat_formular
{
    my $akce = shift; 
    my $rok = shift;
    my $hra = shift;
    my $turnaj = shift;
    # Poslat začátek stránky.
    vypsat_zahlavi("Databáze: $rok - $hra - $turnaj");
    print <<EOF
  [ <a href="akce.pl">Seznam akcí</a> ]
  <form method=get action="akce.pl">
  <h1>$akce->{rok} - $akce->{nazev}</h1>
  <p>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
    ;
    print("    <tr>\n");
    print("        <td align=right>Rok:</td><td><input type=text name=rok value=\"$akce->{rok}\"></td>\n");
    print("        <td align=right>Název CZ:</td><td><input type=text name=nazev value=\"$akce->{nazev}\"></td>\n");
    print("    </tr>\n");

    print("    <tr>\n");
    print("        <td align=right>Kód hry:</td><td><input type=text name=kod_hry value=\"$akce->{kod_hry}\"></td>\n");
    print("        <td align=right>Název EN:</td><td><input type=text name=nazev_en value=\"$akce->{nazev_en}\"></td>\n");
    print("    </tr>\n");

    print("    <tr>\n");
    print("        <td align=right>Kód turnaje:</td><td><input type=text name=kod_turnaje value=\"$akce->{kod_turnaje}\"></td>\n");
    print("        <td align=right>Název RU:</td><td><input type=text name=nazev_ru value=\"$akce->{nazev_ru}\"></td>\n");
    print("    </tr>\n");

    print("    <tr>\n");
    print("        <td align=right>Začátek:</td><td><input type=text name=zacatek value=\"$akce->{zacatek}\"></td>\n");
    print("        <td align=right>Poznámka:</td><td><input type=text name=poznamka value=\"$akce->{poznamka}\"></td>\n");
    print("    </tr>\n");

    print("    <tr>\n");
    print("        <td align=right>Konec:</td><td><input type=text name=konec value=\"$akce->{konec}\"></td>\n");
    print("        <td align=right>Poznámka EN:</td><td><input type=text name=poznamka_en value=\"$akce->{poznamka_en}\"></td>\n");
    print("    </tr>\n");

    print("  </table>");
    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:petr\@gasparik.cz.cz">Petrovi Gašparíkovi</a>.</p>
  </body>
</html>
EOF
    ;
}



#------------------------------------------------------------------------------
# Uloží údaje o akci z formuláře a potom tyto údaje vypíše.
#------------------------------------------------------------------------------
sub ulozit_akci
{
    my $akce = shift;
    # Zkontrolovat, že byl zadán nenulový trojklíč kód akce. Jinak nevíme, co měnit.
    unless($akce->{rok} && $akce->{kod_hry} && $akce->{kod_turnaje})
    {
        fatalni_chyba('Nelze uložit akci s&nbsp;neznámým trojklíčem rok-kod_turnaje-kod_hry.');
    }
    # Zjistit, zda tato akce už existuje.
    my $radek = dzsql::select($databaze, 'akce', { 'values' => $akce, 'wfields' => ['rok', 'kod_turnaje', 'kod_hry'], 'sfields' => ['rok', 'kod_turnaje', 'kod_hry'] });
    my $uz_existuje = scalar(@{$radek})>0;
    # Uložit údaje do databáze.
    my @tfields = qw(kod_turnaje kod_hry nazev);
    my @nfields = qw(rok);
    my @fields = (@tfields, @nfields);
    if($uz_existuje)
    {
        dzsql::update($databaze, 'akce', { 'values' => $akce, 'wfields' => ['rok', 'kod_turnaje', 'kod_hry'], 'ufields' => \@fields, 'nfields' => \@nfields })
            or chyba("Nepodařilo se změnit záznam v&nbsp;tabulce akce: $DBI::errstr<br/>$dzsql::dotaz");
    }
    else
    {
        dzsql::insert($databaze, 'akce', { 'values' => $akce, 'ifields' => \@fields, 'nfields' => \@nfields })
            or chyba("Nepodařilo se přidat záznam do tabulky akce: $DBI::errstr<br/>$dzsql::dotaz");
    }
=pod
=cut
    # Akce je uložena, nyní znova vypsat její formulář pro případné další úpravy.
    vypsat_akci($akce->{rok}, $akce->{kod_hry}, $akce->{kod_turnaje});
}



#------------------------------------------------------------------------------
# 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 název akce).
    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 akcí: Chyba při ukládání změn</title>
  </head>
  <body>
    <h1>Chyba</h1>
    <p>$chyba</p>
  </body>
</html>
EOF
    ;
    exit;
}