#!/usr/bin/perl # CGI přístup k databázi her. Generuje jak seznamy, tak stránky o konkrétních hrách. # (c) prosinec 2002 Daniel Zeman # 30.12.2003: přechod na UTF-8 use utf8; use Encode; # Přinutit Perl, aby UTF8 vypisoval jako UTF8 a nevymýšlel pro mě "vhodné" osmibitové kódování. binmode STDOUT, ":utf8"; # Zjistit cestu pro odkazování na statické stránky hrejsi. open(KONFIG, "../cgi.cfg"); while() { if(m/(\S+)\s*=\s*([^\r\n]*)/) { $konfig{$1} = $2; } } close(KONFIG); $koren_hrejsi = $konfig{ccesta_html_www}; $koren_system = $konfig{scesta_html_www}; # Přečíst parametry. do "../formdata.pl"; precist_parametry_url(); precist_data_formulare() if($pole{formular}); # Pro ladící účely si nachystat výpis parametrů na výstup. $ladeni = 0; if($ladeni) { foreach($key, sort(keys(%pole))) { $dbg_parametry .= "$key = $pole{$key}\n"; } $dbg_parametry = "

$dbg_parametry

\n"; } # Načíst procedury na čtení tabulky her. do "cist.pl"; # Načíst tabulku her. precist_hry("hry.txt"); precist_provedeni("provedeni.txt"); zjistit_pocet_exemplaru("exemplare.txt"); zjistit_pocet_na_prodej("prodej.txt"); # Poslat MIME záhlaví dokumentu. print("Content-Type: text/html; charset=utf-8\n\n"); # Nachystat si proměnné části začátku stránky. if($pole{radit} eq "pocethracu") { $pocethracu = " checked"; } else { $abecedne = " checked"; } if($pole{jenspravidly}) { $jenspravidly = " checked"; } if($pole{jenlzezahrat}) { $jenlzezahrat = " checked"; } if($pole{jenlzekoupit}) { $jenlzekoupit = " checked"; } # Poslat začátek stránky. if($pole{hra} eq "") { print("\n"); print("\n"); print("\n"); print("Palubní pokladnice her\n"); print("\n"); print("\n"); print("\n"); print("\n"); print("\n"); print("\n"); print("\n"); print("\n"); print("\n"); print("\n"); print("\n"); print("\n"); print("\n"); print("\n"); print("\n"); print("\n"); print("

\n"); print("

\n"); print("\n"); print("\n"); print("\n"); print("\n"); print("\n"); print("

\n"); print("\n"); print("\n"); print("\n"); print("\n"); print("

\n"); print("

\n"); print(" \n"); print("\n"); print("$dbg_parametry\n"); print("

Pokladnice her

\n"); print("\n"); } else { generovat_stranku_hry($pole{hra}); exit; } # Neřadíme hry abecedně, protože by byla spousta problémů s Unicodem a systémovým locale. # Místo toho spoléháme na řazení, které provedl Access těsně před exportem. # Seskupit hry podle počtu hráčů. # Pole indexované počtem hráčů, prvkem je pole kódů her připouštějících tento # počet. for($i = 0; $i<=$#kody; $i++) { # Zjistit možné počty hráčů pro tuto hru. my $mozne_pocty = $hry{"$kody[$i]: pocet hracu"}; # Odstranit ze seznamu počtů nepatřičné znaky. $mozne_pocty =~ s/[^0-9+,]//g; # Rozsekat počty do pole. @mozne_pocty = split(/,/, $mozne_pocty); # Pro každý počet si uložit tuto hru do příslušného seznamu. for($j = 0; $j<=$#mozne_pocty; $j++) { # Plus interpretovat jako "a libovolný vyšší počet". if($mozne_pocty[$j] =~ s/\+//) { # Do 6 hráčů musí být počty vyjmenovány jednotlivě. for($k = $mozne_pocty[j]+1; $k<=6; $k++) { push(@mozne_pocty, $k); } # Každopádně hru zařadit do kategorie "mnoho hráčů". push(@skupina_mnoho, $kody[$i]); } push(@{$skupiny[$mozne_pocty[$j]]}, $kody[$i]); } } # Vypsat hry. if($pole{radit} eq "pocethracu") { for($i = 0; $i<=$#skupiny; $i++) { if($#{$skupiny[$i]}>=0) { print("

Hry pro $i hráč".($i>0&&$i<5?"e":"ů")."

\n"); print("

\n"); for($j = 0; $j<=$#{$skupiny[$i]}; $j++) { vypsat_odkaz_na_hru_do_seznamu($skupiny[$i][$j]); } print("\n"); } } if($#skupina_mnoho>=0) { print("

Hry pro libovolný počet hráčů větší než 6

\n"); print("

\n"); for($j = 0; $j<=$#skupina_mnoho; $j++) { vypsat_odkaz_na_hru_do_seznamu($skupiny[$i][$j]); } print("\n"); } } else { my @abeceda; foreach my $pismeno ("A", "B", "C", "Č", "D", "E", "F", "G", "H", "CH", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "Ř", "S", "Š", "T", "U", "V", "W", "X", "Y", "Z", "Ž") { push(@abeceda, "$pismeno"); } print("

", join(" | ", @abeceda), "

\n"); print("

\n"); for($i = 0; $i<=$#kody; $i++) { $predch = vypsat_odkaz_na_hru_do_seznamu($kody[$i], $predch); } print("\n"); } # Vypsat závěr stránky. print <

EOF ; ############################################################################### # Podprogramy ############################################################################### #------------------------------------------------------------------------------ # Čte globální hash %hry a globální proměnnou $koren_hrejsi. # Vrátí název hry, abychom si ho mohli zapamatovat do příště a poznat, kdy # začíná nové písmeno abecedy. #------------------------------------------------------------------------------ sub vypsat_odkaz_na_hru_do_seznamu { my $hra = shift; # třípísmenný kód hry my $predch = shift; # název předcházející hry (abychom poznali nové písmeno v abecedě) if($predch eq "") { $predch = $hry{"$hra: nazev"}; } # Vynechat hry, kterým databáze účast ve webové pokladnici nedoporučuje # (buď o nich nemáme téměř žádné informace, nebo dokonce nejde o skutečné hry). if($hry{"$hra: noweb"}) { return $predch; } # Pokud to uživatel požaduje, vynechat hry, ke kterým nemáme pravidla. # To testujeme tak ze se podivame jestli je tam soubor nazevhry/pravidla.htm # nebo soubor nazevhry/pravidla.html if($pole{jenspravidly} && !((-e "/home/paluba/web/www/".$hry{"$hra: slozka hrejsi"}.'/pravidla.htm') || (-e "/home/paluba/web/www/".$hry{"$hra: slozka hrejsi"}.'/pravidla.html') ) ) { return $predch; }; # Pokud to uživatel požaduje, vynechat hry, které nemáme na Palubě. if($pole{jenlzezahrat} && $hry{"$hra: pocet exemplaru"}==0) { return $predch; } # Pokud to uživatel požaduje, vynechat hry, které nemáme na prodej. if($pole{jenlzekoupit} && !$hry{"$hra: prodej"}) { return $predch; } print("

"); # Začíná-li název hry na jiné písmeno než předcházející hra, vygenerovat # záložku pro skoky po abecedě. my $pismeno = substr($hry{"$hra: nazev"}, 0, 1); $pismeno = "CH" if(substr($hry{"$hra: nazev"}, 0, 2) =~ m/ch/i); if($pismeno ne substr($predch, 0, 1)) { print("\n"); } # U všech her přednostně nabízet dynamickou stránku. print("".$hry{"$hra: nazev"}.""); # Vypsat všechny alternativní názvy hry. if(exists($hry{$hra}{_dalsi_nazvy})) { print(" (", join("; ", @{$hry{$hra}{_dalsi_nazvy}}), ")"); } # Závěr. print("

\n"); return $hry{"$hra: nazev"}; } #------------------------------------------------------------------------------ # Zobrazí kořenovou stránku hry. #------------------------------------------------------------------------------ sub generovat_stranku_hry { my $hra = shift; # kód hry, jejíž stránka se má generovat my $slozka = $hry{"$hra: slozka hrejsi"}; my $pozadi = $hry{"$hra: htmlbgr"}; my $text = $hry{"$hra: htmltext"}; my $link = $hry{"$hra: htmllink"}; my $vlink = $hry{"$hra: htmlvlink"}; my $alink = $hry{"$hra: htmlalink"}; my $nazev = $hry{"$hra: nazev"}; my $dalsi_nazvy = $hry{"$hra: dalsi nazvy"}; print("\n"); print("\n"); print("\n"); print("".$nazev."\n"); print("\n"); print("\n"); # Nastavit barvy pozadí a popředí. my $body = "seznam her ].\n"); print("

\n"); # Pokud existuje, zobrazit barevný nadpis. if($slozka ne "" && -f "$koren_system/$slozka/obr/nadpis.gif") # if($slozka ne "")# && -f $nadpis) Tahle kontrola nefunguje, protože cesta z pohledu webu není stejná jako skutečná cesta v rámci systému. { my $nadpis = "$koren_hrejsi/$slozka/obr/nadpis.gif"; print("

$\"$nazev\"$

\n"); } else { print("

$nazev

\n"); } my $neboli; if($dalsi_nazvy) { $neboli = $dalsi_nazvy; $neboli = "neboli $neboli"; } print("$neboli\n"); print("

\n"); print("

Charakteristika

\n"); if ($hry{"$hra: pocet hracu"} ne "") {print("

Počet hráčů: ".$hry{"$hra: pocet hracu"}.".\n")}; if ($hry{"$hra: min vek"} !=0) {print("
Doporučený věk: alespoň ".$hry{"$hra: min vek"}." let.\n")}; if ($hry{"$hra: min delka"} !=0) {print("
Délka hry: ".$hry{"$hra: min delka"}." až ".$hry{"$hra: max delka"}." minut.\n")}; if(scalar(@{$hry{$hra}{_vydavatele}})>0) { print("
Vydavatel: ", join(", ", @{$hry{$hra}{_vydavatele}}), ".\n"); } if ($hry{"$hra: rok vydani"} !=0) {print("
Rok vydání: ".$hry{"$hra: rok vydani"}.".\n")}; if ($hry{"$hra: autor"} ne "") {print("
Autor: ".$hry{"$hra: autor"}.".\n")}; if ($hry{"$hra: oceneni"} ne "") {print("
Ocenění: ".$hry{"$hra: oceneni"}.".

\n")}; print("

".$hry{"$hra: upoutavka"}."

\n"); print("

".$hry{"$hra: charakteristika"}."

\n"); # Vypsat odkazy na stránky o této hře. # Zatím předpokládáme, že funkce generovat_stranku_hry() se volá jen jednou během jednoho běhu skriptu, jinak by bylo # efektivnější načíst tabulku odkazů dopředu! my $odkazy = access::cist_tabulku_access("odkazy.txt"); print("

$odkazy->[$i]{text}
Hru lze koupit

\n"); print("

\n"); #!!! Chtělo by to kontrolu, že soubor s fotkou existuje!!! if($slozka ne "" && -f "$koren_system/$slozka/obr/fotka.jpg") { print(" $\"fotografie\"$ \n"); } print("

\n"); print("

\n"); print("\n"); print("

Vytvořil tým Klubu deskových her Paluba.

\n"); print("

Obsah webových stránek je chráněn autorskými právy. Jeho reprodukce za komerčními účely je zakázána.

\n"); print("

The contents of these web pages is copyrighted. Any reproduction for commercial use is prohibited.

\n"); print("

$\"[PALUBA]\"$ \n"); print("

\n"); print("\n") if($hry{"$hra: htmltuc"}); print("\n"); print("\n"); }