# Internetový obchod nejen s hrami / košík. Veškeré výpočty ceny včetně slev a poštovného se dějí tady.
# Copyright © 2007-2017 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 kosik;
use utf8;
use Encode;
use pomoc;



BEGIN
{
    # Globální konstanty
    $glob_mnozstevni_sleva_nad = 15000; # při nákupu nad tolik Kč je množstevní sleva
    $glob_mnozstevni_sleva     = 5; # procenta
    # Při hodnotě objednávky (bez dopravy) vyšší než $max je doprava zdarma.
    my $max = 2500;
    $glob_doprava_zdarma = $max;
    # U všech druhů dopravy lze rozlišit výši dopravného v závislosti na hodnotě objednávky.
    # Trojice čísel v hranatých závorkách znamená po řadě:
    #   1. mezní cena objednávky bez dopravy; pokud cena překročí tuto mez, použije se další řádek; pokud je to poslední řádek, je doprava zdarma.
    #   2. cena dopravy bez dobírky (placeno předem převodem), jestliže je cena objednávky menší nebo rovna dané mezní hodnotě.
    #   3. cena dopravy s dobírkou (placeno v hotovosti při převzetí zboží), jestliže je cena objednávky menší nebo rovna dané mezní hodnotě.
    #
    # Naposledy aktualizované ceny: 21.11.2023
    %glob_doprava_sazebnik =
    (
        # Vyzvednutí v Jenštejně je zdarma.
        'jenstejn'      => [[   0,   0,   0]],
        # Vlastní pobočka Zásilkovny!.
        'ulozenka'      => [[$max,  88,  119]],
        # Vlastní pobočka Zásilkovny!.
        'zasilkovna'    => [[$max,  98,  129]],
        # Vlastní slovenská pobočka Zásilkovny!.
        'zasilkovnask'    => [[$max,  128,  159]],
        # Partnerské výdejní místo Uloženky v Česku.
        'dpdcz'         => [[$max,  78,  109]],
        # Partnerské výdejní místo Uloženky na Slovensku.
        'dpdsk'         => [[$max,  128, 149]],
        # Poštomat InTime InPost (v Česku Poštomat, na Slovensku balíkomat).
        #'intimecz'      => [[$max,  78, 119]],
        #'intimesk'      => [[$max, 138, 169]],
        # Od 2019 - nejlevnější doručení na adresu. My určíme přepravce. Dříve: 
                  # Česká pošta obyčejně (doporučený dopis/balíček, cenný balík).
        'posta'         => [
                               [ 800, 118, 149],
                               [$max, 128, 169]
                           ],
        # Česká pošta balík Do ruky.
        'posta_do_ruky' => [[$max, 158, 199]],
        # Česká pošta balík Na poštu.
        'posta_na_postu'=> [[$max, 148, 189]],
        # DPD dodání na adresu.
        'dpd'           => [[$max,  128, 169]]
    );
    # Možnost volby expresního nebo zrychleného vyřízení rušíme. Místo toho si zákazník může vybrat jeden z rychlejších způsobů dopravy.
    # Z výpočtů zatím nezmizela možnost přičíst příplatek za zrychlené vyřízení, ale v informacích pro zákazníka (kecy.pm)
    # a v objednávkovém formuláři (objednavka.pm) se už zrychlené vyřízení nezmiňuje.
    $glob_umime_zrychlene = 0; # nulou lze globálně vypnout zrychlené a expresní zasílání např. o dovolené
    $glob_priplatek_zrychlene = 0; # doručení do 3 pracovních dnů (jen u her, které jsou skladem)
    $glob_priplatek_expres = 0; # doručení do 2 pracovních dnů (jen u her, které jsou skladem)
}



#------------------------------------------------------------------------------
# Zjistí cenu dopravy na základě ceny objednávky, zvoleného způsobu dopravy a
# platby. Navíc vrátí informaci, zda bylo poštovné zdarma kvůli vysoké hodnotě
# objednávky.
#------------------------------------------------------------------------------
sub zjistit_cenu_dopravy
{
    my $objednavka = shift;
    my $hodnota = $objednavka->{celkem};
    my $doprava = 0;
    # Rozlišit případy, kdy je poštovné zdarma, protože zákazník si zboží vyzvedne osobně,
    # a kdy je zdarma, protože je to velký nákup, na který se vztahuje sleva ($odpusteno==1).
    # (Jen ve druhém případě totiž budeme chtít zákazníka informovat, jaké výhody se mu dostalo.)
    my $odpusteno = 0;
    # Vybrat sloupec sazebníku (kteréhokoli) podle zvoleného způsobu placení.
    my $platba = $objednavka->{platba} eq 'převodem' ? 1 : 2;
    # Upravit identifikátor způsobu dopravy. U Uloženky je různá cena na různých pobočkách, proto musíme znát i druh pobočky.
    my $odber = $objednavka->{odber};
    if($odber eq 'ulozenka')
    {
        # Partnerské místo Uloženky v Česku.
        if($objednavka->{ulozenka_branches} =~ m/^dpdcz/)
        {
            $odber = 'dpdcz';
        }
        # Partnerské místo Uloženky na Slovensku.
        elsif($objednavka->{ulozenka_branches} =~ m/^dpdsk/)
        {
            $odber = 'dpdsk';
        }
        # V ostatních případech jde o vlastní pobočku Uloženky.
    }
    elsif($odber eq 'intime')
    {
        # Balíkomat na Slovensku.
        if($objednavka->{ulozenka_branches} =~ m/^intime_pm_SK/)
        {
            $odber = 'intimesk';
        }
        # Poštomat v Česku.
        else
        {
            $odber = 'intimecz';
        }
    }
    elsif($odber eq 'zasilkovna')
    {
        # Zasílání na Slovensko je dražší
        if($objednavka->{country} eq 'sk')
        {
            $odber = 'zasilkovnask';
        }
    }
    # Vybrat sazebník podle zvoleného způsobu dopravy.
    # Pokud není znám způsob odběru nebo pokud jde o osobní odběr v Jenštejně, je poštovné nulové.
    $odber = 'jenstejn' if(!exists($glob_doprava_sazebnik{$odber}));
    my $sazebnik = $glob_doprava_sazebnik{$odber};
    # Stejně tak je nulové poštovné, jestliže celková cena objednávky překročila určitou mez.
    if($hodnota <= $glob_doprava_zdarma)
    {
        for(my $i = 0; $i<=$#{$sazebnik}; $i++)
        {
            if($hodnota <= $sazebnik->[$i][0])
            {
                $doprava = $sazebnik->[$i][$platba];
                last;
            }
        }
    }
    elsif($odber ne 'jenstejn')
    {
        $odpusteno = 1;
    }
    # Připočítat případný expresní příplatek (i u poštovného zdarma!)
    # (Poznámka: V říjnu 2014 bylo zrychlené zpracování zrušeno, protože jsme začali nabízet rychlé služby České pošty,
    # ale je možné, že ho před Vánocemi zase zavedeme, protože půjde ještě o přednostní zpracování na naší straně.)
    if($objednavka->{rychlost} eq 'zrychleně')
    {
        $objednavka->{postovne} += $glob_priplatek_zrychlene;
    }
    elsif($objednavka->{rychlost} eq 'expresně')
    {
        $objednavka->{postovne} += $glob_priplatek_expres;
    }
    return ($doprava, $odpusteno);
}



#------------------------------------------------------------------------------
# Zkontroluje slevový kód. Jestliže je platný, vrátí informaci o slevě, ale do
# záznamu o objednávce nic nezapisuje, to nechá na volajícím. Jestliže je ale
# neplatný, vrátí nulu a do @{$objednavka->{chyby}} přidá chybové hlášení.

# Nové, zatím neaktivní zpracování slevových kódů: Kódy, jejich platnost a
# parametry slevy, kterou způsobí, jsou uvedeny v databázi.
# Začal jsem to chystat 15.3.2012, kdy jsem Klárce vytvořil tabulku Slevové
# kódy v databázi Hry (nikoli Obchod!). Tato tabulka se dokonce exportuje na
# Kub jako hry.slevkody, zůstalo to ale nedodělané. Teď (6.12.2014) to tedy
# doděláme.
#------------------------------------------------------------------------------
sub slevkod
{
    my $databaze = shift; # databáze, ve které jsou popsané slevové kódy
    my $objednavka = shift;
    # Návratové hodnoty:
    ###!!! Systém návratových hodnot bude potřeba změnit, protože např. vůbec nepodporuje jednorázové dárkové poukazy.
    # = -1 ... použít klubovou cenu
    # = 0 .... prázdný kód, v pořádku, ale žádná sleva
    # > 0 .... udává výši slevy v procentech
    # 'chyba' ... neplatný kód, @{$objednavka->{chyby}} obsahuje chybové hlášení
    # Je-li slevový kód prázdný, nemusíme nic dalšího kontrolovat.
    return 0 if($objednavka->{slevkod} =~ m/^\s*$/);
    # Načíst z databáze seznam známých slevových kódů.
    my @nazvy = ('kod', 'jednorazovy', 'platny_od', 'platny_do', 'hodnota', 'sleva', 'cenik');
    my $slevkody = dzsql::dotaz($databaze, @nazvy, 'slevkody');
    # Zahodit všechny kódy kromě toho, který byl vyplněn ve stávající objednávce.
    my @odpovidajici_kody = grep {$_->{kod} eq $objednavka->{slevkod}} @{$slevkody};
    if(scalar(@odpovidajici_kody)==0)
    {
        push(@{$objednavka->{chyby}}, 'Neznámý slevový kód.');
        return 'chyba';
    }
    # Měl by nám zbýt nejvýše jeden řádek, protože databáze požaduje, aby kódy byly jedinečné.
    my $dbkod = $odpovidajici_kody[0];
    # Zkontrolovat datum platnosti kódu.
    my $datum_objednavky = substr($objednavka->{cas}, 0, 8); # např. "20141201"
    my $datum_do = '99999999';
    my $datum_od = '00000000';
    if($dbkod->{platny_do} =~ m/^(\d+)\.(\d+)\.(\d+)$/)
    {
        my $den = $1;
        my $mesic = $2;
        my $rok = $3;
        $datum_do = sprintf("%04d%02d%02d", $rok, $mesic, $den);
    }
    if($dbkod->{platny_od} =~ m/^(\d+)\.(\d+)\.(\d+)$/)
    {
        my $den = $1;
        my $mesic = $2;
        my $rok = $3;
        $datum_od = sprintf("%04d%02d%02d", $rok, $mesic, $den);
    }
    if($datum_objednavky > $datum_do)
    {
        push(@{$objednavka->{chyby}}, "Platnost slevového kódu $objednavka->{slevkod} vypršela $dbkod->{platny_do}.");
        return 'chyba';
    }
    if($datum_objednavky < $datum_od)
    {
        push(@{$objednavka->{chyby}}, "Slevový kód $objednavka->{slevkod} platí až od $dbkod->{platny_od}.");
        return 'chyba';
    }
    # Slevový kód nelze aplikovat na klubovou cenu.
    if($objednavka->{sleva_org_deti})
    {
        push(@{$objednavka->{chyby}}, 'Slevový kód nelze uplatnit na klubové ceny pro organizace pracující s dětmi.');
        return 'chyba';
    }
    # Pokud jsme se dostali až sem, slevový kód je platný.
    # Vrátit výši slevy v procentech.
    ###!!! Zatím neumíme to, co šlo dřív, totiž zapnout klubové ceny bez ohledu na to, zda jde o organizaci pracující s dětmi (vrátili bychom -1).
    ###!!! Také zatím neumíme jednorázové dárkové poukazy (využití by se muselo promítnout do databáze) na konkrétní částku.
    if($dbkod->{sleva} > 0)
    {
        return $dbkod->{sleva};
    }
    else
    {
        push(@{$objednavka->{chyby}}, 'Slevový kód je podle databáze platný, ale zřejmě došlo k systémové chybě při jeho zpracování, protože výsledkem je nulová sleva. Omlouváme se. Prosím obraťte se mailem na obchod@hrejsi.cz.');
        #return 0; # sleva 0 %
        return 'chyba';
    }
}



#------------------------------------------------------------------------------
# Staré zpracování slevových kódů, které jsou popsané natvrdo ve zdrojáku.
# 6.12.2014 ho vypínám, ale ještě nemažu, dokud neotestujeme, že nové
# zpracování s využitím databáze (viz výše) funguje.

# Zkontroluje slevový kód. Jestliže je platný, vrátí informaci o slevě, ale do
# záznamu o objednávce nic nezapisuje, to nechá na volajícím. Jestliže je ale
# neplatný, vrátí nulu a do @{$objednavka->{chyby}} přidá chybové hlášení.
#------------------------------------------------------------------------------
sub slevkod_stare_zpracovani
{
    my $objednavka = shift;
    # Zatím byly vydány tyto slevové kódy (bez rozlišení malých a velkých písmen):
    # DES7121, ZAK7121, zak.PF09, DES4839, JENOBC
    # Slevové kódy mají omezenou platnost. První dva platily do 1.12.2007,
    # ale např. DES7121 byl později recyklován a jeho platnost obnovena do 1.12.2010.
    # Slevové kódy typicky není možné aplikovat na klubové, členské ani hermanské ceny.
    # Slevu také nelze použít na akční zboží (má zaškrtnuté políčko sleva). ###!!! Ale mám pocit, že tohle pravidlo skripty zatím ignorují!
    # Kód zak.PF09 platí od 1.1.2009 do 6.6.2009 a způsobuje, že se použije klubový ceník bez ohledu na to,
    # zda je zákazník členem Paluby nebo organizací pro volný čas dětí a mládeže. Podobně kód zak.PF10.
    my $vysledek = 0;
    # Návratové hodnoty:
    # = -1 ... použít klubovou cenu
    # = 0 .... prázdný kód, v pořádku, ale žádná sleva
    # > 0 .... udává výši slevy v procentech
    # 'chyba' ... neplatný kód, @{$objednavka->{chyby}} obsahuje chybové hlášení
    if($objednavka->{slevkod} =~ m/^DES(7121|4839)$/i)
    {
        # Tento slevový kód je platný do 1.12.2014 včetně.
        if(substr($objednavka->{cas}, 0, 8) > 20141201)
        {
            push(@{$objednavka->{chyby}}, "Platnost slevového kódu $objednavka->{slevkod} vypršela 1.12.2014.");
        }
        # Slevový kód nelze aplikovat na klubovou cenu.
        elsif($objednavka->{sleva_org_deti})
        {
            push(@{$objednavka->{chyby}}, 'Slevový kód nelze uplatnit na klubové ceny.');
        }
        else
        {
            # Tento slevový kód způsobuje slevu 10 %.
            # (DES7121 původně měl 5 %, ale na Deskohraní 2013 Radka vydávala kód DES4839 a Klárka řekla, že na něj mám dát 10 %.)
            $vysledek = 10;
        }
    }
    elsif($objednavka->{slevkod} =~ m/^ZAK\.PF10$/i)
    {
        # Tento slevový kód je platný do 6.6.2010 včetně.
        if(substr($objednavka->{cas}, 0, 8) > 20100606)
        {
            push(@{$objednavka->{chyby}}, 'Platnost slevového kódu ZAK.PF10 vypršela 6.6.2010.');
        }
        else
        {
            # Tento slevový kód způsobí použití klubové ceny bez ohledu na to, zda jde o organizaci pracující s dětmi.
            $vysledek = -1;
        }
    }
    # Slevový kód pro čtenáře Jenštejnského občasníku není zatím časově omezen.
    elsif($objednavka->{slevkod} =~ m/^JENOBC$/i)
    {
        # Slevový kód nelze aplikovat na klubovou cenu.
        if($objednavka->{sleva_org_deti})
        {
            push(@{$objednavka->{chyby}}, 'Slevový kód nelze uplatnit na klubové ceny.');
        }
        else
        {
            # Tento slevový kód způsobuje slevu 10 %.
            $vysledek = 10;
        }
    }
    # Jediný povolený neznámý kód je prázdný.
    elsif($objednavka->{slevkod} !~ m/^\s*$/)
    {
        push(@{$objednavka->{chyby}}, 'Neznámý slevový kód.');
        $vysledek = 'chyba';
    }
    return $vysledek;
}



#------------------------------------------------------------------------------
# Převede obsah košíku z řetězcového zápisu používaného v parametrech CGI
# (1x37a5x152) na pole hashů. Nic jiného nedělá, tedy se ani nesnaží dívat do
# databáze na názvy zboží. Díky tomu ale taky nepotřebuje odkaz na databázi ani
# ostatní parametry CGI.
#------------------------------------------------------------------------------
sub dekodovat
{
    my $kosik = shift; # řetězcový zápis obsahu košíku
    my @kosik = split(/a/, $kosik);
    # Posčítat počty jednotlivých druhů zboží.
    # (Jeden druh zboží se v zápisu mohl vyskytnout opakovaně.)
    my %kosik;
    foreach my $radek (@kosik)
    {
        my ($pocet, $vec) = split(/x/, $radek);
        $kosik{$vec} += $pocet;
    }
    # Nyní převést hash na pole, protože košík budeme chtít procházet, ne v něm vyhledávat.
    splice(@kosik);
    my @klice = sort {$a <=> $b} (keys(%kosik));
    foreach my $klic (@klice)
    {
        # Hry jsou ve staré databázi a kód zboží se skládá pouze z čísel.
        # Ostatní zboží je v nové databázi a kód začíná písmenem "O" (jako "obchod").
        my $db = 'hry';
        my $kod = $klic;
        my $pocet = $kosik{$klic};
        if($kod =~ m/^O(\d+)$/)
        {
            $db = 'obchod';
            $kod = $1;
        }
        my %zaznam =
        (
            'db'    => $db,
            'kod'   => $kod,
            'pocet' => $pocet
        );
        push(@kosik, \%zaznam);
    }
    return \@kosik;
}



#------------------------------------------------------------------------------
# Převede obsah košíku z pole hashů na řetězcový zápis používaný v parametrech
# CGI (1x37a5x152).
#------------------------------------------------------------------------------
sub zakodovat
{
    my $kosik = shift; # odkaz na pole hashů
    # Hry jsou ve staré databázi a kód zboží se skládá pouze z čísel.
    # Ostatní zboží je v nové databázi a kód začíná malým písmenem "o" (jako "obchod").
    my $zkosik = join('a', map {my $kod = $_->{kod}; if($_->{db} eq 'obchod') {$kod = 'O'.$kod} $_->{pocet}.'x'.$kod} (grep {$_->{pocet}>0} (@{$kosik})));
    return $zkosik;
}



#------------------------------------------------------------------------------
# Upraví v zakódovaném košíku počet jedné položky a vrátí nový zakódovaný
# košík. (Může jít i o novou položku, která dosud v košíku nebyla.) Používá se
# při generování odkazů "přidat do košíku".
#------------------------------------------------------------------------------
sub upravit_pocet
{
    my $zkosik = shift; # řetězec kódující košík
    my $odd = shift; # oddělení obchodu (z něj zjistíme, ke které databázi se vztahuje kód zboží)
    my $kod = shift; # kód položky
    my $pocet = shift; # nový počet nebo úprava počtu
    my $delta = shift; # 1 ... $pocet obsahuje požadavek na změnu aktuálního počtu; 0 ... nový počet, starý zahodit
    my $db = $odd eq 'hry' ? 'hry' : 'obchod';
    my $kosik = dekodovat($zkosik);
    my $nalezeno = 0;
    for(my $i = 0; $i<=$#{$kosik}; $i++)
    {
        my $polozka = $kosik->[$i];
        if($polozka->{db} eq $db && $polozka->{kod}==$kod)
        {
            $nalezeno = 1;
            if($delta)
            {
                $polozka->{pocet} += $pocet;
            }
            else
            {
                $polozka->{pocet} = $pocet;
            }
            # Jestliže počet dané položky v košíku klesl na nebo pod nulu, odstranit položku z košíku.
            if($polozka->{pocet}<=0)
            {
                splice(@{$kosik}, $i, 1);
            }
            last;
        }
    }
    if(!$nalezeno && $pocet>0)
    {
        my %zaznam =
        (
            'db'    => $db,
            'kod'   => $kod,
            'pocet' => $pocet
        );
        push(@{$kosik}, \%zaznam);
    }
    return zakodovat($kosik);
}



#------------------------------------------------------------------------------
# Zjistí v databázi názvy a ceny zboží a připíše je k záznamům o zboží
# v košíku. Potřebuje znát parametry CGI, aby věděla, jaké slevy se mají na
# zboží aplikovat. Vlastní košík však z parametrů CGI nečte, ten chce dostat už
# dekódovaný. Do zvláštního hashe pak zapíše další dopočítané vlastnosti
# objednávky (celkovou cenu, množstevní slevy apod.)
#------------------------------------------------------------------------------
sub dopocitat
{
    # Databáze jsou momentálně dvě (her a ostatního zboží) a my potřebujeme obě.
    my $hdb = shift;
    my $odb = shift;
    my $kosik = shift; # odkaz na pole hashů (dekódovaný košík)
    my $objednavka = shift; # odkaz na cílový hash
    #--------------------------------------------------------------------------
    # V první části vyplníme v objednávce položky, které nezávisí na konkrétním
    # zboží, a mají tak alespoň teoreticky smysl i s prázdným košíkem.
    # Nevyžadují přístup do databází.
    # Byl zadán slevový kód? Pokud je platný, nastavit výši slevy.
    my $pouzit_klubovou_cenu = $objednavka->{sleva_org_deti};
    # Slevové kódy jsou popsané v databázi Hry, i když bych je výhledově rád přestěhoval do databáze Obchod.
    my $slevkod = slevkod($hdb, $objednavka);
    if($slevkod<0)
    {
        $pouzit_klubovou_cenu = 1;
    }
    elsif($slevkod>0)
    {
        # Výše slevy v procentech.
        $objednavka->{sleva_kod} = $slevkod;
    }
    # Uložit do objednávky odkaz na dekódovaný košík.
    $objednavka->{kosik} = $kosik;
    # Zbytek už závisí na obsahu košíku. Pokud je košík prázdný, skončit.
    # Ušetříme si dotazy SQL, které by stejně neměly co vrátit, a dopočítávat taky nebude co.
    return $objednavka if(scalar(@{$kosik})==0);
    #--------------------------------------------------------------------------
    # Najít zboží z košíku v příslušných databázích a opsat údaje z databází.
    # Vyhodit neznámé položky a položky, které se nedají koupit.
    my @hkosik = propojit_kosik_s_databazi($hdb, 'hry', $kosik);
    my @okosik = propojit_kosik_s_databazi($odb, 'obchod', $kosik);
    @{$kosik} = (@hkosik, @okosik);
    # Pokud v košíku nezbyla žádná položka, skončit.
    return unless(scalar(@{$kosik})>0);
    # Sledovat, zda máme vše v dostatečném množství skladem na Černém Mostě.
    # Pokud ano, budeme moci zákazníkovi nabídnout expresní zaslání.
    my $skladem = 1;
    foreach my $k (@{$kosik})
    {
        # Zjistit cenu po slevě.
        $k->{jednotkova_cena} = $pouzit_klubovou_cenu ? $k->{clenska_cena} : $k->{prodejni_cena};
        $k->{cena_celkem} = $k->{pocet} * $k->{jednotkova_cena};
        if($objednavka->{sleva_kod} && !$k->{sleva})
        {
            $k->{cena_pred_slevou_kodem} = $k->{cena_celkem};
            $k->{cena_celkem} -= int($k->{cena_celkem} * $objednavka->{sleva_kod} / 100 + 0.5);
        }
        # Ověřit zásoby.
        if($k->{cerny_most}<$k->{pocet})
        {
            $skladem = 0;
        }
    }
    #--------------------------------------------------------------------------
    # Podle parametrů CGI zjistit nároky na slevy, stanovit výši poštovného a celkovou cenu.
    # Vše uložit do cílového hashe, na který jsme dostali odkaz ($objednavka).
    $objednavka->{skladem_cerny_most} = $skladem;
    # Vypočítat celkovou cenu zboží v košíku.
    $objednavka->{celkem} = 0;
    foreach my $vec (@{$kosik})
    {
        $objednavka->{celkem} += $vec->{cena_celkem};
    }
    $objednavka->{mezisoucet} = $objednavka->{celkem};
    # Přičíst poštovné.
    ($objednavka->{postovne}, $objednavka->{postovne_zdarma}) = zjistit_cenu_dopravy($objednavka);
    $objednavka->{celkem} += $objednavka->{postovne};
    # Započítat množstevní slevu.
    # Předpokládáme, že množstevní sleva se aplikuje při vyšším nákupu,
    # než při jakém se odpouští poštovné, takže se nemusíme bát, že bychom
    # výši slevy počítali i z poštovného.
    $objednavka->{mnozstevni_sleva} = $objednavka->{celkem}>=$glob_mnozstevni_sleva_nad ? int($objednavka->{celkem}*$glob_mnozstevni_sleva/100) : 0;
    $objednavka->{celkem} -= $objednavka->{mnozstevni_sleva};
    return $objednavka;
}



#------------------------------------------------------------------------------
# Načte z databáze údaje o zboží v košíku.
#------------------------------------------------------------------------------
sub propojit_kosik_s_databazi
{
    my $databaze = shift; # odkaz na databázi
    my $dbid = shift; # 'hry' nebo 'obchod' identifikuje část košíku, kterou v této databázi najdeme
    my $kosik = shift; # odkaz na pole s dekódovanými položkami košíku
    # Vybrat z košíku pouze zboží, které se dá nalézt v dané databázi.
    my @dkosik = grep {$_->{db} eq $dbid} (@{$kosik});
    # Nahashovat zboží v košíku pro snadný přístup.
    my %kosik;
    foreach my $vec (@dkosik)
    {
        $kosik{$vec->{kod}} = $vec;
        # Kromě názvu databáze si do košíku uložit i odkaz na objekt databáze.
        # Bude se hodit, až budeme ukládat hotovou objednávku a budeme chtít změnit stav skladových zásob.
        $vec->{dbobj} = $databaze;
    }
    # Získat z databáze přehled zboží.
    my @nazvy = qw(kod nazev prodejni_cena clenska_cena nelze_koupit sleva cerny_most);
    my $filtr = join(' OR ', map {"(kod = '$_->{kod}')"} @dkosik);
    my $zdroj = $filtr ? "zbozi WHERE $filtr" : "zbozi";
    my $zbozidb = dzsql::dotaz($databaze, @nazvy, $zdroj);
    # Projít výsledek dotazu a přepsat údaje do košíku.
    foreach my $z (@{$zbozidb})
    {
        # Přeskočit zboží, které nelze koupit. Protože se do košíku nedostane
        # název zboží, poznáme později, že se toto zboží má z košíku vyhodit.
        next if($z->{nelze_koupit});
        my $k = $kosik{$z->{kod}};
        foreach my $nazev (@nazvy)
        {
            $k->{$nazev} = $z->{$nazev};
        }
    }
    # Vyházet z košíku neznámé zboží a zboží, které nelze koupit.
    # (O těchto chybách nebudeme uživatele informovat, jen bychom ho mátli.
    # Klidně mohl mít v košíku vyřazené zboží, aniž o tom věděl, pokud se sem
    # dostal přes zastaralý odkaz někde na síti, který v sobě kódoval obsah košíku.)
    @dkosik = grep {$_->{nazev} ne ''} @dkosik;
    # Ke každé položce v košíku vyplnit, z jakého oddělení obchodu pochází.
    if($dbid eq 'hry')
    {
        # Zboží z databáze hry je vždy z oddělení hry.
        foreach my $vec (@dkosik)
        {
            $vec->{oddeleni} = 'hry';
        }
    }
    else
    {
        # V databázi obchod je tabulka skupiny (zhruba odpovídá tabulce hry v databázi hry), v ní je sloupec oddeleni s hodnotami např. "korálky" nebo "puzzle".
        ###!!! Tenhle dotaz by to chtělo zahrnout pod dotaz nahoře, abychom se nedotazovali databáze zbytečně mnohokrát.
        foreach my $vec (@dkosik)
        {
            my $vecdb = dzsql::dotaz($databaze, 'oddeleni', "zbozi INNER JOIN skupiny ON zbozi.kod_skupiny = skupiny.kod WHERE zbozi.kod = $vec->{kod}");
            if(scalar(@{$vecdb})==1)
            {
                $vec->{oddeleni} = $vecdb->[0]{oddeleni};
            }
        }
    }
    return @dkosik;
}



#------------------------------------------------------------------------------
# Vygeneruje HTML s obsahem nákupního košíku. Tato široká verze je vhodná do
# hlavní části stránky, např. při uzavírání objednávky.
#------------------------------------------------------------------------------
sub html
{
    my $objednavka = shift; # odkaz na hash: vnořené pole hashů kosik: kod_zbozi nazev_zbozi jednotkova_cena pocet cena_celkem
    my $povolit_zmeny = shift; # mají se vygenerovat odkazy na přidávání/ubírání z košíku?
    my $html;
    # Pokud je košík neprázdný, vypsat obsah. Jinak jen informaci o prázdném košíku.
    if(scalar(@{$objednavka->{kosik}}))
    {
        # Projít košík a vypsat jeho obsah.
        # O některých úkonech předpokládáme, že k nim došlo v okamžiku, kdy se převáděl
        # obsah košíku z parametrů cgi do hashe objednavka:
        # - uspořádání pole zboží např. podle názvů zboží
        # - odstranění zboží, které nemáme v nabídce (v parametrech mohlo být např. kvůli nacachovaným stránkám u vyhledávačů)
        $html .= "<table border=0>\n";
        my $odsazeni = '';
        foreach my $vec (@{$objednavka->{kosik}})
        {
            $html .= "<tr>";
            # Umožnit uživateli změnit v objednávce počet kusů každého zboží.
            if($povolit_zmeny)
            {
                # Jestliže teď vkládáme buňku s tlačítky + a -, musíme na tento sloupec navíc pamatovat i níže.
                $odsazeni = '<td></td>';
                $html .= "<td>";
                my $novy_kosik = upravit_pocet($objednavka->{kosik_text}, $vec->{oddeleni}, $vec->{kod}, +1, 1);
                $html .= odkazpar('[+]', "kosik=$novy_kosik");
                $novy_kosik = upravit_pocet($objednavka->{kosik_text}, $vec->{oddeleni}, $vec->{kod}, -1, 1);
                $html .= odkazpar('[&ndash;]', "kosik=$novy_kosik")."\n";
                # Odsadit přidávací a ubírací tlačítka od aktuálního počtu kusů.
                $html .= '&nbsp;';
                $html .= "</td>";
            }
            $html .= "  <td align=right>$vec->{pocet} × </td><td><b>$vec->{nazev}</b></td><td align=right> (po $vec->{jednotkova_cena}&nbsp;Kč)</td><td>&nbsp;=&nbsp;</td><td align=right><b>$vec->{cena_celkem}&nbsp;Kč</b></td>\n";
            $html .= "</tr>\n";
        }
        $html .= "<tr>$odsazeni<td colspan=4><b>Mezisoučet</b></td><td align=right><b>$objednavka->{mezisoucet}&nbsp;Kč</b></td></tr>\n";
        #----------------------------------------------------------------------
        # Přičíst poštovné.
        # Pokud není znám způsob odběru nebo pokud jde o osobní odběr, informaci o poštovném nezobrazovat.
        if($objednavka->{odber} =~ m/^(posta|posta_do_ruky|posta_na_postu|dpd|ulozenka|intime|zasilkovna)$/)
        {
            if($objednavka->{postovne_zdarma})
            {
                $html .= "<tr>$odsazeni<td colspan=5><font color=red>Poštovné a balné ZDARMA.</font></td></tr>\n";
            }
            else
            {
                $html .= "<tr>$odsazeni<td colspan=4>Poštovné a balné</td><td align=right><b>$objednavka->{postovne}&nbsp;Kč</b></td></tr>\n";
            }
        }
        # Započítat množstevní slevu.
        # Předpokládáme, že množstevní sleva se aplikuje při vyšším nákupu,
        # než při jakém se odpouští poštovné, takže se nemusíme bát, že bychom
        # výši slevy počítali i z poštovného.
        if(exists($objednavka->{mnozstevni_sleva}) && $objednavka->{mnozstevni_sleva}>0)
        {
            $html .= "<tr>$odsazeni<td colspan=3><font color=red>Množstevní sleva $glob_mnozstevni_sleva&nbsp;%</font></td><td><font color=red>&nbsp;=&nbsp;</font></td><td align=right><font color=red><b>$objednavka->{mnozstevni_sleva}&nbsp;Kč</b></font></td></tr>\n";
        }
        # Závěr obsahu košíku.
        $html .= "<tr style='color:red;font-weight:bold'>$odsazeni<td colspan=4>Celková cena</td><td align=right>$objednavka->{celkem}&nbsp;Kč</td></tr>\n";
        $html .= "</table>\n";
        # Na cenu mělo vliv, zda jsme zákazníka považovali za organizaci pracující s mládeží. Proto to uvedeme hned pod košíkem.
        if($objednavka->{sleva_org_deti})
        {
            $html .= "<p><font color=red>Uvedené ceny zahrnují slevu pro organizace pracující s&nbsp;mládeží. Vaše IČO: $objednavka->{ico}</font></p>\n";
        }
        if($objednavka->{sleva_kod})
        {
            $html .= "<p><font color=red>S&nbsp;výjimkou akčního zboží ceny zahrnují slevu $objednavka->{sleva_kod}&nbsp;% na základě slevového kódu $objednavka->{slevkod}.</font></p>\n";
        }
    }
    else # košík je prázdný
    {
        $html .= "<p>Váš nákupní košík je zatím prázdný.</p>\n";
    }
    return $html;
}



#------------------------------------------------------------------------------
# Vygeneruje HTML s obsahem nákupního košíku. Tato kompaktní verze je vhodná do
# pravého sloupce, kde je obsah košíku zobrazován průběžně.
#------------------------------------------------------------------------------
sub html_kompakt
{
    my $objednavka = shift; # odkaz na hash: vnořené pole hashů kosik: kod_zbozi nazev_zbozi jednotkova_cena pocet cena_celkem
    my $povolit_zmeny = shift; # mají se vygenerovat odkazy na přidávání/ubírání z košíku?
    my $html;
    # Pokud je košík neprázdný, vypsat obsah. Jinak jen informaci o prázdném košíku.
    if(scalar(@{$objednavka->{kosik}}))
    {
        # Projít košík a vypsat jeho obsah.
        # O některých úkonech předpokládáme, že k nim došlo v okamžiku, kdy se převáděl
        # obsah košíku z parametrů cgi do hashe objednavka:
        # - uspořádání pole zboží např. podle názvů zboží
        # - odstranění zboží, které nemáme v nabídce (v parametrech mohlo být např. kvůli nacachovaným stránkám u vyhledávačů)
        foreach my $vec (@{$objednavka->{kosik}})
        {
            $html .= "<p>";
            # Umožnit uživateli změnit v objednávce počet kusů každého zboží.
            if($povolit_zmeny)
            {
                # Dočasně zvýšit počet kusů dané věci, abychom získali cgi podobu košíku pro odkaz na zvýšení.
                $vec->{pocet}++;
                my $novy_kosik = zakodovat($objednavka->{kosik});
                $vec->{pocet}--;
                $html .= odkazpar('[+]', "kosik=$novy_kosik");
                # Dočasně snížit počet kusů dané věci, abychom získali cgi podobu košíku pro odkaz na snížení.
                # (Funkce zakodovat_kosik() sama ošetří případy, kdy počet klesne na nulu nebo pod ni.)
                $vec->{pocet}--;
                my $novy_kosik = zakodovat($objednavka->{kosik});
                $vec->{pocet}++;
                $html .= odkazpar('[&ndash;]', "kosik=$novy_kosik")."\n";
                # Odsadit přidávací a ubírací tlačítka od aktuálního počtu kusů.
                $html .= '&nbsp;';
            }
            # Šetříme místo.
            ###!!! DZ: Jenže tahle funkce se zřejmě využívala jak pro průběžné zobrazení košíku v úzkém pruhu vpravo,
            ###!!! tak pro závěrečné zobrazení uprostřed. A v tom druhém případě můžeme a měli bychom být upovídanější.
            #$html .= "<b>$vec->{pocet} × $vec->{nazev}</b> (po $vec->{jednotkova_cena}&nbsp;Kč) = <b>$vec->{cena_celkem}&nbsp;Kč</b>\n";
            $html .= "$vec->{pocet} × <b>$vec->{nazev}</b> = $vec->{cena_celkem}&nbsp;Kč";
            $html .= "</p>\n";
        }
        #----------------------------------------------------------------------
        # Tato funkce je určena pro zobrazení v pravém pruhu, kdy ještě nevíme, jak budeme zboží dodávat, takže žádné poštovné.
        # Započítat množstevní slevu.
        # Předpokládáme, že množstevní sleva se aplikuje při vyšším nákupu,
        # než při jakém se odpouští poštovné, takže se nemusíme bát, že bychom
        # výši slevy počítali i z poštovného.
        if(exists($objednavka->{mnozstevni_sleva}) && $objednavka->{mnozstevni_sleva}>0)
        {
            $html .= "<p><font color=red>Sleva $glob_mnozstevni_sleva&nbsp;% = $objednavka->{mnozstevni_sleva}&nbsp;Kč</font></p>\n";
        }
        # Závěr obsahu košíku.
        $html .= "<p><font color=red><b>Celkem $objednavka->{celkem}&nbsp;Kč</b>.</font></b></p>\n";
        # Na cenu mělo vliv, zda jsme zákazníka považovali za organizaci pracující s mládeží. Proto to uvedeme hned pod košíkem.
        if($objednavka->{sleva_org_deti})
        {
            $html .= "<p><font color=red>Uvedené ceny zahrnují slevu pro organizace pracující s&nbsp;mládeží. Vaše IČO: $objednavka->{ico}</font></p>\n";
        }
        if($objednavka->{sleva_kod})
        {
            $html .= "<p><font color=red>S&nbsp;výjimkou akčního zboží ceny zahrnují slevu $objednavka->{sleva_kod}&nbsp;% na základě slevového kódu $objednavka->{slevkod}.</font></p>\n";
        }
    }
    else # košík je prázdný
    {
        $html .= "<p>Váš nákupní košík je zatím prázdný.</p>\n";
    }
    return $html;
}



#------------------------------------------------------------------------------
# Vygeneruje text do mailu s obsahem nákupního košíku.
#------------------------------------------------------------------------------
sub text
{
    my $objednavka = shift; # odkaz na hash: vnořené pole hashů kosik: kod_zbozi nazev_zbozi jednotkova_cena pocet cena_celkem
    my $mail;
    # Pokud je košík neprázdný, vypsat obsah. Jinak jen informaci o prázdném košíku.
    if(scalar(@{$objednavka->{kosik}}))
    {
        # Projít košík a vypsat jeho obsah.
        # O některých úkonech předpokládáme, že k nim došlo v okamžiku, kdy se převáděl
        # obsah košíku z parametrů cgi do hashe objednavka:
        # - uspořádání pole zboží např. podle názvů zboží
        # - odstranění zboží, které nemáme v nabídce (v parametrech mohlo být např. kvůli nacachovaným stránkám u vyhledávačů)
        foreach my $vec (@{$objednavka->{kosik}})
        {
            $mail .= sprintf("%2d × %4d Kč = %4d Kč: %s\n", $vec->{pocet}, $vec->{jednotkova_cena}, $vec->{cena_celkem}, $vec->{nazev});
        }
        #----------------------------------------------------------------------
        $mail .= sprintf("MEZISOUČET   = %4d Kč\n", $objednavka->{mezisoucet});
        # Přičíst poštovné.
        # Pokud není znám způsob odběru nebo pokud jde o osobní odběr, informaci o poštovném nezobrazovat.
        if($objednavka->{odber} =~ m/^(posta|posta_do_ruky|posta_na_postu|dpd|ulozenka|intime|zasilkovna)$/)
        {
            if($objednavka->{postovne_zdarma})
            {
                $mail .= sprintf("Poštovné     = %4d Kč\n", 0);
            }
            else
            {
                $mail .= sprintf("Poštovné     = %4d Kč\n", $objednavka->{postovne});
            }
        }
        # Započítat množstevní slevu.
        # Předpokládáme, že množstevní sleva se aplikuje při vyšším nákupu,
        # než při jakém se odpouští poštovné, takže se nemusíme bát, že bychom
        # výši slevy počítali i z poštovného.
        if(exists($objednavka->{mnozstevni_sleva}) && $objednavka->{mnozstevni_sleva}>0)
        {
            $mail .= sprintf("Sleva $glob_mnozstevni_sleva %%    = %4d Kč\n", $objednavka->{mnozstevni_sleva});
        }
        # Závěr obsahu košíku.
        $mail .= sprintf("CELKEM       = %4d Kč\n\n", $objednavka->{celkem});
        # Na cenu mělo vliv, zda jsme zákazníka považovali za organizaci pracující s mládeží. Proto to uvedeme hned pod košíkem.
        if($objednavka->{sleva_org_deti})
        {
            $mail .= "Sleva pro organizace pracující s mládeží byla započtena. (IČO: $objednavka->{ico})\n";
        }
        else
        {
            $mail .= "Není organizace pracující s mládeží.";
            if($objednavka->{ico} !~ m/^\s*$/)
            {
                $mail .= " IČO: $objednavka->{ico}";
            }
            $mail .= "\n";
        }
        if($objednavka->{sleva_kod})
        {
            $mail .= "S výjimkou akčního zboží ceny zahrnují slevu $objednavka->{sleva_kod} % na základě slevového kódu $objednavka->{slevkod}.\n";
        }
    }
    return $mail;
}



1;
