#!/usr/bin/perl # Internetový obchod nejen s hrami / katalog (většina zobrazovaných informací o zboží, včetně ceníků) # Copyright © 2007-2013 Dan Zeman # 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 package katalog; use utf8; use Encode; use dzsql; use mysql; use csort; use pomoc; #------------------------------------------------------------------------------ # Sestaví seznam her na prodej. #------------------------------------------------------------------------------ sub seznam_her { my $databaze = shift; my $html; # Získat z databáze seznam názvů her a jejich kódů. # Propojit s tabulkou "prodej", aby se seznam her omezil na hry, které se dají koupit. # Nepoužijeme funkci dzsql::dotaz(), protože rovnou v průběhu načítání her budeme vyrábět jejich třídící hodnoty. my $dotaz = "SELECT kod, hry.nazev, hry.nazev_na_ceskem_trhu FROM hry INNER JOIN prodej ON hry.kod = prodej.kod_hry GROUP BY kod, hry.nazev"; my $dtzobj = $databaze->prepare($dotaz); $dtzobj->execute(); # Nejdříve načíst, potom si je sami seřadíme podle české abecedy algoritmem, # kterému můžeme důvěřovat. my @hry; while(my ($kod, $nazev, $nazev_cs) = map{decode("utf8", $_)}($dtzobj->fetchrow_array())) { my %zaznam = ( "kod" => $kod, "nazev" => $nazev, "trid" => csort::zjistit_tridici_hodnoty($nazev, "cs") ); push(@hry, \%zaznam); # Jestliže se na českém trhu používá odlišný název, zařadit ho do seznamu také. if($nazev_cs && $nazev_cs ne $nazev) { my %zaznam = ( "kod" => $kod, "nazev" => $nazev_cs, "trid" => csort::zjistit_tridici_hodnoty($nazev_cs, "cs") ); push(@hry, \%zaznam); } } # Seřadit seznam her podle názvů her podle české abecedy. @hry = sort{$a->{trid} cmp $b->{trid}}(@hry); # Projít seřazený seznam a vypsat odkazy na hry. my $n = scalar(@hry); $html .= "

V nabídce máme těchto $n her:

\n"; my $odkazy = join(" \x{203B} ", map {odkazpar($_->{nazev}, 'pohled=hra', "hra=$_->{kod}")} (@hry)); $html .= "

$odkazy

\n"; return $html; } #------------------------------------------------------------------------------ # Vytáhne z databáze seznam her a zboží. #------------------------------------------------------------------------------ sub dbzbozi { my $databaze = shift; # Získat z databáze údaje o hrách. my $tabulka; my @nazvy; if($main::pole{odd} eq 'hry') { $tabulka = 'zbozi INNER JOIN hry ON hry.kod=zbozi.kod_hry'; @nazvy = qw(kod_hry zbozi.kod hry.kod zbozi.nazev prodejni_cena bezna_cena nelze_koupit slozka_hrejsi novinka omezeny_pocet sleva popis_zbozi zbozi.poznamka lokalizace paluba cerny_most); } else { $tabulka = 'zbozi INNER JOIN skupiny ON skupiny.kod=zbozi.kod_skupiny'; @nazvy = qw(kod_skupiny zbozi.kod skupiny.kod zbozi.nazev prodejni_cena bezna_cena nelze_koupit slozka_hrejsi novinka omezeny_pocet sleva popis_zbozi zbozi.poznamka lokalizace paluba cerny_most); } my $zbozi = dzsql::dotaz($databaze, @nazvy, "$tabulka ORDER BY zbozi.nazev"); return $zbozi; } #------------------------------------------------------------------------------ # Získá z databáze údaje o hře. Nezabývá se údaji specifickými pro konkrétní # druh zboží (např. u hry Carcassonne zjistí doporučený minimální věk, ale # nezjišťuje prodejní ceny základní hry a jednotlivých rozšíření). #------------------------------------------------------------------------------ sub zjistit_udaje_o_hre { my $databaze = shift; my $hra = shift; # kód hry # Získat z databáze údaje o hře. my $tabulka; my @nazvy; if($main::pole{odd} eq 'hry') { $tabulka = 'hry'; @nazvy = ('nazev', 'nazev_na_ceskem_trhu', 'upoutavka', 'pocet_hracu', 'min_vek', 'min_delka', 'max_delka', 'slozka_hrejsi', 'htmltext', 'htmllink', 'htmlvlink', 'htmlalink'); } else { $tabulka = 'skupiny'; @nazvy = ('nazev', 'nazev_na_ceskem_trhu', 'slozka_hrejsi', 'htmltext', 'htmllink', 'htmlvlink', 'htmlalink'); } my $hry = dzsql::dotaz($databaze, @nazvy, "$tabulka WHERE kod = '$hra'"); # Nepokračovat, jestliže jsme z databáze k danému kódu hry nedostali žádný záznam. return if(scalar(@{$hry})<1); $hry->[0]{kod} = $hra; my %zaznam = %{$hry->[0]}; # Název na českém trhu je pro nás hlavní, takže zajistit, aby byl vždy vyplněn. unless($zaznam{nazev_na_ceskem_trhu}) { $zaznam{nazev_na_ceskem_trhu} = $zaznam{nazev}; } # Druhým dotazem získat alternativní názvy hry. my $dalsi_nazvy = dzsql::dotaz($databaze, 'kod_hry', 'nazev', "nazvy WHERE (kod_hry = '$zaznam{kod}') AND (nazev <> '$zaznam{nazev}')"); my @dalsi_nazvy = map {$_->{nazev}} (@{$dalsi_nazvy}); if(scalar(@dalsi_nazvy)) { $zaznam{dalsi_nazvy} = \@dalsi_nazvy; } # Třetím dotazem získat odkazy na stránky o této hře. my $odkazy = dzsql::dotaz($databaze, 'hra', 'text', 'adresa', "odkazy WHERE (hra = '$zaznam{kod}')"); if(scalar(@{$odkazy})) { $zaznam{odkazy} = $odkazy; } return \%zaznam; } #------------------------------------------------------------------------------ # Sestaví kořenovou stránku hry. #------------------------------------------------------------------------------ sub hra { my $databaze = shift; my $kod_hry = shift; # kód hry, jejíž stránka se má generovat # Získat z databáze údaje o hře. my $hra = zjistit_udaje_o_hre($databaze, $kod_hry); # Získat přehled zboží souvisejícího s touto hrou. my ($nazev_kod_hry, $filtr); if($main::pole{odd} eq 'hry') { $nazev_kod_hry = 'kod_hry'; $filtr = "kod_hry = '$kod_hry'"; } else { $nazev_kod_hry = 'kod_skupiny AS kod_hry'; $filtr = "kod_skupiny = '$kod_hry'"; } my $zbozi = dzsql::dotaz($databaze, 'kod', $nazev_kod_hry, 'nelze_koupit', 'nazev', 'prodejni_cena', 'bezna_cena', 'poznamka', 'popis_zbozi', 'lokalizace', 'cerny_most', 'paluba', 'dostupnost', 'dostupnost_poznamka', "zbozi WHERE ($filtr)"); my @zbozi = @{$zbozi}; # Vypsat informace o hře. my $html; $html .= " \n"; # Informace o počtu hráčů apod. jsou k dispozici u her, ale ne u zboží z ostatních oddělení. if($main::pole{odd} eq 'hry') { $html .= sestavit_radek_tabulky_o_hre_3_bunky($hra); } # Vypsat informace o jednotlivých druzích zboží souvisejících s touto hrou. my $n_zbozi = 0; foreach my $zbozi (@zbozi) { unless($zbozi->{nelze_koupit}) { $n_zbozi++; $zbozi->{slozka_hrejsi} = $hra->{slozka_hrejsi}; $html .= " \n"; $html .= sestavit_radek_tabulky_o_zbozi_3_bunky($zbozi); } } $html .= "
\n"; # Pokud k této hře nemáme žádné zboží, napsat to (na stránku hry se můžeme dostat z vyhledávačů). if($n_zbozi<=0) { $html .= "

Litujeme, ale toto zboží momentálně nemáme v nabídce.

\n"; } return $html; } #------------------------------------------------------------------------------ # Sestaví stránku o jednom výrobku (druhu zboží). #------------------------------------------------------------------------------ sub zbozi { my $databaze = shift; my $odd = shift; # kód oddělení obchodu; zajímá nás zejména, zda jde o hry, nebo o něco jiného my $kod = shift; # kód zboží, jehož stránka se má generovat # Získat z databáze údaje o tomto druhu zboží. my $nazev_kod_skupiny = $odd eq 'hry' ? 'kod_hry' : 'kod_skupiny'; my $zbozi = dzsql::dotaz($databaze, 'kod', $nazev_kod_skupiny, 'nelze_koupit', 'nazev', 'prodejni_cena', 'bezna_cena', 'poznamka', 'popis_zbozi', 'lokalizace', 'cerny_most', 'paluba', 'dostupnost', 'dostupnost_poznamka', "zbozi WHERE (kod = '$kod')"); my @zbozi = @{$zbozi}; # Nepokračovat, jestliže jsme z databáze nezískali žádný záznam o zboží s takovým kódem. return "

Neznámé zboží $kod.

\n" if(scalar(@zbozi)<1); # Vygenerovat HTML s informacemi o zboží. my $html; $zbozi = $zbozi[0]; my $hra; if($odd eq 'hry') { # Získat informace o hře, ke které tento druh zboží patří. $hra = zjistit_udaje_o_hre($databaze, $zbozi->{kod_hry}); $zbozi->{slozka_hrejsi} = $hra->{slozka_hrejsi}; } $html .= " \n"; if($odd eq 'hry') { $html .= sestavit_radek_tabulky_o_hre_3_bunky($hra); } # Vypsat informace o jednotlivých druzích zboží souvisejících s touto hrou. unless($zbozi->{nelze_koupit}) { $html .= " \n"; $html .= sestavit_radek_tabulky_o_zbozi_3_bunky($zbozi); } $html .= "
\n"; return $html; } #------------------------------------------------------------------------------ # Hledá řetězec v kódu hry, názvu hry, alternativních názvech hry a názvech # zboží. Hledá i ve hrách, které neprodáváme, aby mohl informovat, že je # neprodáváme. Vrátí přehled výsledků hledání v HTML. #------------------------------------------------------------------------------ sub hledat { my $databaze = shift;; my $retezec = shift; my $html; $html .= "\n"; # Hledat podle hlavního názvu hry. my $hry = mysql::dotaz($databaze, "kod", "nazev", "slozka_hrejsi", "hry WHERE nazev LIKE '%$retezec%'"); # Hledat podle alternativních názvů hry. my $althry = mysql::dotaz($databaze, "kod", "hry.nazev AS nazev", "slozka_hrejsi", "hry INNER JOIN nazvy ON hry.kod = nazvy.kod_hry WHERE nazvy.nazev LIKE '%$retezec%'"); # Přidat do her alternativní hry, které už v hrách nejsou. foreach my $althra (@{$althry}) { unless(grep{$_->{kod} eq $althra->{kod}}(@{$hry})) { push(@{$hry}, $althra); } } # Nastavit způsob zvýrazňování nalezeného řetězce (musí být tady, využijeme nejen uvnitř následujícího cyklu). my $zvyr1 = ""; my $zvyr0 = ""; foreach my $hra (@{$hry}) { # Zjistit alternativní názvy hry. my $nazvy = mysql::dotaz($databaze, "nazev", "nazvy WHERE (kod_hry = '$hra->{kod}') AND (nazev <> '$hra->{nazev}')"); my $dalsi_nazvy = join(", ", map{$_->{nazev}}(@{$nazvy})); # Zvýraznit hledaný řetězec v názvech hry. my $nazev = $hra->{nazev}; $nazev =~ s/($retezec)/$zvyr1$1$zvyr0/ig; $dalsi_nazvy =~ s/($retezec)/$zvyr1$1$zvyr0/ig; # Získat seznam zboží patřícího k této hře, abychom věděli, zda ji máme v nabídce. my $zbozii = mysql::dotaz($databaze, "kod", "kod_hry", "nelze_koupit", "nazev", "prodejni_cena", "zbozi WHERE (kod_hry = '$hra->{kod}')"); my $n_zbozi = 0; foreach my $zbozi (@{$zbozii}) { $n_zbozi++; $html .= "\n"; $html .= "\n"; $html .= "\n"; $html .= "\n"; } my $nabidka; if($n_zbozi<=0) { # K této hře nemáme žádné zboží. Přidat obecný řádek o hře. $html .= "\n"; $html .= "\n"; $html .= "\n"; $html .= "\n"; } } # Hledat podle názvů zboží. Děláme zvlášť, protože od těchto her nechceme zobrazit druhy zboží, které řetězec neobsahují. my $zbohry = mysql::dotaz($databaze, "hry.kod", "hry.nazev", "slozka_hrejsi", "zbozi.kod", "nelze_koupit", "zbozi.nazev", "prodejni_cena", "hry INNER JOIN zbozi ON hry.kod = zbozi.kod_hry WHERE zbozi.nazev LIKE '%$retezec%'"); # Vynechat hry, které už jsme zobrazili. my @nove; foreach my $zbohra (@{$zbohry}) { unless(grep{$_->{kod} eq $zbohra->{"hry.kod"}}(@{$hry})) { push(@nove, $zbohra); } } foreach my $zbozi (@nove) { $html .= "\n"; $html .= "\n"; $html .= "\n"; $html .= "\n"; } $html .= "
\n"; # Zobrazit fotografii zboží. my $slozka = $hra->{slozka_hrejsi}; my $foto = foto($slozka, $zbozi->{kod_hry}, $zbozi->{kod}, 100); if($foto eq "") { $foto = foto($slozka, "", "", 100); } $html .= "$foto\n"; $html .= "\n"; $html .= "
\n" if($foto eq ""); $html .= odkazpar($nazev, "", 'pohled=hra', "hra=$hra->{kod}")."
\n"; if($dalsi_nazvy ne "") { $html .= "Alternativní názvy: $dalsi_nazvy
\n"; } # Zvýraznit hledaný řetězec v názvu zboží, podobně jako jsme to už dříve udělali s názvem hry. my $nazev_zbozi = $zbozi->{nazev}; $nazev_zbozi =~ s/($retezec)/$zvyr1$1$zvyr0/ig; $html .= "Zboží: $nazev_zbozi"; if($zbozi->{nelze_koupit}) { $html .= "
\nToto zboží momentálně nemáme v nabídce."; } else { $html .= "
\nNaše cena: $zbozi->{prodejni_cena} Kč"; } $html .= "\n"; $html .= "
\n
\n" if($foto eq ""); $html .= "
\n"; my $slozka = $hra->{slozka_hrejsi}; my $foto = foto($slozka, "", "", 100); $html .= "$foto\n"; $html .= "\n"; $html .= "
\n" if($foto eq ""); $html .= odkazpar($nazev, 'pohled=hra', "hra=$hra->{kod}")."
\n"; if($dalsi_nazvy ne "") { $html .= "Alternativní názvy: $dalsi_nazvy
\n"; } $html .= "Toto zboží momentálně nemáme v nabídce."; $html .= "
\n
\n" if($foto eq ""); $html .= "
\n"; # Zobrazit fotografii zboží. my $foto = foto($zbozi->{slozka_hrejsi}, $zbozi->{"hry.kod"}, $zbozi->{"zbozi.kod"}, 100); if($foto eq "") { $foto = foto($zbozi->{slozka_hrejsi}, "", "", 100); } $html .= "$foto\n"; $html .= "\n"; $html .= "
\n" if($foto eq ""); $html .= odkazpar($zbozi->{"hry.nazev"}, 'pohled=hra', "hra=$zbozi->{\"hry.kod\"}")."
\n"; # Zvýraznit hledaný řetězec v názvu zboží, podobně jako jsme to už dříve udělali s názvem hry. my $nazev_zbozi = $zbozi->{"zbozi.nazev"}; $nazev_zbozi =~ s/($retezec)/$zvyr1$1$zvyr0/ig; $html .= "Zboží: $nazev_zbozi"; if($zbozi->{nelze_koupit}) { $html .= "
\nToto zboží momentálně nemáme v nabídce."; } else { $html .= "
\nNaše cena: $zbozi->{prodejni_cena} Kč"; } $html .= "\n"; $html .= "
\n
\n" if($foto eq ""); $html .= "
\n"; # Pokud nebylo nalezeno nic, nahradit prázdný prostor krátkou zprávou. if(scalar(@{$hry})<=0 && scalar(@nove)<=0) { $html .= "

Nebyly nalezeny žádné hry, jejichž název by obsahoval daný řetězec znaků.

\n"; } return $html; } #------------------------------------------------------------------------------ # Sestaví přehled novinek. #------------------------------------------------------------------------------ sub novinky { my $databaze = shift; my $zbozi = dbzbozi($databaze); # Novinky nechceme řadit podle abecedy, ale sestupně podle čísla zboží, aby se ty nejnovější novinky dostaly nahoru. my @zbozi = sort {$b->{'zbozi.kod'} <=> $a->{'zbozi.kod'}} @{$zbozi}; my $html; $html .= "

Novinky

\n"; $html .= " \n"; my $prvni = 1; for(my $i = 0; $i<=$#zbozi; $i++) { if(($zbozi[$i]->{novinka}) && !($zbozi[$i]->{nelze_koupit})) { # Mezi dvěma řádky tabulky udělat vodorovnou čáru. Před prvním řádkem ne. if($prvni) { # Čáru nezobrazíme, ale prázdný řádek ano, aby text nebyl nalepený k hornímu okraji tabulky. $html .= " \n"; $prvni = 0; } else { $html .= " \n"; } $html .= sestavit_radek_tabulky_o_zbozi($zbozi[$i]); } } $html .= "
\n"; return $html; } #------------------------------------------------------------------------------ # Sestaví přehled her v akci. #------------------------------------------------------------------------------ sub akce { my $databaze = shift; my $zbozi = dbzbozi($databaze); my @zbozi = @{$zbozi}; my $html; $html .= "

Akce

\n"; $html .= " \n"; my $prvni = 1; for(my $i = 0; $i<=$#zbozi; $i++) { if(($zbozi[$i]->{sleva}) && !($zbozi[$i]->{nelze_koupit})) { # Mezi dvěma řádky tabulky udělat vodorovnou čáru. Před prvním řádkem ne. if($prvni) { # Čáru nezobrazíme, ale prázdný řádek ano, aby text nebyl nalepený k hornímu okraji tabulky. $html .= " \n"; $prvni = 0; } else { $html .= " \n"; } $html .= sestavit_radek_tabulky_o_zbozi($zbozi[$i]); } } $html .= "
\n"; return $html; } #============================================================================== # Řádky v tabulkách zboží #============================================================================== #------------------------------------------------------------------------------ # Vyrobí HTML řádek tabulky o jedné, např. v pohledu na konkrétní hru nebo druh # zboží. Je to ten první řádek tabulky, kde jsou informace společné pro všechny # druhy zboží od dané hry. #------------------------------------------------------------------------------ sub sestavit_radek_tabulky_o_hre_3_bunky { my $hra = shift; # odkaz na hash my $html; $html .= " \n"; $html .= " \n"; # Zkontrolovat, že máme fotku hry, a pokud ano, vložit ji. $html .= " ".foto($hra->{slozka_hrejsi}, '', '', 200)."\n"; $html .= " \n"; $html .= " \n"; my $nazev = $hra->{nazev_na_ceskem_trhu} ? $hra->{nazev_na_ceskem_trhu} : $hra->{nazev}; $html .= "

$nazev

\n"; # Pokud známe alternativní názvy, vypsat je. my $neboli; if(@{$hra->{dalsi_nazvy}}) { $neboli = join(', ', @{$hra->{dalsi_nazvy}}); $neboli = "
neboli $neboli
"; } $html .= "$neboli\n"; # Vypsat upoutávku na hru a charakteristiku hry. $html .= "

$hra->{upoutavka}

\n"; $html .= " \n"; $html .= " \n"; ###!!! Tohle by mělo být jen dočasné, než přestěhujeme všechny korálky z oddělení her tam, kam patří. ###!!! Ke korálkům nemáme takové údaje, jaké máme ke hrám. if($hra ne 'kor') { $html .= "

Počet hráčů: $hra->{pocet_hracu}.\n"; $html .= "
Minimální věk: $hra->{min_vek} let.\n"; if($hra->{min_delka}!=0) { if($hra->{min_delka}>=60*24) { my $dnymin = sprintf("%d", ($hra->{min_delka}/60/24)+0.5); my $dnymax = sprintf("%d", ($hra->{max_delka}/60/24)+0.5); $html .= sprintf("
Délka hry: %s %s.\n", $dnymax==$dnymin ? $dnymax : "$dnymin až $dnymax", $dnymax==1 ? "den" : $dnymax>=2 && $dnymax<=4 ? "dny" : "dnů"); } elsif($hra->{min_delka}>=100) { my $hodmin = sprintf("%.1f", ($hra->{min_delka}/60)+0.05); my $hodmax = sprintf("%.1f", ($hra->{max_delka}/60)+0.05); $html .= "
Délka hry: $hodmin až $hodmax hod.\n"; } else { $html .= "
Délka hry: $hra->{min_delka} až $hra->{max_delka} min.\n"; } } # Vypsat odkazy na stránky o této hře. $html .= "

{kod}\">Základní informace o hře
Informace z deskovehry.cz
\n"; } else { # Zkontrolovat, že máme fotku hry, a pokud ano, vložit ji. $html .= " ".foto($hra->{slozka_hrejsi}, '', '', 200)."\n"; } foreach my $odkaz (@{$hra->{odkazy}}) { my $adresa = $odkaz->{adresa}; unless($adresa =~ m/^(\/|http:)/) { $adresa = "$main::koren_hrejsi/$hra->{slozka_hrejsi}/$adresa"; } $html .= " $odkaz->{text}
\n"; } $html .= " \n"; $html .= " \n"; return $html; } #------------------------------------------------------------------------------ # Vyrobí HTML řádek tabulky o jednom zboží, např. v pohledu na konkrétní hru # nebo druh zboží. #------------------------------------------------------------------------------ sub sestavit_radek_tabulky_o_zbozi_3_bunky { my $zbozi = shift; # odkaz na hash o druhu zboží my $html; $html .= " \n"; # Uvést cenu a srovnat ji s běžnou cenou tohoto zboží na trhu. $html .= " \n"; $html .= "

$zbozi->{nazev}

\n"; $html .= " Naše cena: $zbozi->{prodejni_cena} Kč
\n"; if($zbozi->{bezna_cena}>0) { $html .= " Běžná cena: $zbozi->{bezna_cena} Kč\n"; if($zbozi->{bezna_cena}>$zbozi->{prodejni_cena}) { my $uspora_kc = $zbozi->{bezna_cena}-$zbozi->{prodejni_cena}; my $uspora_prc = $uspora_kc/$zbozi->{bezna_cena}*100; if($uspora_prc>=4) { $html .= sprintf("
(Tedy ušetříte %d Kč, resp. %d %%.)\n", $uspora_kc, $uspora_prc); } } } else { $html .= " Běžně se v Česku neprodává.\n"; } # Sestavit informaci o aktuální zásobě tohoto zboží na skladě. # Z historických důvodů je distribuční sklad v databázi veden ve sloupci "cerny_most". # Nyní je tento sklad samozřejmě v Jenštejně a je to náš jediný sklad. my $sklad = $zbozi->{cerny_most}; my $prah = 3; $html .= "
\n"; if($sklad>=$prah) { $html .= " Skladem alespoň $prah ks. Údaje o zásobách jsou orientační!\n"; } elsif($sklad>0) { $html .= " Skladem $sklad ks. Údaje o zásobách jsou orientační!\n"; } else { $html .= " Tato položka momentálně není skladem.\n"; # U zboží, které nemáme, navíc doplnit informaci, za jak dlouho ho budeme mít. if($zbozi->{dostupnost_poznamka}) { $html .= "
Dostupnost: $zbozi->{dostupnost_poznamka}\n"; } elsif($zbozi->{dostupnost}>=29) { my $m0 = int(($zbozi->{dostupnost}+1)/30); my $m1 = $m0+1; $m1 .= $m1>=5 ? ' měsíců' : ' měsíce'; $html .= "
Dostupnost: $m0 až $m1\n"; } elsif($zbozi->{dostupnost}>14) { my $t0 = int($zbozi->{dostupnost}/7); my $t1 = $t0+1; $t1 .= $t1>=5 ? ' týdnů' : ' týdny'; $html .= "
Dostupnost: $t0 až $t1\n"; } elsif($zbozi->{dostupnost}>1) { my $d = $zbozi->{dostupnost}; $d .= $d>=5 ? ' dní' : ' dny'; $html .= "
Dostupnost: $d\n"; } } $html .= " \n"; # Doplnit další poznámky o této položce. my @poznamky; push(@poznamky, "$zbozi->{poznamka}") if($zbozi->{poznamka} ne ''); push(@poznamky, $zbozi->{popis_zbozi}) if($zbozi->{popis_zbozi} ne ''); push(@poznamky, $zbozi->{lokalizace}) if($zbozi->{lokalizace} ne ''); # Vytvořit odkaz na košík, v němž je o 1 ks tohoto zboží víc. my $oddeleni = $main::pole{odd}; $oddeleni = 'korálky' if($oddeleni eq 'koralky'); my $novy_kosik = kosik::upravit_pocet($main::pole{kosik}, $oddeleni, $zbozi->{kod}, +1, 1); push(@poznamky, odkazpar("Přidat do košíku.", "", "kosik=$novy_kosik")); my $poznamky = join("
\n ", @poznamky); $html .= " \n"; $html .= " $poznamky\n"; $html .= " \n"; # Vložit fotku zboží, pokud je k dispozici. $html .= " \n"; $html .= " ".foto($zbozi->{slozka_hrejsi}, $zbozi->{kod_hry}, $zbozi->{kod}, 200)."\n"; $html .= " \n"; $html .= " \n"; return $html; } #------------------------------------------------------------------------------ # Vyrobí HTML řádek tabulky o jednom zboží, např. v tabulce novinek nebo akcí. #------------------------------------------------------------------------------ sub sestavit_radek_tabulky_o_zbozi { my $zbozi = shift; # odkaz na hash o druhu zboží my $html; my $hnazev = ($main::pole{odd} eq 'hry') ? 'hry' : 'skupiny'; $html .= " \n"; # Vložit fotku zboží, pokud je k dispozici. $html .= " \n"; $html .= " ".foto($zbozi->{slozka_hrejsi}, $zbozi->{$hnazev.'.kod'}, $zbozi->{'zbozi.kod'}, 100)."\n"; $html .= " \n"; # Uvést cenu a srovnat ji s běžnou cenou tohoto zboží na trhu. $html .= " \n"; $html .= " ".odkazpar($zbozi->{'zbozi.nazev'}, 'pohled=hra', "hra=$zbozi->{'kod_'.$hnazev}")."
\n"; $html .= " Naše cena: $zbozi->{prodejni_cena} Kč
\n"; if($zbozi->{bezna_cena}>0) { $html .= " Běžná cena: $zbozi->{bezna_cena} Kč\n"; if($zbozi->{bezna_cena}>$zbozi->{prodejni_cena}) { my $uspora_kc = $zbozi->{bezna_cena}-$zbozi->{prodejni_cena}; my $uspora_prc = $uspora_kc/$zbozi->{bezna_cena}*100; if($uspora_prc>=4) { $html .= sprintf("
(ušetříte %d %%)\n", $uspora_prc); } } } else { $html .= " Běžně se v Česku neprodává.\n"; } $html .= " \n"; # Sestavit informaci o aktuální zásobě tohoto zboží na skladě. # Z historických důvodů je distribuční sklad v databázi veden ve sloupci "cerny_most". # Nyní je tento sklad samozřejmě v Jenštejně a je to náš jediný sklad. my $sklad = $zbozi->{cerny_most}; my $prah = 2; $html .= " \n"; if($sklad>=$prah) { $html .= " Skladem alespoň $prah ks.\n"; } elsif($sklad>0) { $html .= " Skladem $sklad ks.\n"; } else { $html .= " Tato položka momentálně není skladem, ale rádi ji pro vás doobjednáme.\n"; } $html .= " \n"; # Doplnit další poznámky o této položce. my @poznamky; push(@poznamky, "$zbozi->{'zbozi.poznamka'}") if($zbozi->{'zbozi.poznamka'} ne ''); push(@poznamky, $zbozi->{popis_zbozi}) if($zbozi->{popis_zbozi} ne ''); push(@poznamky, $zbozi->{lokalizace}) if($zbozi->{lokalizace} ne ''); my $poznamky = join("
\n ", @poznamky); $html .= " \n"; $html .= " $poznamky\n"; $html .= " \n"; $html .= " \n"; return $html; } #============================================================================== # Miniseznamy do pravého sloupce #============================================================================== #------------------------------------------------------------------------------ # Sestaví přehled her v akci - slevy - ve zmenšené formě pro tisk na okraj. #------------------------------------------------------------------------------ sub akce_mini { my $zbozi = shift; my $n = shift; $n = 2 unless(defined($n)); my @zbozi = @{$zbozi}; my $hkodnazev = ($main::pole{odd} eq 'hry') ? 'hry.kod' : 'skupiny.kod'; # Vybrat zboží, které je v akci a má fotku. @zbozi = grep { $_->{fotka} = foto($_->{slozka_hrejsi}, $_->{$hkodnazev}, $_->{'zbozi.kod'}, 35); # Každé položce vygenerovat náhodné číslo pro řazení. $_->{nahod} = rand(); $_->{sleva} && !$_->{nelze_koupit} && $_->{fotka} } (@zbozi); @zbozi = sort {$a->{nahod} <=> $b->{nahod}} (@zbozi); my $html = "

Akce

\n"; $html .= sestavit_mini_vyber($n, @zbozi); $html .= odkazpar("

... další zboží v akci

", 'pohled=akce'); return $html; } #------------------------------------------------------------------------------ # Sestaví vlastní přehled novinek, bez informace o akčním zboží vpravo ve zmenšené podobě. #------------------------------------------------------------------------------ sub novinky_mini { my $zbozi = shift; my $n = shift; $n = 2 unless(defined($n)); my @zbozi = sort {$b->{'zbozi.kod'} <=> $a->{'zbozi.kod'}} @{$zbozi}; my $hkodnazev = ($main::pole{odd} eq 'hry') ? 'hry.kod' : 'skupiny.kod'; # Vybrat zboží, které je nové a má fotku. @zbozi = grep { $_->{fotka} = foto($_->{slozka_hrejsi}, $_->{$hkodnazev}, $_->{'zbozi.kod'}, 35); # Každé položce vygenerovat náhodné číslo pro řazení. $_->{nahod} = rand(); $_->{novinka} && !$_->{nelze_koupit} && $_->{fotka} } (@zbozi); # Novinky určitě nechceme řadit podle abecedy. # Sestupně podle čísla zboží znamená, že se ty nejnovější novinky dostanou nahoru. # Nebo náhodně, aby se vpravo vždy vybraly jiné dvě. #@zbozi = sort {$b->{'zbozi.kod'} <=> $a->{'zbozi.kod'}} @{$zbozi}; @zbozi = sort {$a->{nahod} <=> $b->{nahod}} (@zbozi); my $html = "

Novinky

\n"; $html .= sestavit_mini_vyber($n, @zbozi); $html .= odkazpar("

... všechny novinky

", 'pohled=novinky'); return $html; } #------------------------------------------------------------------------------ # Sestaví přehled her podobných hře X. #------------------------------------------------------------------------------ sub podobne { my $databaze = shift; my $hra = shift; my $html; # Zjistit, zda je daná hra členem rodiny her. my $odpoved = dzsql::dotaz($databaze, 'rodina', "hry WHERE kod='$hra'"); my $rodina = $odpoved->[0]{rodina}; # Ke hře existují podobné hry pouze v případě, že hra je členem nějaké rodiny. if($rodina ne '') { # Zajímají nás pouze hry, od kterých existuje alespoň jedno zboží, které lze koupit. my $podobne = dzsql::dotaz($databaze, "hry.kod AS kod", "hry.nazev AS nazev", "nazev_na_ceskem_trhu", "slozka_hrejsi", "hry INNER JOIN prodej ON hry.kod=prodej.kod_hry WHERE (rodina='$rodina') AND (nelze_koupit=0)"); # Dotaz mohl vrátit jednu hru několikrát, pokud od ní existuje několik druhů zboží. # Vybrat každou hru jen jednou a vynechat hru, podle které jsme podobnost určovali. my @podobne; my %pridano; foreach my $p (@{$podobne}) { unless($p->{kod} eq $hra || $pridano{$p->{kod}}) { push(@podobne, $p); $pridano{$p->{kod}}++; } } # Pokud nám zbyla alespoň jedna jiná hra, vypsat. if(@podobne) { $html .= "

Podobné hry

\n"; $html .= "\n"; # Máme tady seznam her, ne druhů zboží. Proto nemůžeme využít funkci sestavit_mini_vyber(), kterou používáme pro akce a novinky. foreach my $p (@podobne) { my $nazev = $p->{nazev_na_ceskem_trhu} ? $p->{nazev_na_ceskem_trhu} : $p->{nazev}; my $odkaz = odkazpar($nazev, 'pohled=hra', "hra=$p->{kod}"); my $foto = foto($p->{slozka_hrejsi}, '', '', 50); $html .= "\n"; } $html .= "
$foto$odkaz
\n"; } } return $html; } #------------------------------------------------------------------------------ # Vyrobí HTML seznam (tabulku) se stručným výběrem her pro pravý sloupec. Volá # se z funkcí akce_mini() a novinky_mini(). #------------------------------------------------------------------------------ sub sestavit_mini_vyber { # Seznam zboží už očekáváme vyfiltrovaný a seřazený tak, jak se má # zobrazovat. Jediné další filtrování, které provedeme zde, je, že zobrazíme # jen prvních N položek. (N==0 znamená bez omezení.) my $n = shift; my @zbozi = @_; my $hkodnazev = ($main::pole{odd} eq 'hry') ? 'kod_hry' : 'kod_skupiny'; $n = scalar(@zbozi) if($n==0); my $html; $html .= " \n"; for(my $i = 0; $i<$n && $i<=$#zbozi; $i++) { $html .= " \n"; $html .= " \n"; $html .= " \n"; $html .= " \n"; } $html .= "
\n"; $html .= " $zbozi[$i]{fotka}\n"; $html .= " \n"; # Změnit mezery za neslabičnými předložkami v názvech zboží na nezalomitelné. my $nazev = $zbozi[$i]{'zbozi.nazev'}; $nazev =~ s/^([KSVZ])\s+/$1 /i; $nazev =~ s/\s+([ksvz])\s+/ $1 /ig; $nazev =~ s/\s+-\s+/ – /g; $html .= " ".odkazpar($nazev, 'pohled=hra', "hra=$zbozi[$i]{$hkodnazev}")."
\n"; $html .= " $zbozi[$i]{prodejni_cena} Kč\n"; if($zbozi[$i]{bezna_cena}>0) { if($zbozi[$i]{bezna_cena}>$zbozi[$i]{prodejni_cena}) { my $uspora_kc = $zbozi[$i]{bezna_cena}-$zbozi[$i]{prodejni_cena}; my $uspora_prc = $uspora_kc/$zbozi[$i]{bezna_cena}*100; if($uspora_prc>=4) { $html .= sprintf(" (–%d %%)\n", $uspora_prc); } } } $html .= "
\n"; return $html; } #============================================================================== # Ceníky #============================================================================== #------------------------------------------------------------------------------ # Zjistí z databáze ceník. Vrací tabulku, ještě ne HTML, na to jsou jiné # funkce. #------------------------------------------------------------------------------ sub zjistit_cenik { my $odd = $main::pole{odd}; my $databaze = shift; # Získat z databáze přehled zboží. # Oddělení her je v samostatné databázi. U ostatních oddělení musíme zajistit, že se vybere pouze jejich zboží. my $zbozi; if($odd eq 'hry') { my @nazvy = qw(kod_hry kod nazev prodejni_cena clenska_cena bezna_cena nelze_koupit); $zbozi = dzsql::dotaz($databaze, @nazvy, 'zbozi ORDER BY prodejni_cena, nazev'); } else { # Názvy oddělení v parametrech webové aplikace jsou bez diakritiky, ale v databázi jsou s diakritikou, takže je musíme převést. my %dbodd = ('koralky' => 'korálky', 'puzzle' => 'puzzle'); my $dbodd = exists($dbodd{$odd}) ? $dbodd{$odd} : 'korálky'; my @nazvy = ('kod_skupiny AS kod_hry', 'zbozi.kod AS kod', 'nazev', 'prodejni_cena', 'clenska_cena', 'bezna_cena', 'nelze_koupit'); #$dzsql::debug = 1; ###!!! $zbozi = dzsql::dotaz($databaze, 'kod_skupiny AS kod_hry', 'zbozi.nazev AS nazev', 'prodejni_cena', 'clenska_cena', 'bezna_cena', 'nelze_koupit', 'zbozi LEFT JOIN skupiny ON zbozi.kod_skupiny=skupiny.kod'. " WHERE skupiny.oddeleni='$dbodd'". ' ORDER BY prodejni_cena, nazev'); my $n = scalar(@{$zbozi}); } return $zbozi; } #------------------------------------------------------------------------------ # Sestaví ceník. #------------------------------------------------------------------------------ sub cenik { my $databaze = shift; my $zbozi = zjistit_cenik($databaze); # Seřadit zboží vzestupně podle cen. # (Sice jsme o totéž už požádali SQL server, jenže on to seřadí řetězcově, takže cena 1128 bude před 128.) my @cenik = sort{$a->{prodejni_cena} <=> $b->{prodejni_cena}}(@{$zbozi}); my $dodacipodminky = odkazpar('dodacích podmínkách', 'odd=info', 'pohled=obecne'); # Vypsat ceník. my $html = <Ceník

Položky jsou řazeny od nejlevnějších po nejdražší. Kliknutím na název se o daném zboží dozvíte více. Ceny poštovného najdete v $dodacipodminky.


EOF ; foreach my $radek (@cenik) { unless($radek->{nelze_koupit}) { $html .= " \n"; $html .= " \n"; $html .= " \n"; $html .= " \n"; $html .= " \n"; } } $html .= < EOF ; return $html; } #------------------------------------------------------------------------------ # Sestaví ceník pro kluby. #------------------------------------------------------------------------------ sub klubovy_cenik { my $databaze = shift; my $zbozi = zjistit_cenik($databaze); # Pro název každého zboží získat jeho třídící hodnoty. foreach my $z (@{$zbozi}) { $z->{_trid} = csort::zjistit_tridici_hodnoty($z->{nazev}, "cs"); } # Seřadit zboží vzestupně podle abecedy. my @cenik = sort{$a->{_trid} cmp $b->{_trid}}(@{$zbozi}); my $dodacipodminky = odkazpar('dodacích podmínkách', 'odd=info', 'pohled=obecne'); # Vypsat ceník. my $html = <Klubový ceník

Tento ceník platí pro organizace pracující s dětmi a mládeží. U většiny položek jde o zhruba 10 % slevu oproti našim cenám. Srovnání s běžnými cenami na trhu vychází ještě příznivěji. Ceny poštovného najdete v $dodacipodminky.

Položky jsou řazeny podle abecedy. Kliknutím na název se o daném zboží dozvíte více.


Název zboží Naše cena Běžná cena
".odkazpar($radek->{nazev}, 'pohled=hra', "hra=$radek->{kod_hry}")."$radek->{prodejni_cena} Kč$radek->{bezna_cena} Kč
EOF ; foreach my $radek (@cenik) { unless($radek->{nelze_koupit}) { $html .= " \n"; $html .= " \n"; $html .= " \n"; $html .= " \n"; $html .= " \n"; } } $html .= < EOF ; return $html; } #============================================================================== # Pomocné funkce #============================================================================== #------------------------------------------------------------------------------ # Vrátí HTML odkaz () na fotku zboží. Pokud fotka není k dispozici, vrátí # prázdný řetězec. #------------------------------------------------------------------------------ sub foto { my $slozka = shift; # položka slozka_hrejsi k dané hře v databázi my $kod_hry = shift; my $kod_zbozi = shift; my $sirka = shift; # šířka fotky do parametru width; výchozí = 100 $sirka = 100 if($sirka eq ""); my $odkaz; if($slozka eq "") { return ""; } my $soubor; if($kod_hry ne "" && $kod_zbozi ne "") { $soubor = "zbo".$kod_hry.$kod_zbozi; } else { $soubor = "fotka"; } my $cesta_disk = "$main::koren_system/$slozka/obr/$soubor"; my $cesta_url = "$main::koren_hrejsi/$slozka/obr/$soubor"; if(-f "$cesta_disk.jpg") { $odkaz = "\"fotografie\""; } elsif(-f "$cesta_disk.gif") { $odkaz = "\"fotografie\""; } return $odkaz; } 1;
Název zboží Klubová cena Běžná cena
".odkazpar($radek->{nazev}, 'pohled=hra', "hra=$radek->{kod_hry}")."$radek->{clenska_cena} Kč$radek->{bezna_cena} Kč