#!/usr/bin/perl # CGI přístup k internetovému obchodu nejen s hrami. # Copyright © 2002 – 2015 Dan Zeman # Licence: GNU GPL # prosinec 2002: vytvořeno # 30.12.2003: přechod na UTF-8 # 11.12.2005: data už se neberou z textových souborů, ale z MySQL serveru # 15.2.2009: do názvu stránky se přednostně píše český název # 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 # 12.3.2025: přechod na https use utf8; use open ':utf8'; use lib '/s/w/lib/dan'; use lib '/s/w/lib/cgi/hry'; use Encode; use DBI; use DBD::mysql; # Danovy sdílené knihovny. use dzcgi; use dzsql; use sitesql; use csort; use cas; # Knihovny specifické pro tuto aplikaci. use pomoc; use kecy; use katalog; use kosik; use objednavka; use norobot; binmode(STDOUT, ':utf8'); binmode(STDERR, ':utf8'); # Zapamatovat si, kdy jsme s generováním stránky začali, abychom na konci mohli # zjistit, jak dlouho nám to trvalo. $starttime = time(); # URL Ondrovy statické části (obrázky, styly aj.) $staturl = 'https://obchod.hrejsi.cz/ondra_2012'; # Založit hash na parametry, se kterými byl tento CGI skript zavolán. my $pole = resetpar(); # Přečíst parametry. dzcgi::cist_parametry($pole); dzcgi::cist_formular_post($pole) if($pole->{formular}); # Kvůli ladění číst parametry i z @ARGV. dzcgi::cist_parametry_argv($pole); # Pro ladící účely si nachystat výpis parametrů na výstup. $ladeni = 0; if($ladeni) { $dbg_parametry .= "QUERY_STRING = $ENV{QUERY_STRING}\n"; foreach my $key (sort(keys(%{$pole}))) { $dbg_parametry .= "$key = $pole->{$key}\n"; } $dbg_parametry = "
$dbg_parametry
\n"; }; if(0) { ###!!! Dočasně zablokovat provoz obchodu, aniž bychom prozradili skutečný důvod. print < Under construction

Připravujeme novou verzi

Omlouváme se, stránky jsou dočasně nedostupné.

EOF ; exit(0); } # Robotům odmítnout přístup, jestliže si chtějí něco strčit do košíku. # Kromě toho všechny požadavky s košíkem přesměrovat na alias prodej0.pl, který uvedeme v robots.txt. # Nejlepší by ovšem bylo, kdyby se roboti po této stránce vůbec neptali, protože potenciálních adres je nekonečně mnoho. # Proto musíme na jiném místě zajistit, aby odkazy s neprázdným košíkem rovnou vedly na prodej0.pl. if(exists($pole->{kosik})) { # Varianta 2: jestliže jsme voláni jako prodej.pl, vrátíme přesměrování na prodej0.pl. # Každý uživatel se dočká kýženého výsledku. Ale robot by měl zabrzdit, protože prodej0.pl má na černé listině (robots.txt). # I když opravíme odkazy, aby vedly na prodej0.pl, je možné, že nějaký robot tudy projde, protože si z dřívějška pamatuje # starou adresu. if($0 =~ m/prodej\.pl/) { print < EOF ; exit(0); } # Varianta 1: uživateli, který je podezřelý, že je robot, ohlásíme chybu. Další odkazy nedostane. # Sem se dostaneme, pokud už jsme voláni jako prodej0.pl (což znamená, že robot ignoroval zákaz v robots.txt). elsif(!norobot::proverit()) { # Když si trochu pospíme a vrátíme chybu až za chvíli, třeba nám mezitím nepošle další požadavek? # A my si tím nijak nezatížíme procesor... sleep(20); norobot::ohlasit_chybu(); exit(0); } } # Připojit se k databázi her. $databaze = sitesql::connect_obchod('hry'); $odb = sitesql::connect_obchod('web_hrejsi_obchod'); # Doplnit výchozí hodnoty chybějících parametrů a vyřešit konflikty mezi hodnotami parametrů. doplnit_parametry($pole); # Parametry, které se nemají propagovat do všech odkazů vedoucích odsud dál, # je potřeba přestěhovat z hashe %pole někam jinam, kde je najdou pouze funkce, # které je potřebují pro výrobu této stránky, ale ne pro konstrukci odkazů z ní. # Jak původní parametry CGI, tak kopie těch, které se nemají propagovat, budou # uložené v globálních proměnných. $hledat = $pole->{hledat}; delete($pole->{hledat}); $objednavka = objednavka::zjistit($pole, $databaze, $odb); delete($pole->{kosik}) if($pole->{hra} eq 'objednavka'); vypsat_stranku(); ############################################################################### # Podprogramy ############################################################################### #------------------------------------------------------------------------------ # Doplní chybějící vstupní parametry a vyřeší případné konflikty mezi hodnotami # parametrů. #------------------------------------------------------------------------------ sub doplnit_parametry { my $p = shift; # odkaz na hash # Některé parametry CGI se jmenují jinak, než bych chtěl, ale neumím to s těmi tlačítky líp. if($p->{submit} eq 'Zpět') { if($p->{pohled} eq 'objednavka') { $p->{pohled} = 'konec1'; } delete($p->{submit}); } # Oddělení musí být určeno a musí jít o známou hodnotu. if($p->{odd} !~ m/^(hry|hracky|koralky|geo|puzzle|ruzne|info)$/) { $p->{odd} = 'hry'; } # Pohled musí být určen a musí jít o známou hodnotu. if(!defined($p->{pohled})) { # Kompatibilita: Dříve jsme neměli parametr "pohled" a vše se to rvalo do parametru "hra". if(length($p->{hra})>3) { $p->{pohled} = $p->{hra}; } # Je-li požadován konkrétní druh zboží, má přednost před hrou (skupinou zboží). elsif(defined($p->{zbozi})) { $p->{pohled} = 'zbozi'; } elsif(length($p->{hra})==3) { $p->{pohled} = 'hra'; } # Výchozí zobrazení je přehled her v akci. else { $p->{pohled} = 'akce'; } } # Starší odkazy, ve kterých parametr hra obsahuje kód informačního pohledu, musí vždy vést do oddělení info. my $info_pohledy = 'obecne|slovensko|slevy'; my $neinfo_pohledy = 'novinky|akce|cenik|cenikk'; my $neutralni_pohledy = 'konec1|konec2|objednavka'; if($p->{hra} =~ m/^($info_pohledy|$neinfo_pohledy|$neutralni_pohledy)$/) { $p->{pohled} = $pole->{hra}; } if($p->{pohled} =~ m/^($info_pohledy)$/) { $p->{odd} = 'info'; } # A naopak v oddělení info povinně vyžadujeme jeden z výše uvedených pohledů. if($p->{odd} eq 'info' && $p->{pohled} !~ m/^($info_pohledy|$neutralni_pohledy)$/) { $p->{pohled} = 'obecne'; } ###!!! Při pohledu na konkrétní zboží musí oddělení odpovídat tomu, o jaké zboží jde. ###!!! Kód zboží začínající na "O" (momentálně se používá v odkazech z Heuréky) odkazuje do databáze obchod, ###!!! nejde tedy o hru. Bohužel nevíme, o jaké jiné oddělení jde, to bychom zjistili pouze dotazem v databázi. ###!!! Pokud tedy oddělení není vybráno nebo jsou vybrány hry, vybereme zatím korálky, i když to taky nemusí být správně. if($p->{pohled} eq 'zbozi' && $p->{zbozi} =~ m/^O/) { # Výše už jsme zajistili, že oddělení má definovanou hodnotu. Čili teď už jde jen o to, aby to nebyly hry. if($p->{odd} eq 'hry') { $p->{odd} = 'koralky'; ###!!! } # Odstranit z kódu zboží to počáteční "O", aby kód odpovídal kódu, který je v databázi. $p->{zbozi} =~ s/^O//; } return $p; } #------------------------------------------------------------------------------ # Vypíše kostru stránky. Volá podřízené funkce pro jednotlivé části stránky. #------------------------------------------------------------------------------ sub vypsat_stranku { # Vypsat záhlaví MIME a HTML, styly a záložky jednotlivých oddělení. vypsat_zahlavi(); print("\n"); print("
\n"); vypsat_prostredek_stranky(); # Zjistit, jak dlouho nám to trvalo, a vypsat to na konec stránky. #my $hlaseni = sestavit_hlaseni_o_trvani_programu($starttime); #print("
$hlaseni
\n"); print("
\n"); print("\n"); # Ondrovo levé a pravé okno. print("\n"); print("
\n"); print("

MENU

\n"); vypsat_menu(); print("
\n"); # Oddíl s vyhledávacími okénky. print < EOF ; print("
\n"); print("
\n"); print("

VYHLEDÁVÁNÍ

\n"); print("

\n"); # Přidat okénko pro vyhledávání v seznamu (včetně alternativních názvů a názvů zboží). print("

\n"); print(odsadit(formpar(), 8)); # Vynulovat pole, která by mohla způsobit, že se místo výsledků hledání zobrazí něco jiného. print(" \n"); print(" \n"); print(" \n"); print(" \n"); print("
\n"); print("
\n"); print("

\n"); print("
\n"); print("\n"); # Vypsat pravé okno: obsah košíku, případně akce/novinky, podobné hry apod. vypsat_pravy_okraj(); # Ladění: Vypsat všechny parametry (upravené, takže ne nutně shodné s tím, co je vidět v adresním řádku) jako HTML komentáře na konec stránky. for my $parametr (sort(keys(%{$pole}))) { print("\n"); } # Vypsat závěr stránky. vypsat_zapati(); } #------------------------------------------------------------------------------ # Provede počáteční úkony, nezávislé na tom, jaký pohled uživatel zvolil. # Pozor! (léto 2007) Ve skutečnosti i tady musíme vědět, jaký pohled uživatel # zvolil. Pokud si řekl o konkrétní hru, chceme, aby v názvu stránky bylo # "koupit hru tu a tu". To kvůli indexování roboty. # Načte parametry a vypíše začátek HTML stránky. #------------------------------------------------------------------------------ sub vypsat_zahlavi { # Poslat MIME záhlaví dokumentu. print("Content-Type: text/html; charset=utf-8\n\n"); # Poslat začátek stránky. print("\n"); print(" \n"); # Nedovolit robotům indexovat stránku, na které je něco v košíku. if(exists($pole->{kosik})) { # index/noindex ... indexovat tuto stránku? # follow/nofollow ... sledovat odkazy z této stránky? # noindex,nofollow print(" \n"); } # Sestavit název stránky. Pokud je stránka cílena na určitou hru, musí být název hry obsažen v názvu. my $nazev_stranky; if($pole->{odd} ne 'hry') { $nazev_stranky = "Obchod hrejsi.cz: $pole->{odd}"; } elsif(exists($pole->{hra})) { ###!!! Je potřeba zneškodnit případné apostrofy v názvech her. Zatím je prostě zakážeme. (Jsou nebezpečné, hrozí vložení cizího SQL kódu.) if($pole->{hra} =~ m/'/) # ' { die("Název hry (\"$pole->{hra}\") nesmí obsahovat ASCII apostrof (\"'\")"); # ' } my $odpoved = mysql::dotaz($databaze, 'nazev', 'nazev_na_ceskem_trhu', "hry WHERE kod='$pole->{hra}'"); if(scalar(@{$odpoved})) { my $nazev_hry = $odpoved->[0]{nazev_na_ceskem_trhu} ? $odpoved->[0]{nazev_na_ceskem_trhu} : $odpoved->[0]{nazev}; $nazev_stranky = "Koupit $nazev_hry (obchod)"; } else { # Nebyl nalezen název hry podle kódu. Nejspíš šlo o pseudokód, např. "novinky" nebo "poradna". $nazev_stranky = "Deskové hry: obchod: $pole->{hra}"; } } else { $nazev_stranky = "Deskové hry: obchod"; } # Zvolit barevnou kombinaci podle toho, v jakém se nacházíme oddělení. my %oddstyl = ( 'info' => '00', 'hry' => '01', 'puzzle' => '02', 'koralky' => '03', 'geo' => '04', 'hracky' => '05', 'ruzne' => '06' ); print < $nazev_stranky $dbg_parametry
www. OBCHOD . HREJSI .cz
  © 2012-2013 hrejsi.cz; Dan a Ondra
EOF ; # Jestliže ve stávajícím oddělení ukazujeme stránku konkrétní skupiny zboží (parametr "hra"), # v cílovém oddělení tato skupina nebude existovat, proto ji vyhodit z parametrů. print("
", odkazpar('HRY', 'odd=hry', 'pohled=akce', 'hra='), "
\n"); # print("
", odkazpar('PUZZLE', 'odd=puzzle', 'pohled=cenik', 'hra='), "
\n"); print("
", odkazpar('ŠPERKY', 'odd=koralky', 'pohled=hra', 'hra=nau'), "
\n"); # print("
", odkazpar('GEOCACHE', 'odd=geo', 'pohled=cenik', 'hra='), "
\n"); # print("
", odkazpar('HRAČKY', 'odd=hracky', 'pohled=cenik', 'hra='), "
\n"); # print("
", odkazpar('RŮZNÉ', 'odd=ruzne', 'pohled=cenik', 'hra='), "
\n"); print("
", odkazpar('INFO', 'odd=info', 'pohled=obecne', 'hra='), "
\n"); print("\n"); } #------------------------------------------------------------------------------ # Vypíše prostředek stránky. To je ten hlavní obsah. #------------------------------------------------------------------------------ sub vypsat_prostredek_stranky { my $db; if($pole->{odd} =~ m/^(puzzle|hracky|koralky|geo)$/) { $db = $odb; } else { $db = $databaze; } # Aktuální kecy na začátek každé stránky jako např. budou vánoce nebo sereme na vás, jsme na dovolené... # print("

Vážení zákazníci,
zboží skladem dodáme do Vánoc objednáte-li do 20.12.

Objednávky s osobním odběrem v Jenštejně
jsou možné objednat a vyzvednout do 24.12. do 12 hod.

Klidné svátky Vám přeje Obchod.HrejSi.cz

\n"); # print("

Vážení zákazníci,
žádáme Vás o strpení s vyřízením Vašich objednávek, které vzhledem k dovoleným bohužel budeme vyřizovat pomaleji. Zrychlené a expresní zásilky nejsme momentálně schopni zajistit.

Děkujeme za pochopení Váš OBCHOD.HREJSI.CZ

\n"); # print("

Otvítací doba do Vánoc na Palubě:
21.12. 17 - 21 hod. běžná otvírací doba s volným hraním a možností nákupu her.
23.12. 10 - 17 hod. VÁNOČNÍ PORADNA - na Palubě se již nebude hrát, ale rádi Vám poradíme s výběrem her a hry skladem budete moct koupit.
Objednávky podané po 21.12.2011 budeme odesílat až začátkem ledna 2012!

Klidné svátky Vám přeje OBCHOD.HREJSI.CZ

\n"); # Další obsah se řídí několika parametry: # odd ... info obsahuje informační text, všechna ostatní oddělení obsahují různé pohledy na zboží # pohled ... jakým způsobem chceme zobrazit nabídku daného oddělení? Ne všechny pohledy jsou k dispozici ve všech odděleních. # hra ... v oddělení her je to jedna stránka katalogu; může obsahovat více než jeden druh zboží! if($pole->{pohled} eq 'obecne') { # Tento pohled implikuje odd=info. kecy::obecne(); } elsif($pole->{pohled} eq 'slovensko') { kecy::slovensko(); } elsif($pole->{pohled} eq 'slevy') { kecy::slevy(); } # Zvláštní pohledy určené pro prodejní oddělení (nikoli pro info). # Odkaz na konkrétní druh zboží. elsif($pole->{pohled} eq 'zbozi') { print(katalog::zbozi($db, $pole->{odd}, $pole->{zbozi}, $pole->{kosik})); } # Odkaz na všechny druhy zboží od jedné hry. elsif($pole->{pohled} eq 'hra') { print(katalog::hra($db, $pole->{odd}, $pole->{hra}, $pole->{kosik})); } # Seznamy her a/nebo zboží. elsif($pole->{pohled} eq 'seznam') { print(odsadit(katalog::seznam_her($db), 8)); } elsif($pole->{pohled} eq 'novinky') { print(katalog::novinky($db, $pole->{odd})); } elsif($pole->{pohled} eq 'akce') { print(katalog::akce($db, $pole->{odd})); } elsif($pole->{pohled} eq 'cenik') { print(katalog::cenik($db, $pole->{odd})); } elsif($pole->{pohled} eq 'cenikk') { print(katalog::klubovy_cenik($db, $pole->{odd})); } # Herní poradna (určeno pouze pro oddělení her). elsif($pole->{pohled} eq 'poradna') { if($pole->{hra} eq 'deti') { kecy::poradna_deti(); } elsif($pole->{hra} eq 'rodina') { kecy::poradna_rodina(); } elsif($pole->{hra} eq 'pro2') { kecy::poradna_pro2(); } elsif($pole->{hra} eq 'experti') { kecy::poradna_experti(); } elsif($pole->{hra} eq 'mejdan') { kecy::poradna_mejdan(); } else { kecy::poradna(); } } elsif($pole->{pohled} eq 'konec1') { print("
\n"); print("

Obsah vašeho košíku

\n"); print(kosik::html($objednavka, 1)); print("
\n"); print("

Chcete-li do košíku něco přidat, zvolte si hru v levém sloupci.\n"); print(" Pokud jste již s obsahem košíku spokojeni, vyplňte a odešlete následující údaje:

\n"); print(objednavka::formular1($objednavka, $odb)); } elsif($pole->{pohled} eq 'konec2') { print("
\n"); print("

Obsah vašeho košíku

\n"); print(kosik::html($objednavka, 1)); print("
\n"); print("

Chcete-li do košíku něco přidat, zvolte si hru v levém sloupci.\n"); print(" Pokud jste již s obsahem košíku spokojeni, vyplňte a odešlete následující údaje:

\n"); print(objednavka::formular2($objednavka, $odb)); } elsif($pole->{pohled} eq 'objednavka') { # Následující funkci předáváme pouze odkaz na databázi obchod ($odb), kde se zkontroluje, zda # neodesíláme tutéž objednávku podruhé, a pak se tam objednávka uloží. Kromě toho bude funkce # také aktualizovat stav skladových zásob u každé objednané položky, přičemž položky mohou ležet # v různých databázích (hry v databázi hry ($databaze), ostatní v databázi obchod). To už zde ale # nemusíme řešit, protože už při načítání objednávky (funkce objednavka::zjistit() volaná nahoře) # se ke každé položce v košíku uložil odkaz na databázový objekt, kde lze dotyčné zboží nalézt. print(objednavka::zpracovat($objednavka, $odb)); } elsif($hledat ne '') { print("

Výsledky hledání řetězce '$hledat' v katalogu

\n"); print(katalog::hledat($db, $hledat)); } # Na začátku skriptu jsme zajistili, že parametr "pohled" není prázdný. # Sem se dostaneme pouze v případě, že měl neznámou hodnotu. else { print("

Chyba: neznámý parametr pohled='$pole->{pohled}'

\n"); print(katalog::akce($databaze, $pole->{odd})); } ###!!! Tyhle dva trpaslíky možná budeme chtít umístit nějak zajímavěji, třeba do řádku tabulky se zbožím. # V některých pohledech už jsou zobrazeni uvnitř. A v některých je nechceme zobrazit vůbec. unless($pole->{pohled} eq 'obecne') { print("


\n"); print(" \n"); print(" \n"); } } #------------------------------------------------------------------------------ # Vypíše menu (míněno do Ondrova levého sloupce). #------------------------------------------------------------------------------ sub vypsat_menu { print("

\n"); # print("
\n"); if($pole->{odd} eq 'info') { print(odkazpar("> DODACÍ PODMÍNKY", $pole, 'pohled=obecne'), "
\n"); print(odkazpar("> SLOVENSKO", $pole, 'pohled=slovensko'), "
\n"); # print(odkazpar("> SLEVY", $pole, 'pohled=slevy'), "
\n"); } else { print(odkazpar("> NOVINKY", $pole, 'pohled=novinky'), "
\n"); print(odkazpar("> AKCE", $pole, 'pohled=akce'), "

\n"); print(odkazpar("> CENÍK", $pole, 'pohled=cenik'), "
\n"); } if($pole->{odd} eq 'hry') { print("
\n"); print(odkazpar("> PORADNA", $pole, 'pohled=poradna'), "
\n"); print(odkazpar("> Všechny hry", $pole, 'pohled=seznam'), "
\n"); # print(odkazpar("> Hry pro 1 hráče", $pole, 'pohled=hra', 'hra=xxx'), "
\n"); ###!!! print(odkazpar("> Hry pro 2 hráče", $pole, 'pohled=poradna', 'hra=pro2'), "
\n"); ###!!! # print(odkazpar("> Hry pro více hráčů", $pole, 'pohled=hra', 'hra=xxx'), "
\n"); ###!!! print(odkazpar("> Hry na mejdan", $pole, 'pohled=poradna', 'hra=mejdan'), "
\n"); print(odkazpar("> Rodinné hry", $pole, 'pohled=poradna', 'hra=rodina'), "
\n"); print(odkazpar("> Dětské hry", $pole, 'pohled=poradna', 'hra=deti'), "
\n"); print(odkazpar("> Hry pro náročné", $pole, 'pohled=poradna', 'hra=experti'), "
\n"); # print("> Speciality
\n"); ###!!! } elsif($pole->{odd} eq 'koralky') { print("
\n"); print(odkazpar("> Náušnice", $pole, 'pohled=hra', 'hra=nau'), "
\n"); print(odkazpar("> Náramky", $pole, 'pohled=hra', 'hra=nar'), "
\n"); print(odkazpar("> Náhrdelníky", $pole, 'pohled=hra', 'hra=nah'), "
\n"); print(odkazpar("> Sady", $pole, 'pohled=hra', 'hra=sad'), "
\n"); } elsif($pole{odd} eq 'koralky') { print("
\n"); print(odkazpar("> Náušnice", \%pole, 'pohled=hra', 'hra=nau'), "
\n"); print(odkazpar("> Náramky", \%pole, 'pohled=hra', 'hra=nar'), "
\n"); print(odkazpar("> Náhrdelníky", \%pole, 'pohled=hra', 'hra=nah'), "
\n"); print(odkazpar("> Sady", \%pole, 'pohled=hra', 'hra=sad'), "
\n"); } print("

\n"); } #------------------------------------------------------------------------------ # Vypíše pravý okraj stránky s výjimkou odkazů na Palubu vpravo nahoře. #------------------------------------------------------------------------------ sub vypsat_pravy_okraj { my $db; my $zbozi; if($pole->{odd} eq 'hry') { $db = $databaze; } else { $db = $odb; } $zbozi = katalog::dbzbozi($db, $pole->{odd}); print("\n"); print("
\n"); # Dát dohromady jednotlivé kusy, ze kterých se může skládat pravý okraj. # Podobné hry nejsou k dispozici vždycky. Novinky a akce zase nezobrazovat, pokud je totéž zobrazeno v hlavní části stránky. my @prvky; if($pole->{kosik} ne '' && $pole->{pohled} !~ m/^(konec|objednavka)/) { my $kosik = "

".odkazpar('KOŠÍK', $pole, 'pohled=konec1')."

\n"; $kosik .= kosik::html_kompakt($objednavka, 1); # Přidat odkaz na objednávkový formulář. my $odkazobr = odkazpar("", $pole, 'pohled=konec1'); my $odkaztxt = odkazpar("K pokladně", $pole, 'pohled=konec1'); $kosik .= "

$odkaztxt
\n"; $kosik .= " $odkazobr

\n"; push(@prvky, $kosik); } if($pole->{odd} eq 'hry' && length($pole->{hra})==3) { my $podobne = katalog::podobne($db, $pole->{hra}); if($podobne ne '') { push(@prvky, $podobne); } } if($pole->{kosik} eq '' || $pole->{pohled} =~ m/^(konec|objednavka)/) { if($pole->{pohled} eq 'akce') { push(@prvky, katalog::novinky_mini($pole->{odd}, $zbozi, 4)); } elsif($pole->{pohled} eq 'novinky') { push(@prvky, katalog::akce_mini($pole->{odd}, $zbozi, 4)); } else { push(@prvky, katalog::novinky_mini($pole->{odd}, $zbozi, 2)); push(@prvky, katalog::akce_mini($pole->{odd}, $zbozi, 2)); } } print(join("
\n", @prvky)); print("
\n"); print("\n"); } #------------------------------------------------------------------------------ # Vypíše závěr stránky HTML. #------------------------------------------------------------------------------ sub vypsat_zapati { # Poslat konec stránky. print < EOF ; } #------------------------------------------------------------------------------ # Vypíše dobu, po kterou program běžel. K tomu potřebuje dostat časové otisky # začátku a konce. #------------------------------------------------------------------------------ sub sestavit_hlaseni_o_trvani_programu { my $starttime = shift; my $stoptime = time(); my $cas = $stoptime-$starttime; my $hod = int($cas/3600); my $min = int(($cas%3600)/60); my $sek = $cas%60; my $hlaseni; if($hod==0) { if($min==0) { $hlaseni = sprintf("Program běžel $sek vteřin%s.\n", $sek==1 ? "u" : $sek>=2 && $sek<=4 ? "y" : ""); } else { $hlaseni = sprintf("Program běžel %d:%02d minut.\n", $min, $sek); } } else { $hlaseni = sprintf("Program běžel %2d:%02d:%02d hodin.\n", $hod, $min, $sek); } return $hlaseni; }