#!/usr/bin/perl
# CGI přístup k databázi her. Generuje jak seznamy, tak stránky o konkrétních hrách.
# Copyright © 2002-2009, 2013, 2015 Daniel Zeman <zeman@ufal.mff.cuni.cz>
# Licence: GNU GPL
# 30.12.2003: přechod na UTF-8
# 11.9.2007: přechod pod MySQL
# 17.9.2009: zahozeno ../formdata.pl, přechod pod dzcgi.pm
# 15.9.2013: ruším filtr na hry k půjčení na Palubě: naposledy jsme to aktualizovali, když palubní hry spravovala Radka
# 10.4.2015: přechod na new.kub.cz
use utf8;
use Encode;
# Přinutit Perl, aby UTF8 vypisoval jako UTF8 a nevymýšlel pro mě "vhodné" osmibitové kódování.
binmode(STDOUT, ':utf8');
# Přidat Danovy sdílené knihovny. Skript běžící pod uživatelem apache by je jinak nenašel.
use lib '/s/w/lib/dan';
use lib '/s/w/lib/cgi/hry';
use dzcgi;
use cist;



# Zjistit cestu pro odkazování na statické stránky hrejsi.
open(KONFIG, "../cgi.cfg");
while(<KONFIG>)
{
    if(m/(\S+)\s*=\s*([^\r\n]*)/)
    {
        $konfig{$1} = $2;
    }
}
close(KONFIG);
$koren_hrejsi = $konfig{ccesta_html_www};
$koren_system = $konfig{scesta_html_www};



# Přečíst parametry.
dzcgi::cist_parametry(\%pole);
dzcgi::cist_formular_post(\%pole) if($pole{formular});
upravit_konfig(\%pole);
# Pro ladící účely si nachystat výpis parametrů na výstup.
$ladeni = 0;
if($ladeni)
{
    foreach($key, sort(keys(%pole)))
    {
        $dbg_parametry .= "$key = $pole{$key}\n";
    }
    $dbg_parametry = "<pre>$dbg_parametry</pre>\n";
}



# Načíst procedury na čtení tabulky her.
$hry = cist::precist_hry();
cist::precist_provedeni("provedeni.txt");



# Poslat MIME záhlaví dokumentu.
print("Content-Type: text/html; charset=utf-8\n\n");



# Poslat začátek stránky.
if($pole{hra} eq "") {
    print("<html>\n");
    print("<head>\n");
    print("<meta http-equiv=\"content-type\" content=\"text/html; charset=utf-8\">\n");
    print("<title>Pokladnice her</title>\n");
#    print("<link rel=\"stylesheet\" type=\"text/css\" href=\"$koren_hrejsi/obr/main.css\">\n");
#    print("<link rel=\"stylesheet\" type=\"text/css\" href=\"$koren_hrejsi/obr/titulni.css\">\n");
    print("</head>\n");
    print("<body text=\"#C0C0C0\" bgcolor=\"#000000\" link=\"#FFFF99\" vlink=\"#FFFF99\" alink=\"#FFFF99\">\n");
    print("<!--webbot bot=\"Include\" U-Include=\"$koren_hrejsi/obr/topmenu.htm\" TAG=\"BODY\" startspan -->\n");
    print("<!-- #BeginLibraryItem \"/Library/Hlavicka - black s sedou bublinou.lbi\" -->\n");
#    print("<script language=\"JavaScript\" src=\"$koren_hrejsi/obr/menus.js\"></script>\n");
#    print("<script language=\"JavaScript\" src=\"$koren_hrejsi/obr/menusopts.js\"></script>\n");
    print("<table border=\"0\" width=\"100%\" cellpadding=\"0\" cellspacing=\"0\">\n");
    print("<tr>\n");
    print("<td>\n");
    print("<p align=left>\n");
    print("<map name=\"FPMap0\">\n");
#    print("<area href=\"$koren_hrejsi/paluba\" alt=\"Klub deskových her Paluba\" shape=\"rect\" coords=\"9,66,207,85\" title=\"Klub deskových her Paluba\">\n");
    print("<area href=\"$koren_hrejsi/\" alt=\"Hrejsi.cz - svět deskových her jako na dlani\" shape=\"rect\" coords=\"9,3,206,67\" title=\"Hrejsi.cz - svět deskových her jako na dlani\">\n");
    print("</map>\n");
    print("<img border=\"0\" src=\"$koren_hrejsi/obr/hrejsibub.gif\" usemap=\"#FPMap0\" width=\"288\" height=\"91\">\n");
    print("</td>\n");
    print("<td width=\"90%\" valign=\"top\">&nbsp;</td>\n");
    print("</tr>\n");
    print("<tr>\n");
    print("<td colspan=\"2\" height=\"5\">\n");
    print("<table border=\"0\" cellpadding=\"0\" width=\"100%\" cellspacing=\"0\">\n");
    print("<tr>\n");
    print("<td colspan=\"2\">\n");
    print("<div width=\"50\" height=\"1\"><b><font size=\"-2\" color=\"#C0C0C0\"> </font></b></div>\n");
    print("</td>\n");
    print("</tr>\n");
    print("</table>\n");
    print("</td>\n");
    print("</tr>\n");
    print("</table>\n");
    print("<!-- #EndLibraryItem --><!-- #BeginEditable \"Obsah stranky\" --> <!--webbot bot=\"Include\" U-Include=\"obr/topmenu.htm\" TAG=\"BODY\" startspan -->\n");
    print("<!--webbot bot=\"Include\" endspan i-checksum=\"45316\" -->\n");
    print("$dbg_parametry\n");
    print("<h1><font color=yellow>Pokladnice her</font></h1>\n");
    # Generovat část pro výběr řazení a filtru.
    generovat_vyber_razeni_a_filtru(\%pole);
    # Aplikovat současný filtr: Úplně zahodit hry, které filtrem neprošly.
    filtrovat($hry, \%pole);
}
else
{
    # Najít záznam požadované hry.
    foreach my $hra (@{$hry})
    {
        if($hra->{kod} eq $pole{hra})
        {
            generovat_stranku_hry($hra);
            last;
        }
    }
    exit;
}



# Seskupit hry podle prvního třídícího kritéria.
# Druhým kritériem je vždy abeceda, ale předpokládáme, že podle ní už hry za nás seřadil Microsoft Access před exportem.
# Kdybychom si abecední řazení chtěli dělat sami, narazíme na problémy s Unicodem a systémovým locale.
$skupiny = seskupit($hry, \%pole);



# Vypsat hry.
if($pole{razeni} ne "abecedne" && $pole{razeni} ne "")
{
    foreach my $skupina (@{$skupiny})
    {
        print("<h2>$skupina->{nadpis}</h2>\n");
        print("<ol>\n");
        foreach my $hra (@{$skupina->{hry}})
        {
            vypsat_odkaz_na_hru_do_seznamu($hra);
        }
        print("</ol>\n");
    }
}
else
{
    my @abeceda;
    foreach my $pismeno ("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", "Ž")
    {
        push(@abeceda, "<a href=\"#$pismeno\">$pismeno</a>");
    }
    print("<p>", join(" | ", @abeceda), "</p>\n");
    print("<ol>\n");
    for($i = 0; $i<=$#{$hry}; $i++)
    {
        $predch = vypsat_odkaz_na_hru_do_seznamu($hry->[$i], $predch);
    }
    print("</ol>\n");
}



# Vypsat závěr stránky.
print <<EOF
<div align=right>
<hr>
<address>&copy; 2002 - 2005, 2013 Dan a Klára Zemanovi</address>
</div>
</body>
</html>
EOF
;



###############################################################################
# Podprogramy
###############################################################################



#------------------------------------------------------------------------------
# Zahodí hry, které neprojdou aktuálním filtrem.
#------------------------------------------------------------------------------
sub filtrovat
{
    my $hry = shift; # odkaz na pole hashů
    my $konfig = shift; # odkaz na hash
    for(my $i = 0; $i<=$#{$hry}; $i++)
    {
        my $hra = $hry->[$i];
        my $vyhodit = 0;
        # Vynechat hry, kterým databáze účast ve webové pokladnici nedoporučuje
        # (buď o nich nemáme téměř žádné informace, nebo dokonce nejde o skutečné hry).
        if($hra->{noweb})
        {
            $vyhodit = 1;
        }
        # Pokud to uživatel požaduje, vynechat hry, ke kterým nemáme pravidla.
        if($konfig->{filtr}{pravidla})
        {
            # Pokusit se najít mezi odkazy odkaz na pravidla.
            my $nalezeno = 0;
            foreach my $odkaz (@{$hra->{_odkazy}})
            {
                if($odkaz->{text} =~ m/^pravidla$/i)
                {
                    $nalezeno = 1;
                    last;
                }
            }
            $vyhodit = !$nalezeno;
        }
        # Pokud to uživatel požaduje, vynechat hry, které nemáme na prodej.
        if($konfig->{filtr}{koupit} && !$hra->{_prodej})
        {
            $vyhodit = 1;
        }
        # Pokud hra neprošla, vyhodit ji.
        if($vyhodit)
        {
            splice(@{$hry}, $i, 1);
            $i--;
        }
    }
}



#------------------------------------------------------------------------------
# Seskupí hry podle prvního třídícího kritéria.
# Druhým kritériem je vždy abeceda, ale předpokládáme, že podle ní už hry za
# nás seřadil Microsoft Access před exportem. Kdybychom si abecední řazení
# chtěli dělat sami, narazíme na problémy s Unicodem a systémovým locale.
#------------------------------------------------------------------------------
sub seskupit
{
    my $hry = shift; # odkaz na pole hashů
    my $konfig = shift; # odkaz na hash
    my %skupiny;
    foreach my $hra (@{$hry})
    {
        my $skupids = zjistit_skupiny($hra, $konfig);
        # Pro každou skupinu si uložit tuto hru do příslušného seznamu.
        foreach my $skupina (@{$skupids})
        {
            unless(exists($skupiny{$skupina}))
            {
                $skupiny{$skupina} = zalozit_skupinu($skupina, $konfig->{razeni});
            }
            push(@{$skupiny{$skupina}{hry}}, $hra);
        }
    }
    my @skupiny = map{$skupiny{$_}}(sort{$skupiny{$a}{trid} cmp $skupiny{$b}{trid}}(keys(%skupiny)));
    return \@skupiny;
}



#------------------------------------------------------------------------------
# Podle požadovaného kritéria zjistí skupiny, do kterých hra patří. Každá hra
# může patřit do několika skupin současně. Vrátí pole identifikátorů skupin.
#------------------------------------------------------------------------------
sub zjistit_skupiny
{
    my $hra = shift; # odkaz na hash
    my $konfig = shift; # odkaz na hash
    my $druh = $konfig->{razeni};
    my @skupiny;
    if($druh eq "pocethracu")
    {
        # Zjistit možné počty hráčů pro tuto hru.
        my $mozne_pocty = $hra->{pocet_hracu};
        # Odstranit ze seznamu počtů nepatřičné znaky.
        $mozne_pocty =~ s/[^0-9,]//g;
        # Rozsekat počty do pole.
        @skupiny = split(/,/, $mozne_pocty);
    }
    elsif($druh eq "vek")
    {
        if($hra->{min_vek})
        {
            $skupiny[0] = $hra->{min_vek};
        }
    }
    elsif($druh eq "cas")
    {
        if($hra->{max_delka})
        {
            $skupiny[0] = $hra->{max_delka};
        }
    }
    elsif($druh eq "rok")
    {
        if($hra->{rok_vydani})
        {
            $skupiny[0] = $hra->{rok_vydani};
        }
    }
    elsif($druh eq "autor")
    {
        if($hra->{autor})
        {
            @skupiny = split(/[,;]\s*/, $hra->{autor});
        }
    }
    elsif($druh eq "vydavatel")
    {
        @skupiny = @{$hra->{_vydavatele}};
    }
    return \@skupiny;
}



#------------------------------------------------------------------------------
# Založí (zatím prázdnou) skupinu her vymezenou určitým kritériem, vytvoří pro
# ni třídící hodnotu (aby bylo možné seřadit seznam skupin) a nadpis.
#------------------------------------------------------------------------------
sub zalozit_skupinu
{
    my $id = shift; # identifikátor skupiny
    my $druh = shift; # kritérium, jehož hodnotou je id
    my %skupina;
    if($druh eq "pocethracu")
    {
        %skupina =
        (
            "nadpis" => "Hry pro $id hráč".($id>0 && $id<5 ? "e" : "ů"),
            "trid" => sprintf("%03d", $id)
        );
    }
    elsif($druh eq "vek")
    {
        %skupina =
        (
            "nadpis" => "Hry od $id let",
            "trid" => sprintf("%03d", $id)
        );
    }
    elsif($druh eq "cas")
    {
        %skupina =
        (
            "nadpis" => "Hry do $id minut",
            "trid" => sprintf("%04d", $id)
        );
    }
    elsif($druh eq "rok")
    {
        %skupina =
        (
            "nadpis" => $id,
            "trid" => sprintf("%05d", $id+5000)
        );
    }
    elsif($druh eq "autor")
    {
        %skupina =
        (
            "nadpis" => $id,
            "trid" => $id
        );
    }
    elsif($druh eq "vydavatel")
    {
        %skupina =
        (
            "nadpis" => $id,
            "trid" => $id
        );
    }
    return \%skupina;
}



#------------------------------------------------------------------------------
# Vrátí název hry, abychom si ho mohli zapamatovat do příště a poznat, kdy
# začíná nové písmeno abecedy.
#------------------------------------------------------------------------------
sub vypsat_odkaz_na_hru_do_seznamu
{
    my $hra = shift; # odkaz na hash
    my $predch = shift; # název předcházející hry (abychom poznali nové písmeno v abecedě)
    if($predch eq "")
    {
        $predch = $hra->{nazev};
    }
    print("<li>");
    # Začíná-li název hry na jiné písmeno než předcházející hra, vygenerovat
    # záložku pro skoky po abecedě.
    my $pismeno = substr($hra->{nazev}, 0, 1);
    $pismeno = "CH" if(substr($hra->{nazev}, 0, 2) =~ m/ch/i);
    if($pismeno ne substr($predch, 0, 1))
    {
        print("<a name=\"$pismeno\"/>\n");
    }
    # U všech her přednostně nabízet dynamickou stránku.
    print("<a href=\"hry.pl?hra=$hra->{kod}\">$hra->{nazev}</a>");
    # Vypsat všechny alternativní názvy hry.
    if(exists($hra->{_dalsi_nazvy}))
    {
        print(" (", join("; ", @{$hra->{_dalsi_nazvy}}), ")");
    }
    # Závěr.
    print("</li>\n");
    return $hra->{nazev};
}



#------------------------------------------------------------------------------
# Zobrazí kořenovou stránku hry.
#------------------------------------------------------------------------------
sub generovat_stranku_hry
{
    my $hra = shift; # odkaz na hash se záznamem hry, jejíž stránka se má generovat
    my $slozka = $hra->{slozka_hrejsi};
    my $pozadi = $hra->{htmlbgr};
    my $text = $hra->{htmltext};
    my $link = $hra->{htmllink};
    my $vlink = $hra->{htmlvlink};
    my $alink = $hra->{htmlalink};
    my $nazev = $hra->{nazev};
    my $dalsi_nazvy = join(", ", @{$hra->{_dalsi_nazvy}});
    print("<html>\n");
    print("<head>\n");
    print("<meta http-equiv=\"Content-Type\" content=\"text/html; charset=utf-8\">\n");
    print("<title>$hra->{nazev}</title>\n");
    print("<meta name=\"keywords\" CONTENT=\"$hra->{nazev}, $hra->{_dalsi_nazvy}, deskové hry, pravidla\">\n");
    print("</head>\n");
    # Nastavit barvy pozadí a popředí.
    my $body = "<body";
    if($pozadi =~ m/\./) # obsahuje-li tečku, je to název souboru
    {
        $body .= " background=\"$koren_hrejsi/$slozka/$pozadi\"";
    }
    elsif($pozadi ne "") # neobsahuje-li tečku, je to kód nebo název barvy
    {
        $body .= " bgcolor=\"$pozadi\"";
    }
    $body .= " text=\"$text\"" if($text ne "");
    $body .= " link=\"$link\"" if($link ne "");
    $body .= " vlink=\"$vlink\"" if($vlink ne "");
    $body .= " alink=\"$alink\"" if($alink ne "");
    $body .= ">";
    $body .= "<b>" if($hry{"$hra: htmltuc"});
    print("$body\n");
    print("Zpět nahoru: [ <a href=\"hry.pl\">seznam her</a> ].\n");
    print("<hr>\n");

    # Pokud existuje, zobrazit barevný nadpis.
    if($slozka ne "" && -f "$koren_system/$slozka/obr/nadpis.gif")

    # if($slozka ne "")# && -f $nadpis) Tahle kontrola nefunguje, protože cesta z pohledu webu není stejná jako skutečná cesta v rámci systému.
    {
        my $nadpis = "$koren_hrejsi/$slozka/obr/nadpis.gif";
        print("<h1 align=center><a name=\"zacatek\"><img src=\"$nadpis\" alt=\"$nazev\"></a></h1>\n");
    }
    else
    {
        print("<h1 align=center><a name=zacatek>$nazev</a></h1>\n");
    }
    my $neboli;
    if($dalsi_nazvy)
    {
        $neboli = $dalsi_nazvy;
        $neboli = "<center>neboli $neboli</center>";
    }
    print("$neboli\n");
    print("<table width=100%><tr><td>\n");
    print("<h2><a name=\"Charakteristika\">Charakteristika</a></h2>\n");
    if($hra->{pocet_hracu} ne "")
    {
        print("<p><b>Počet hráčů:</b> $hra->{pocet_hracu}.\n");
    }
    if($hra->{min_vek}!=0)
    {
        print("<br><b>Doporučený věk:</b> alespoň $hra->{min_vek} let.\n");
    }
    if($hra->{min_delka}!=0)
    {
        if($hra->{min_delka}>=60*24)
        {
             $dnymin = sprintf("%d", ($hra->{min_delka}/60/24)+0.5);
             $dnymax = sprintf("%d", ($hra->{max_delka}/60/24)+0.5);
             printf("<br><b>Délka hry:</b> %s %s.\n", $dnymax==$dnymin ? $dnymax : "$dnymin až $dnymax", $dnymax==1 ? "den" : $dnymax>=2 && $dnymax<=4 ? "dny" : "dnů");
        }
        elsif($hra->{min_delka}>=100)
        {
             $hodmin = sprintf("%.1f", ($hra->{min_delka}/60)+0.05);
             $hodmax = sprintf("%.1f", ($hra->{max_delka}/60)+0.05);
             print("<br><b>Délka hry:</b> $hodmin až $hodmax hod.\n");
        }
        else
        {
            print("<br><b>Délka hry:</b> $hra->{min_delka} až $hra->{max_delka} minut.\n");
        }
    }
    if(scalar(@{$hra->{_vydavatele}})>0)
    {
        print("<br><b>Vydavatel:</b> ", join(", ", @{$hra->{_vydavatele}}), ".\n");
    }
    if($hra->{rok_vydani}!=0)
    {
        print("<br><b>Rok vydání:</b> $hra->{rok_vydani}.\n");
    }
    if($hra->{autor} ne "")
    {
        print("<br><b>Autor:</b> $hra->{autor}.\n");
    }
    if($hra->{oceneni} ne "")
    {
        print("<br><b>Ocenění:</b> $hra->{oceneni}.</p>\n");
    }
    print("<p>$hra->{upoutavka}</p>\n");
    print("<p>$hra->{charakteristika}</p>\n");
    # Vypsat odkazy na stránky o této hře.
    my $odkazy = $hra->{_odkazy};
    print("<ul>\n");
    for(my $i = 0; $i<=$#{$odkazy}; $i++)
    {
        my $odkaz;
        unless($odkazy->[$i]{adresa} =~ m/^(\/|http:)/)
        {
            $odkaz = "$koren_hrejsi/$slozka/";
        }
        $odkaz .= $odkazy->[$i]{adresa};
        print("<li><a href=\"$odkaz\">$odkazy->[$i]{text}</a></li>\n");
    }
    # Upozornit na hry, které máme na prodej.
    if($hra->{_prodej})
    {
        print("<li><a href=\"prodej.pl?hra=$hra->{kod}\">Hru lze koupit</a></li>\n");
    }
    # U odkazů na deskovehry.cz nekontrolujeme, zda jsou funkční. Jednou mohou být.
    print("<li><a href=\"http://www.deskovehry.cz/index.php/$hra->{nazev}\">Tato hra na deskovehry.cz</a></li>\n");
    print("</ul>\n");
    print("</td><td>\n");
    #!!! Chtělo by to kontrolu, že soubor s fotkou existuje!!!
    if($slozka ne "" && -f "$koren_system/$slozka/obr/fotka.jpg")
    {
        print("<img src=\"$koren_hrejsi/$slozka/obr/fotka.jpg\" align=right alt=\"fotografie\">\n");
    }
    print("</td></tr></table>\n");
    print("<hr>\n");
    print("<center>\n");
    print("<address>Vytvořili Dan a Klára Zemanovi pro <a HREF=\"http://obchod.hrejsi.cz/\">Obchod.HrejSi.cz</a></address>\n");
    print("<address>Obsah webových stránek je chráněn autorskými právy. Jeho reprodukce za komerčními účely <b>je zakázána</b>.</address>\n");
    print("<address>The contents of these web pages is copyrighted. Any reproduction for commercial use <b>is prohibited</b>.</address>\n");
    print("<p><a HREF=\"http://obchod.hrejsi.cz/\">Obchod.HrejSi.cz</a>\n");
    print("</center>\n");
    print("</b>\n") if($hry{"$hra: htmltuc"});
    print("</body>\n");
    print("</html>\n");
}



#------------------------------------------------------------------------------
# Generuje HTML kód pro výběr řazení a filtru.
#------------------------------------------------------------------------------
sub generovat_vyber_razeni_a_filtru
{
    my $konfig = shift; # odkaz na hash
    my $formular = 0;
    unless($formular)
    {
        # Zobrazit současné nastavení filtru.
        print("<h2>Současné nastavení filtru</h2>\n");
        my $html;
        if($konfig->{filtr}{pravidla})
        {
            $html .= "<li>pouze hry s&nbsp;elektronickými pravidly na hrejsi.cz</li>\n";
        }
        if($konfig->{filtr}{koupit})
        {
            $html .= "<li>pouze hry, které si můžete koupit na <a href='http://obchod.hrejsi.cz/'>obchod.hrejsi.cz</a></li>\n";
        }
        if($html ne "")
        {
            print("<ul>\n$html</ul>\n");
        }
        else
        {
            print("<p>žádné omezující podmínky</p>\n");
        }
        # Nabídnout rozšíření filtru.
        my $html;
        unless($konfig->{filtr}{pravidla})
        {
            my $href = vytvorit_odkaz($konfig, "filtr+pravidla");
            $html .= "<li><a href=$href>pouze hry s&nbsp;elektronickými pravidly na hrejsi.cz</a></li>\n";
        }
        unless($konfig->{filtr}{koupit})
        {
            my $href = vytvorit_odkaz($konfig, "filtr+koupit");
            $html .= "<li><a href=$href>pouze hry, které si můžete koupit na hrejsi.cz</a></li>\n";
        }
        if($html ne "")
        {
            print("<h2>Přidat podmínku do filtru</h2>\n");
            print("<ul>\n$html</ul>\n");
        }
        # Zobrazit současné nastavení řazení.
        my %raz =
        (
            "pocethracu" => "podle počtu hráčů",
            "vek" => "podle doporučeného minimálního věku",
            "cas" => "podle časové náročnosti",
            "rok" => "podle roku vydání",
            "autor" => "podle autora",
            "vydavatel" => "podle vydavatele",
            "abecedne" => "abecedně"
        );
        print("<h2>Současné nastavení řazení</h2>\n");
        print("<ol>\n");
        if($konfig->{razeni} ne "abecedne" && $konfig->{razeni} ne "")
        {
            print("<li>$raz{$konfig->{razeni}}</li>\n");
        }
        print("<li>abecedně</li>\n");
        print("</ol>\n");
        # Nabídnout změnu řazení.
        $html = "";
        foreach my $razeni ("pocethracu", "vek", "cas", "rok", "autor", "vydavatel")
        {
            unless($konfig->{razeni} eq $razeni)
            {
                my $href = vytvorit_odkaz($konfig, "razeni=$razeni");
                $html .= "<li><a href=$href>$raz{$razeni}</a></li>\n";
            }
        }
        if($html ne "")
        {
            print("<h2>Změnit způsob řazení</h2>\n");
            print("<ul>\n$html</ul>\n");
        }
    }
    else
    # Archív: Dříve pro výběr sloužil formulář, který je sice příjemnější pro
    # uživatele, ale bohužel dělá problémy při generování statického otisku
    # stránek. Pozor, pokud by měl být opět oživen, je třeba mít na paměti, že
    # tato část nebyla aktualizována a neposkytuje tak bohatý výběr jako
    # obyčejná soustava odkazů výše!
    {
        print("<form method=post action=\"hry.pl?formular\">\n");
        print("Řadit\n");
        print("<input type=radio name=radit value=abecedne$abecedne> abecedně |\n");
        print("<input type=radio name=radit value=pocethracu$pocethracu> podle počtu hráčů<br>\n");
        print("<table><tr><td valign=top>Pouze hry</td>\n");
        print("<td><input type=checkbox name=jenspravidly$jenspravidly> od kterých tu máme pravidla<br>\n");
    #    print("<input type=checkbox name=jenlzezahrat$jenlzezahrat> které si na Palubě můžete zahrát<br>\n");
    #    print("<input type=checkbox name=jenlzekoupit$jenlzekoupit> které si na Palubě můžete koupit</td></tr></table>\n");
        print("<input type=submit value=\"Odeslat\">\n");
        print("</form>\n");
    }
}



#------------------------------------------------------------------------------
# Generuje HTML odkaz s novými parametry.
#------------------------------------------------------------------------------
sub vytvorit_odkaz
{
    # Vytvořit si kopii konfigurace.
    my $stary_konfig = shift;
    # Potřebujeme oddělit kopii od originálu, a to na všech úrovních!
    my %konfig = %{$stary_konfig};
    delete($konfig{filtr});
    %{$konfig{filtr}} = %{$stary_konfig->{filtr}};
    # Aplikovat požadované změny.
    while(my $zmena = shift)
    {
        if($zmena =~ m/^filtr\+(.*)/)
        {
            $konfig{filtr}{$1} = 1;
        }
        elsif($zmena =~ m/(.*)=(.*)/)
        {
            $konfig{$1} = $2;
        }
    }
    # Vygenerovat seznam parametrů.
    my @param;
    foreach my $filtr (sort(keys(%{$konfig{filtr}})))
    {
        if($konfig{filtr}{$filtr})
        {
            push(@param, "f$filtr=1");
        }
    }
    foreach my $klic (sort(keys(%konfig)))
    {
        unless($klic eq "filtr")
        {
            push(@param, "$klic=$konfig{$klic}");
        }
    }
    # Vytvořit odkaz v takovém tvaru, aby se dalo napsat <a href=$href>.
    my $href = "\"hry.pl";
    if(scalar(@param))
    {
        $href .= "?".join("&", @param);
    }
    $href .= "\"";
    return $href;
}



#------------------------------------------------------------------------------
# Upraví hash s načtenými parametry.
#------------------------------------------------------------------------------
sub upravit_konfig
{
    my $konfig = shift; # odkaz na hash
    foreach my $klic (keys(%{$konfig}))
    {
        if($klic =~ m/^f(.*)/ && $klic ne "filtr" && $konfig->{$klic}==1)
        {
            $konfig->{filtr}{$1} = 1;
            delete($konfig->{$klic});
        }
    }
}
