# Internetový obchod s hrami / nízkoúrovňové funkce
# Copyright © 2007-2015 Dan Zeman <zeman@ufal.mff.cuni.cz>
# Licence: GNU GPL
# 3.3.2012: začíná přestavba, na jejímž konci by obchod měl mít několik oddělení, hry budou jedno z nich
# 9.4.2015: stěhování na new.kub.cz

package pomoc;
use utf8;
use dzcgi;
require 5.000;
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(resetpar par urlpar odkazpar formpar urlstat odkazstat odsadit statpath_url statpath_sys);



#------------------------------------------------------------------------------
# Hlavní hash s parametry CGI skriptu uložíme zde a ne v hlavním skriptu, aby
# k němu mohly funkce, které kopírují parametry do nových odkazů. S přechodem
# na nový kub, mod_perl a Perl 5.20 totiž přestalo fungovat, že si z těchto
# funkcí saháme přímo na %main::pole. Načtení parametrů do tohoto pole zatím
# zůstává v hlavním programu.
#------------------------------------------------------------------------------
our %parametry;
sub resetpar {%parametry = (); return \%parametry;}
sub par {return \%parametry;}



#------------------------------------------------------------------------------
# Vyrobí relativní URL, které vede zpět na tento skript, ale s jinými
# parametry. Používá se ve funkci odkazpar(), která výstup dále obalí HTML
# značkami <a href=...>...</a>, ale hodí se také uživateli, který potřebuje
# vložit odkaz např. do značky <form>. Toho osvobozuje od globální proměnné
# %main::pole, od znalosti řetězce "prodej.pl" a od modulu dzcgi.
#------------------------------------------------------------------------------
sub urlpar
{
    # Parametry funkce popisují nové parametry, se kterými se má zavolat tento skript, ve tvaru atribut=hodnota.
    my $parametry = dzcgi::sestavit_parametry(par(), @_);
    # Pro neprázdný košík použít alternativní název skriptu, na který nemůžou roboti.
    my $skript = $parametry =~ m/kosik=/ ? 'prodej0.pl' : 'prodej.pl';
    return "$skript?$parametry";
}



#------------------------------------------------------------------------------
# Vyrobí odkaz, který vede zpět na tento skript, ale s jinými parametry.
#------------------------------------------------------------------------------
sub odkazpar
{
    my $text = shift;
    # Ostatní parametry funkce popisují nové parametry, se kterými se má zavolat tento skript, ve tvaru atr=hodnota
    my $url = urlpar(@_);
    return "<a href=\"$url\">$text</a>";
}



#------------------------------------------------------------------------------
# Vygeneruje pro každý neprázdný parametr CGI neviditelné pole formuláře,
# kterým se dá tento parametr předat dál. Neviditelná pole je vhodné
# vygenerovat na začátku formuláře, aby je bylo možné v případě potřeby přebít
# novými hodnotami.
#------------------------------------------------------------------------------
sub formpar
{
    my $konfig = shift; # odkaz na hash s dosavadními parametry skriptu
    if($konfig eq "")
    {
        $konfig = par();
    }
    my $html;
    foreach my $parametr (keys(%{$konfig}))
    {
        unless($konfig->{$parametr} =~ m/^\s*$/)
        {
            $html .= "<input type=hidden name=\"$parametr\" value=\"$konfig->{$parametr}\">\n";
        }
    }
    return $html;
}



#------------------------------------------------------------------------------
# Vyrobí URL do statických stránek na témže serveru.
#------------------------------------------------------------------------------
sub urlstat
{
    my $cesta = shift; # absolutní cesta odkazu v rámci serveru
    $cesta =~ s-^/--;
    return "http://hrejsi.cz/$cesta";
}



#------------------------------------------------------------------------------
# Vyrobí odkaz do statických stránek na témže serveru.
#------------------------------------------------------------------------------
sub odkazstat
{
    my $text = shift;
    my $cesta = shift; # absolutní cesta odkazu v rámci serveru
    my $url = urlstat($cesta);
    return "<a href=\"$url\">$text</a>";
}



#------------------------------------------------------------------------------
# Odsadí každý řádek textu o udaný počet mezer. Čistě estetická funkce, kterou
# používáme pro odsazení částí zdrojáku HTML, které jsme získali jako výstup
# funkcí, ale vzhledem ke kontextu by měly být odsazené. Na vzhled výsledného
# dokumentu v prohlížeči to nemá žádný vliv.
#------------------------------------------------------------------------------
sub odsadit
{
    my $text = shift;
    my $n = shift; # kolik mezer vložit na začátek každého řádku
    my $mezery = join("", map {" "} (1..$n));
    $text =~ s/^/$mezery/mg;
    return $text;
}



BEGIN
{
    # Zjistit cestu pro odkazování na statické stránky hrejsi.
    # Nejdřív zjistit cestu ke konfiguračnímu souboru, kde je to napsáno.
    # __FILE__ obsahuje úplnou cestu k tomuto modulu, např. '/s/w/lib/cgi/hry/pomoc.pm'.
    my $cfgcesta = __FILE__;
    $cfgcesta =~ s-/[^/]+/pomoc.pm$-/cgi.cfg-;
    open(KONFIG, $cfgcesta) or $konfig{error} = "Nelze číst $cfgcesta: $! (pwd = ".`pwd`.', modulepath = '.__FILE__.')';
    while(<KONFIG>)
    {
        if(m/(\S+)\s*=\s*([^\r\n]*)/)
        {
            $konfig{$1} = $2;
        }
    }
    close(KONFIG);
    $koren_url = $konfig{ccesta_html_obchod};
    # $koren_url smí být prázdný. V tom případě je to kořen webu na dané doméně.
    # Pokud ale máme neprázdné chybové hlášení, pak předpokládáme, že je prázdný omylem.
    if((!defined($koren_sys) || $koren_sys eq '') && defined($konfig{error}))
    {
        $koren_url = "<span style='color:red'>$konfig{error}</span>";
    }
    # $koren_sys nesmí být prázdný, protože statické stránky určitě neleží v kořeni systému souborů.
    $koren_sys = $konfig{scesta_html_obchod};
    ###!!! Nový kub.cz 2015: Zadrátovávám cesty přímo sem. Možná dočasně, možná ne.
    ###!!! Otázka je, zda má smysl udržovat je v samostatném konfiguračním souboru.
    ###!!! Ale pozor, to Jakubovo "testapp" zřejmě taky není trvalé řešení,
    ###!!! a navíc se tu teď zabýváme pouze obrázky, ale dotyčné proměnné mají vést i na statické stránky s pravidly her apod.!
    $koren_sys = '/var/web/hrejsi.cz/testapp';
    $koren_url = 'http://testapp.hrejsi.cz';
    if(!defined($koren_sys) || $koren_sys eq '')
    {
        if(!defined($konfig{error}))
        {
            $konfig{error} = "Konfigurace $cfgcesta nedefinovala položku scesta_html_obchod.";
        }
        $koren_sys = "<span style='color:red'>$konfig{error}</span>";
    }
}



#------------------------------------------------------------------------------
# Zjistí cestu ke statickým stránkám v rámci URL.
#------------------------------------------------------------------------------
sub statpath_url
{
    return $koren_url;
}



#------------------------------------------------------------------------------
# Zjistí cestu ke statickým stránkám v rámci URL.
#------------------------------------------------------------------------------
sub statpath_sys
{
    return $koren_sys;
}



1;