#!/usr/bin/perl # Zpracuje data z formuláře přihlášky na olympiádu, uloží je na disk, pošle mailem a zobrazí potvrzovací HTML stránku. require("../access.pm"); ##################################################################### # Uprava a doplneni dat ##################################################################### $db_akci = "4ph1mr,Mistrovství ČR v deskových hrách družstev,1st Czech Team Championship in Board Games,1. tschechische Mannschaftsmeisterschaft in Brettspielen\n". "4phpre,Exhibiční utkání sponzorů,Exhibition Match of Sponsors,Exhibitionsbegegnung der Sponsoren\n". "abaoly,Olympijský turnaj v Abalone,Abalone Olympic Tournament,Olympiaturnier in Abalone\n". "abapar,Abalone páry,Abalone Pairs,Abalone Paare\n". "abazac,Abalone začátečníci,Abalone for Beginners,Abalone für Anfänger\n". "caroly,1. Mistrovství ČR v Carcassonne,Carcassonne Olympic Tournament,Olympiaturnier in Carcassonne\n". "carzac,Carcassonne začátečníci,Carcassonne for Beginners,Carcassonne für Anfänger\n". "claoly,Olympijský turnaj v Clanech,Clans Olympic Tournament,Olympiaturnier in Clans\n". "damecl,3. England Club,England Club,England Club\n". "damfri,Fríská dáma,Frisian Draughts,Friesische Dame\n". "damfus,Future Stars 10x10,Future Stars 10×10,Future Stars 10×10\n". "damita,1. Dolce Italia,Dolce Italia,Dolce Italia\n". "dammez,Mezinárodní Dáma 10x10,International Draughts 10×10,Internazionale Dame 10×10\n". "dammwc,Millenium World Cup III - česká dáma,Millenium World Cup III - Czech Draughts,Millenium World Cup III - tschechische Dame\n". "damutk,Utkání týmů z Česka, Anglie, Itálie a Fríska,Team Match of Czechia, England, Italy and Friesland,Mannschaftsbegegnung von Tschechien, England, Italien und Friesland\n". "desoly,Desetiboj,Decamentatlon,Denkzehnkampf\n". "dipoly,Evropská Diplomacie,European Diplomacy,Europäische Diplomatie\n". "dipkol,Koloniálmí Diplomacie,Diplomacy,Diplomatie\n". "dvooly,Olympijský turnaj v Dvonnu,Dvonn Olympic Tournament,Olympiaturnier in Dvonn\n". "entoly,Olympijský turnaj v Entropii,Entropy Olympic Tournament,Olympiaturnier in Entropie\n". "gipoly,Olympijský turnaj v Gipfu,Gipf Olympic Tournament,Olympiaturnier im Gipf\n". "gipzac,Gipf začátečníci,Gipf for Beginners,Gipf für Anfänger\n". "goo13x,Bleskovka Go 13x13,Lightning Go 13x13,Blitzgo 13x13\n". "goo19x,Bleskovka 19x19,Lightning Go 19x19,Blitzgo 19x19\n". "goo9x9,Bleskovka Go 9x9,Lightning Go 9x9,Blitzgo 9x9\n". "goooly,Olympijský turnaj v Go 19x19,Go Olympic Tournament 19×19,Olympiaturnier in Go 19×19\n". "hakoly,Olympijský křížovkářský turnaj,Crosswords Olympic Tournament,Olympiaturnier in Kreuzworträtsel\n". "hakqal,Hádankářské celotýdenní klání,Whole-Week Puzzle Contest,Wochenrätselwettbewerb\n". "konoly,Olympijský turnaj v Continuu,Continuo Olympic Tournament,Olympiaturnier im Continuo\n". "loaoly,Olympijský turnaj v Lines of Action,Lines of Action Olympic Tournament,Olympiaturnier in Lines of Action\n". "loazac,Lines of Action začátečníci,Lines of Action for Beginners,Lines of Actio für Anfänger\n". "memoly,Otevřený turnaj v Memorice,Memorics Open Tournament,Offenes Turnier in Memorik\n". "mempoh,5. český pohár Memoriky,Czech Memorics Cup,Tschechisches Memorik-Pokal\n". "metoly,Olympijský turnaj v Metru,Merto Olympic Tournament,Olympiaturnier in Metro\n". "metzac,Metro začátečníci,Metro for Beginners,Metro für Anfänger\n". "mutoly,Multiherní turnaj,Multigame Tournament,Multispielturnier\n". "osamcr,Mistrovství ČR v Osadnících,Settlers of Catan Championship,Siedler von Catan Meisterschaft\n". "osaoly,Olympijský turnaj v Osadnících,Settlers of Catan Olympic Tournament,Olympiaturnier in Siedler von Catan\n". "osazac,Osadníci začátečníci,Siedlers for Beginners,Siedlers für Anfänger\n". "otholy,Olympijský turnaj v Othellu,Othello Olympic Tournament,Olympiaturnier in Othello\n". "othble,Bleskové Othello,Lightning Othello, Blitzothello\n". "othopn,Otevřený turnaj v Othellu,Open Othello Tournament,Offenes Turnier in Othello\n". "othzac,Othello začátečníci,Othello for Beginners, Othello für Anfänger\n". "owaoly,Olympijský turnaj v Oware,Oware Olympic Tournament,Olympiaturnier im Oware\n". "owazac,Oware začátečníci,Oware for Beginners,Oware für Anfänger\n". "petoly,Pětimysl,Pentamind,Pentamind\n". "pisoly,Olympijský turnaj v Piškvorkách,Tic Tac Toe,Gomoku\n". "pisvar,Piškvorky a jejích varianty,Five-in-a-Row Variants,Fünf-gewinnt-Varianten\n". "scrang,Anglický scrabble,English Scrabble,Englisches Scrabble\n". "scrjun,Mistrovství ČR juniorů ve scrabblu,Czech Scrabble Junior Olympic Championship,Junioren-Olympiameisterschaft im tschechischen Scrabble\n". "scrjuo,Olympijský turnaj juniorů ve scrabblu,Czech Scrabble Junior Olympic Tournament,Junioren-Olympiaturniere im tschechischen Scrabble\n". "scrjuq,Kvalifikační turnaje ve scrabblu juniorů,Czech Scrabble Juniors Qualification,Junioren-Qualifikationsturniere im tschechischen Scrabble\n". "scrmar,Scrabble maratón,Czech Scrabble Marathon,Tschechisches Scrabble-Marathon\n". "scrmax,Maxiscrabble,Czech Maxiscrabble 21×21,Tschechisches Maxiscrabble 21×21\n". "scroly,Olympijský turnaj ve scrabblu,Czech Scrabble Olympic Tournament,Olympiaturnier im tschechischen Scrabble\n". "scroph,Ohebný opisovaný scrabble,Czech Duplicate Scrabble,Tschechisches Simultan-Scrabble\n". "scropi,Neohebný opisovaný scrabble (kvalifikace na Pohár),Limited Czech Duplicate Scrabble,Tschechisches Simultan-Scrabble Begrenzter Wortschatz\n". "scropn,Německý opisovaný scrabble,German Duplicate Scrabble,Deutsches Simultan-Scrabble\n". "scropr,Ruský opisovaný scrabble,Russian Duplicate Scrabble,Russisches Simultan-Scrabble\n". "scrpar,Scrabble Páry,Czech Scrabble Pairs,Tschechisches Scrabble Paare\n". "scrpre,Přemísťovací scrabble,Czech Transposing Scrabble,Tschechisches Versatz-Scrabble\n". "scrslo,Slovenský scrabble,Slovak Scrabble,Slowakisches Scrabble\n". "schble,Bleskový šach,Lightning Chess,Blitzschach\n". "schrap,Rapid šach,Rapid Chess,Rapid Schach\n". "sogble,Bleskové Šógi,Lightning Shogi,Olympiaturnier im Schogi\n". "sogoly,Olympijský turnaj v Šógách,Shogi Olympic Tournament,Olympiaturnier in Schogi\n". "srooly,Souboj rodin,Family contest,Familienwettbewerb\n". "tamoly,Olympijský turnaj v Tamsku,Tamsk Olympic Tournament,Olympiaturnier in Tamsk\n". "trnoly,Olympijský turnaj v Trans Americe,Trans America Olympic Tournament,Olympiaturnier in Trans America\n". "twioly,Olympijský turnaj v Twixtu,Twixt Olympic Tournament,Olympiaturnier im Twixt\n". "vrholy,Olympijský turnaj ve Vrhcábech,Backgammon Olympic Tournament,Olympiaturnier im Backgammon\n". "vrhvec,Večerní Vrhcáby,Evening Backgammon,Abendbackgammon\n". "vrhzac,Vrhcáby začátečníci,Backgammon for Beginners,Backgammon für Anfänger\n". "zatjun,Zatre junioři,Zatre for Juniors,Zatre Junioren\n". "zatoly,Olympijský turnaj v Zatre,Zatre Olympic Tournament,Olympiaturnier in Zatre\n". "zatzac,Zatre začátečníci,Zatre for Beginners,Zatre für Anfänger\n". "zeroly,Olympijský turnaj v Zertzu,Zertz Olympic Tournament,Olympiaturnier in Zertz\n". "zerzac,Zertz začátečníci,Zertz for Beginners,Zertz für Anfänger\n". "ztmoly,Olympijský turnaj ve Ztracených městech,Lost Cites Olympic Tournament,Olympiaturnier in Lost Cites\n". "ztmzac,Ztracená města začátečníci,Lost Cites for Beginners,Lost Cites für Anfänger\n". "pisblr,Bleskové Renju,Lightning Renju,Blitz-Renju\n". "scholy,Olympijský turnaj v šachu,Chess Olympic Tournament,Olympiaturnier im Schach\n". "osamcr,Mistrovství ČR v Osadnících,Settlers of Catan Championship,Siedler von Catan Meisterschaft\n". "pisolr,Olympijský turnaj Renju,Renju Olympic Tournament,Olympiaturnier in Renju\n". "prooly,Olympijský turnaj v Proroctví,Prophecy Olympic Tournament,Olympiaturnier in Prophezeiung\n". ""; @db_akci = split(/\n/, $db_akci); for($i = 0; $i<=$#db_akci; $i++) { @zaznam = split(/,/, $db_akci[$i]); $dbhash{$zaznam[0].".cs"} = $zaznam[1]; $dbhash{$zaznam[0].".en"} = $zaznam[2]; $dbhash{$zaznam[0].".de"} = $zaznam[3]; } # Doplnit datum prihlasky ($sec, $min, $hour, $mday, $mon, $year) = localtime(time); $mon++; if($year<1900) { $year += 1900; } $datum = "$mday.$mon.$year"; $cas = sprintf("$hour:%02d:%02d", $min, $sec); # Precist data vyplnena ve formulari. while(<>) { $formular = $formular.$_; } # Pro jistotu si necháme poslat i informace v surové formě. Proto si je okopírujem ještě než se do nich hmátne. $origform = $formular; $origform =~ s/&/
\n/g; # Dekodovat mezery. $formular =~ s/\+/ /g; # Rozdelit data podle polozek. @formular = split(/&/, $formular); for($i = 0; $i<=$#formular; $i++) { # Uložit příslušné pole formuláře do hashe. if($formular[$i] =~ m/(.*?)=(.*)/) { my $klic = $1; my $hodnota = $2; # Dekódovat zvláštní znaky v datech. for(my $j = 32; $j<256; $j++) { if($j!=hex("3C")) { $hex = sprintf("%02X", $j); $znak = chr($j); $klic =~ s/%$hex/$znak/ig; $hodnota =~ s/%$hex/$znak/ig; } } $pole{$klic} = $hodnota; } } # Zkompletovat registracni udaje. $vyplneno = $pole{jmeno} ne "" && $pole{prijmeni} ne "" && $pole{obec} ne "" && $pole{zeme} ne "" && $pole{pohlavi} ne "" && $pole{kategorie} ne "" && $pole{email} ne ""; if($pole{"4ph1mr"} eq "4ph1mr") { $vyplneno = $vyplneno && $pole{druzstvo} ne "" && $pole{jmenokap} ne "" && $pole{prijmenikap} ne "" && $pole{obeckap} ne "" && $pole{zemekap} ne "" && $pole{pohlavikap} ne "" && $pole{emailkap} ne ""; } if($pole{"srooly"} eq "srooly") { $vyplneno = $vyplneno && $pole{rodina} ne "" && $pole{jmenor1} ne "" && $pole{prijmenir1} ne "" && $pole{obecr1} ne "" && $pole{zemer1} ne "" && $pole{pohlavir1} ne "" && $pole{emailr1} ne ""; } if(!$vyplneno && $pole{jmeno} ne "test") { if($pole{jazyk} eq "cs") { $potvrzeni = "

Chyba: Přihláška odmítnuta!

\n

Nechali jste nevyplněné nejméně jedno pole přihlášky. Vraťte se prosím do formuláře, doplňte chybějící údaje o sobě a přihlášku znova odešlete. Děkujeme vám za spolupráci.

"; } else { $potvrzeni = "

Error: Registration rejected!

\n

You omitted to fill in at least one of the fields in the registration form. Please go back, complete the information on you and resubmit the form. Thank you for co-operation.

"; } } else { if($pole{jazyk} eq "cs") { $potvrzeni = "

Těšíme se na setkání v Praze!

\n

S potěšením jsme přijali vaši přihlášku na níže uvedené disciplíny Olympiády duševních sportů. Budete-li v budoucnosti chtít přihlášku změnit, použijte stejný formulář a přihlašte se znova. Budeme brát ohled pouze na poslední vaši přihlášku. Nezapomeňte prosím, že musíte přijít včas a zaplatit startovné, aby vaše přihláška zůstala v platnosti.

"; $osloveni = $pole{pohlavi} eq "muz" ? "Pan" : $pole{kategorie} ne "dite" ? "Paní" : "Slečna"; $kategorie = "kategorie: " . ($pole{kategorie} eq "dospely" ? "dospělý" : $pole{kategorie} eq "student" ? "student, důchodce, ZTP" : "dítě do 15 let"); if($pole{clenpal} eq "paluba") { $kategorie .= ", člen Paluby"; } if($pole{clenscr} eq "cas") { $kategorie .= ", člen ČAS"; } if($pole{clengoo} eq "cago") { $kategorie .= ", člen ČAGo"; } if($pole{clendam} eq "cfd") { $kategorie .= ", člen ČFD"; } if($pole{clenoth} eq "cfo") { $kategorie .= ", člen ČFO"; } if($pole{clenhak} eq "hadanka") { $kategorie .= ", člen SČHAK"; } $casova_nalepka = ($pole{pohlavi} eq "zena" ? "Přihlášena" : "Přihlášen") . " $datum ($cas SEČ)."; $zapati = "
Informace: olympiada\@hrejsi.cz, tel.: 281910418, 777552729
Vytvořila Klára Zemanová z Klubu deskových her Paluba
"; if($pole{"4ph1mr"} eq "4ph1mr") { $ctyrpohar = "

Přijali jsme přihlášku družstva $pole{druzstvo} do Čtyřpoháru s těmito údaji:

"; } if($pole{"srooly"} eq "srooly") { $rodiny = "

Přijali jsme přihlášku rodiny $pole{rodina} do Souboje rodin s těmito údaji:

"; } } else { $potvrzeni = "

See you in Prague!

\n

We are happy to receive your registration for the following events of the Mind Sports Olympiad Prague. Should you in future wish to make any corrections, use the same form and register anew. Only the last registration of a person will be kept. Please remember that you have to appear and pay the fee in time to keep your registration valid.

"; $osloveni = $pole{pohlavi} eq "muz" ? "Mr." : "Ms."; $kategorie = "category: " . ($pole{kategorie} eq "dospely" ? "adult" : $pole{kategorie} eq "student" ? "student, pensioner" : "child under 15"); if($pole{clenpal} eq "paluba") { $kategorie .= ", member of Paluba"; } if($pole{clenscr} eq "cas") { $kategorie .= ", member of ČAS"; } if($pole{clengoo} eq "cago") { $kategorie .= ", member of ČAGo"; } if($pole{clendam} eq "cfd") { $kategorie .= ", member of ČFD"; } if($pole{clenoth} eq "cfo") { $kategorie .= ", member of ČFO"; } if($pole{clenhak} eq "hadanka") { $kategorie .= ", member of SČHAK"; } $casova_nalepka = "Registered on $datum ($cas CET)."; $zapati = "
Information: olympiada\@hrejsi.cz, phone: +420/777852582
Created by Klára Zemanová of the Board Games Club Paluba
English translation by Daniel Zeman
"; if($pole{"4ph1mr"} eq "4ph1mr") { $ctyrpohar = "

We received the registration for Fight of Four of the team $pole{druzstvo} with the following data:

"; } if($pole{"srooly"} eq "srooly") { $rodiny = "

We received the registration of $pole{rodina} for the Fight of Families with the following data:

"; } } $prihlaska = "

$osloveni $pole{jmeno} $pole{prijmeni}"; $prihlaska = $prihlaska.", $pole{obec}, $pole{zeme}
\n"; $prihlaska = $prihlaska."$kategorie
\n"; $prihlaska = $prihlaska."e-mail: $pole{email}

\n\n"; $prihlaska = $prihlaska."
";
    # Projít pole načtená z formuláře, posbírat kódy akcí a uložit je do pole i na disk.
    $pole{datprihl} = "$datum $cas";
    zjistit_a_ulozit_vybrane_akce(\%pole, \%dbhash, \@vybrane_akce);
    # Seřadit akce podle času začátku. Seřazené je přidat do textu přihlášky.
    @vybrane_akce = sort{$dbhash{$a."-od"}<=>$dbhash{$b."-od"}}(@vybrane_akce);
    for($i = 0; $i<=$#vybrane_akce; $i++)
    {
        $prihlaska .= $dbhash{$vybrane_akce[$i]."-od"}." ".$dbhash{$vybrane_akce[$i].".".$pole{jazyk}}."\n";
    }
    $prihlaska .= "
\n"; # Přidat dovětek pro účastníky olympijského turnaje ve scrabblu (stačí česky). if(join(",", @vybrane_akce) =~ m/scroly/) { $potvrzeni .= "

Upozornění pro účastníky olympijského turnaje ve scrabblu: Na rozdíl od většiny turnajů, u tohoto turnaje platí snížené startovné pouze v případě, že ho také zaplatíte do 30.9.2003! Můžete tak učinit buď v hotovosti na Palubě v době, kdy je otevřena, nebo složenkou na adresu Dan a Klára Zemanovi, Vybíralova 15, Praha, 19800. Další slevu můžete získat, pokud nechcete mít v ceně občerstvení. U tohoto scrabblového turnaje si také můžete prohlédnout automaticky aktualizovaný seznam přihlášených, včetně nasazení do prvního kola a informací o vašem potenciálním soupeři.

\n"; } # Přidat k přihlášce informaci, kdy se dotyčný přihlašoval. $prihlaska .= "$ctyrpohar\n$rodiny

$casova_nalepka

\n"; # Odeslat e-mail s údaji z přihlášky. $prihlaska_mail = $prihlaska; $prihlaska_mail =~ s/<[^>]*>//gs; if($pole{jmeno} eq "test") { $adresat = "zeman\@ufal.mff.cuni.cz"; $kopie = "zeman\@ufal.mff.cuni.cz"; } else { $adresat = "olympiada\@hrejsi.cz"; $kopie = "admin\@hrejsi.cz"; } if(-e "/usr/lib/sendmail") { $sendmail = "|/usr/lib/sendmail -oi -t"; } else { $sendmail = ">posledni-prihlaska.txt"; } open(SENDMAIL, $sendmail) or print "Nemůžu najít sendmail: $!\n"; print SENDMAIL ("From: Robot Hrejsi \n"); print SENDMAIL ("Reply-to: $pole{jmeno} $pole{prijmeni} <$pole{email}>\n"); print SENDMAIL ("To: $adresat\n"); print SENDMAIL ("Cc: $kopie\n"); my $jmeno_do_predmetu = access::iso2ascii("$pole{jmeno} $pole{prijmeni}"); print SENDMAIL ("Subject: MSO prihlaska: $jmeno_do_predmetu\n"); print SENDMAIL ("Content-Type: text/plain; charset=\"iso-8859-2\"\n"); print SENDMAIL ("\n"); print SENDMAIL ("Uživatel vyplnil www přihlášku na stránce olympiády těmito údaji:\n\n$prihlaska_mail\n$origform\n"); } # Vytvoreni potvrzovaci stranky print < MSO: On-line registration $potvrzeni $prihlaska EOF ; print <
$zapati

[PALUBA]

EOF ; ##################################################################### # PODPROGRAMY ##################################################################### #------------------------------------------------------------------------------ # Projde pole načtená z formuláře, vybere z nich ta, která obsahují kódy # vybraných turnajů, uloží je do pole vybraných akcí a do souborů: jednou do # souboru přihlášených na konkrétní akci, jednou do souboru všech přihlášek na # olympiádu. #------------------------------------------------------------------------------ sub zjistit_a_ulozit_vybrane_akce { my $pole = $_[0]; # odkaz na hash se všemi poli formuláře my $akce = $_[1]; # odkaz na hash s dalšími informacemi o akcích my $vybrane = $_[2]; # odkaz na pole kódů akcí, které si dotyčný vybral # Připravit záznam o osobě do seznamů přihlášených. my $zaznam = "\"$pole->{jmeno}\";\"$pole->{prijmeni}\";\"$pole->{obec}\";\"$pole->{zeme}\";\"$pole->{email}\";\"$pole->{pohlavi}\";\"$pole->{kategorie}\";\"$pole->{clenpal}\";\"$pole->{clengoo}\";\"$pole->{clenscr}\";\"$pole->{clendam}\";\"$pole->{clenoth}\";\"$pole->{clenhak}\";\"$pole->{datprihl}\"\n"; # Odstranit uvozovky kolem prázdných řetězců. Dekodér by si to vyložil jako zneškodnění uvozovek, které jsou součástí # řetězce, a to je v našem případě vždy špatně. $zaznam =~ s/""//g; # Interně máme všechny texty uložené v ISO 8859-2, ale na disk je ukládáme ve Windows 1250. $zaznam = access::iso2win($zaznam); # Otevřít seznam všech přihlášek (kromě něj ještě zapíšeme každou akci do seznamu přihlášených na danou akci). open(PRIHLOLY, ">>prihlaseni.txt"); # Projít zaškrtnuté akce. my $key; foreach $key (keys(%{$pole})) { # Pole akce se od ostatních polí pozná takhle (datum-čas začátku): if($key =~ m/akce:(......)/) { # Dříve byl klíč současně časem začátku, který jinak chybí v tabulce akcí. Teď už ho tam ale doplnit nemůžeme. #my $termin = "$1.10.2003 $2:$3"; #$akce->{$pole->{$key}."-od"} = $termin; # Uložit kód akce do pole vybraných akcí. push(@{$vybrane}, $pole->{$key}); # Uložit údaje o přihlášeném do souboru se seznamem přihlášených na tuto akci. open(PRIHLAKCE, ">>prihlaseni-$pole->{$key}.txt"); print PRIHLAKCE ($zaznam); close(PRIHLAKCE); # Uložit kód akce a údaje o přihlášeném do souboru se seznamem všech přihlášených. print PRIHLOLY ("\"$pole->{$key}\";$zaznam"); } } close(PRIHLOLY); } #------------------------------------------------------------------------------ # Převede časový údaj z textového formátu dd.mm.rrrr hh:mm:ss do jednoho čísla, # udávajícího počet vteřin. #------------------------------------------------------------------------------ sub cas { my $textcas = $_[0]; # dd.mm.rrrr h:mm:ss $textcas =~ m/(\d+).(\d+).(\d+) (\d+):(\d+):(\d+)/; return $6+60*$5+60*60*$4+60*60*24*den("$1.$2.$3"); } #------------------------------------------------------------------------------ # Převede datum z textového formátu dd.mm.rrrr do jednoho čísla, udávajícího # počet dní od začátku epochy (1.1.1970). #------------------------------------------------------------------------------ sub den { my $epocha = 1970; my $datum = $_[0]; # dd.mm.rrrr my $vysledek = 0; $datum =~ m/(\d+)\.(\d+)\.(\d+)/; my $den = $1; my $mesic = $2; my $rok = $3; my($irok, $imesic); for($irok = $epocha; $irok<$rok; $irok++) { if(($irok % 400 == 0) || ($irok % 4 == 0) && ($irok % 100 != 0)) { $vysledek += 366; } else { $vysledek += 365; } } my @delka_mesice = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31); for($imesic = 1; $imesic<$mesic; $imesic++) { $vysledek += $delka_mesice[$imesic-1]; } if(($mesic>2) && (($irok%400==0) || ($irok%4==0) && ($irok%100!=0))) { $vysledek++; } $vysledek += $den; return $vysledek; }