#!/usr/bin/perl # Zobrazí nebo zpracuje přihlašovací formulář. # Copyright © 2004-2024 Dan Zeman # Licence: GNU GPL # 18-21.8.2024: zduplikován formulář na přihlašování do turnajů a upraven use utf8; # říct Perlu, že konstantní řetězce ve zdrojáku jsou v UTF use Encode; # funkce pro překódování use DBI; # spolupráce se serverem MySQL # Říct Perlu, kde najde Danovy sdílené knihovny. # CGI skripty běží pod uživatelem apache, který nemá tyto knihovny v cestě. use lib '/s/w/lib/dan'; use lib '/s/w/lib/cgi/mso'; use dancgi; # čtení parametrů z webu nebo z ARGV use dzsql; # Danovy funkce pro práci s MySQL use cas; # práce s daty a časem use jazyky; # jazykové verze textů use csort; # jazykově závislé řazení podle abecedy use mso; # funkce pro generování stránek o olympiádě binmode(STDOUT, ':utf8'); # říct Perlu, že UTF chceme i na výstupu ################################################################### # vypnutí a zapnutí přihlášky pomocí proměnné prihlasovani_otevreno # Připojit se k databázi. $databaze = mso::pripojit_se_k_databazi(); # Načíst parametry z URL. dancgi::cist_parametry(\%konfig); # Umožnit volat skript z příkazového řádku a předat parametry tam (např. perl partie.pl zdroj=cas). dancgi::rozebrat_parametry($ARGV[0], \%konfig); # Načíst formulář. if($konfig{co} eq 'zpracuj') { dancgi::cist_formular_post(\%konfig); } if($konfig{jazyk} eq '') { $konfig{jazyk} = 'cs'; } $jazyky::jazyk = $konfig{jazyk}; # Vždy se lze přihlásit pouze na jeden ročník: ten nejbližší, který bude, případně # ten, který právě probíhá. Zjistit, který ročník to je, a přepsat parametr rok, # ať už tam měl uživatel cokoli. $ted = cas::ted(); $roky = mso::dotazat_se_databaze($databaze, 'rok', 'konec', 'vcasne_prihlasky_do', 'rocniky ORDER BY rok'); for(my $i = 0; $i<=$#{$roky}; $i++) { $konfig{rok} = $roky->[$i]{rok}; $konfig{vcas} = $roky->[$i]{vcasne_prihlasky_do}; if($ted->{eden} <= cas::datum2eden($roky->[$i]{konec})) { last; } } if($konfig{co} ne 'zpracuj') { zobrazit_prihlasku($databaze, \%konfig); } else { zpracovat_prihlasku($databaze, \%konfig); } ############################################################################### # PODPROGRAMY ############################################################################### #------------------------------------------------------------------------------ # Zobrazí přihláškový formulář. #------------------------------------------------------------------------------ sub zobrazit_prihlasku { my $databaze = shift; my $konfig = shift; mso::vypsat_stranku( { "nazev" => "MSO: $konfig->{rok}: ".jazyky::zjistit("Prihlaska_skupiny"), "nadpis" => jazyky::zjistit("prihlaska_skupiny_nadpis", $konfig->{rok}), "telo" => prihlaska($databaze, $konfig), "rok" => $konfig->{rok} }); } #------------------------------------------------------------------------------ # Vypíše přihlašovací formulář. #------------------------------------------------------------------------------ sub prihlaska { my $databaze = shift; my $konfig = shift; my $stranka; ### Jakub: nastavení parametrů jsem přemístil nahoru, aby se dalo použít dřív. my $prihlasovani_otevreno = 0; ###!!! Výjimka za účelem ladění: IP adresa Zemanových může všechno. ###!!! Místo porovnání na rovnost regulární výraz, protože kolem adresy mohou být mezery. ###!!! Na novém kubu nefunguje standardní proměnná REMOTE_ADDR, je v ní local 127.0.0.1. # Které dny mají ještě volnou kapacitu? my $pondeli = 1; my $utery = 1; my $streda = 1; my $ctvrtek = 0; my $patek = 1; my $prihlaska_class = 'prihlaska'; if(!$prihlasovani_otevreno && $ENV{HTTP_X_REAL_IP} =~ m/91\.201\.20\.97/ && !$konfig{notest}) { $prihlasovani_otevreno = 1; $prihlaska_class = 'prihlaska_test'; } if(!$prihlasovani_otevreno) { $stranka .= jazyky::zjistit("prihlaska_skoly_uvod_neaktivni"); } else{ # Vypsat formulář přihlášky. $stranka .= jazyky::zjistit("prihlaska_skupiny_uvod", "index.pl?".dancgi::sestavit_parametry_odkaz(\%main::konfig, "telo=text.pl", "text=kde.htm")."#vstupne"); my $parametry = dancgi::sestavit_parametry_odkaz(\%main::konfig, "telo=prihlaska_skupiny.pl", "co=zpracuj"); $stranka .= "
\n"; $stranka .= " \n"; $stranka .= " \n"; $stranka .= " \n"; $stranka .= " \n"; $stranka .= " \n"; $stranka .= " \n"; $stranka .= " \n"; $stranka .= " \n"; $stranka .= " \n"; $stranka .= " \n"; $stranka .= " \n"; $stranka .= " \n"; $stranka .= " \n"; $stranka .= " \n"; $stranka .= " \n"; $stranka .= " \n"; $stranka .= " \n"; $stranka .= " \n"; $stranka .= " \n"; $stranka .= " \n"; $stranka .= " \n"; $stranka .= " \n"; $stranka .= " \n"; $stranka .= " \n"; $stranka .= "
".jazyky::zjistit("nazev_skupiny")."
".jazyky::zjistit("prihlaska_skoly_diakritika")."\n"; #$stranka .= "

".jazyky::zjistit("nadpis_soukromi")."

\n"; $stranka .= "
".jazyky::zjistit("email")."
".jazyky::zjistit("telefonni_cislo")." (s mezerami)
".jazyky::zjistit("cas_prichodu")."
".jazyky::zjistit("cas_odchodu")."
".jazyky::zjistit("zaci")."

".jazyky::zjistit("vek_deti")."

".jazyky::zjistit("pocet_deti")."

\n"; $stranka .= " ".jazyky::zjistit("preferovane_dny")."
\n"; $stranka .= $pondeli ? "  ".jazyky::zjistit("den1")."\n" : "  ".jazyky::zjistit("den1")." - OBSAZENO\n"; $stranka .= $utery ? "  ".jazyky::zjistit("den2")."
\n" : "  ".jazyky::zjistit("den2")." - OBSAZENO
\n"; $stranka .= $streda ? "  ".jazyky::zjistit("den3")."\n" : "  ".jazyky::zjistit("den3")." - OBSAZENO\n"; $stranka .= $ctvrtek ? "  ".jazyky::zjistit("den4")."
\n" : "  ".jazyky::zjistit("den4")." - OBSAZENO
\n"; $stranka .= $patek ? "  ".jazyky::zjistit("den5")."
\n" : "  ".jazyky::zjistit("den5")." - OBSAZENO
\n"; #$stranka .= "  ".jazyky::zjistit("prihlaska_skoly_nahrada")."\n"; $stranka .= "
".jazyky::zjistit("jmeno_dospeleho")."
".jazyky::zjistit("poznamka")."
\n"; $stranka .= " ".jazyky::zjistit("robotazka")." \n"; $stranka .= "
\n"; # Přidat parametry, které uživatele nezajímají, ale my je potřebujeme. $stranka .= " \n"; $stranka .= " \n"; my $cas = cas::ted()->{rmdhms}; $stranka .= " \n"; # Přidat tlačítka pro odeslání nebo vymazání formuláře. $stranka .= "

\n"; my $disabled = $prihlasovani_otevreno ? '' : ' disabled'; $stranka .= " \n"; $stranka .= " \n"; $stranka .= "

\n"; $stranka .= "
\n"; } return $stranka; } #============================================================================== # Funkce pro zpracování vyplněné přihlášky #============================================================================== #------------------------------------------------------------------------------ # Zkontroluje údaje na přihlášce, uloží je do databáze, pošle je e-mailem # organizátorům a uživateli vygeneruje odpověď. #------------------------------------------------------------------------------ sub zpracovat_prihlasku { my $databaze = shift; my $konfig = shift; # Údaje s přihláškou jsou v hashi %{$konfig} pohromadě s případnými dalšími # parametry skriptu. Přidat mezi údaje datum a čas odeslání přihlášky. $konfig->{casode} = cas::ted()->{rmdhms}; # Klárka ještě potřebuje čas odeslání přihlášky ve formátu shodném s Accessem. if($konfig->{casode} =~ m/(\d\d\d\d)(\d\d)(\d\d)(\d\d)(\d\d)(\d\d)/) { $konfig->{cas_odeslani_access} = sprintf("%d.%d.%d %d:%02d:%02d", $3, $2, $1, $4, $5, $6); } # Variabilní symbol je stejný jako čas odeslání přihlášky, akorát se na začátku # musí umazat rok, aby symbol neměl 14 číslic, ale jen 10. $konfig->{vs} = $konfig->{casode}; $konfig->{vs} =~ s/^\d\d\d\d//; # Zkontrolovat přihlášku. my $chyby = zkontrolovat_prihlasku($databaze, $konfig); # Pokud byla kontrola úspěšná, uložit údaje do databáze a odeslat je e-mailem organizátorům. unless(scalar(@{$chyby})) { #ulozit_prihlasku_do_databaze($databaze, $konfig); odeslat_prihlasku_e_mailem($databaze, $konfig); } # Vygenerovat odpověď pro uživatele. zobrazit_potvrzovaci_stranku($databaze, $konfig, $chyby); } #------------------------------------------------------------------------------ # Zkontroluje údaje z přihlášky a vrátí seznam chyb, které najde. #------------------------------------------------------------------------------ sub zkontrolovat_prihlasku { my $databaze = shift; my $konfig = shift; my @chyby; # Zkontrolovat, že uživatel prohlásil, že není robot. my $ne = jazyky::zjistit("ne"); if($konfig->{robotazka} !~ m/^$ne$/i) { push(@chyby, "chyba_robotazka"); } # Odstranit z názvu školy přebytečné mezery. $konfig->{nazev_skoly} =~ s/^\s+//; $konfig->{nazev_skoly} =~ s/\s+$//; $konfig->{nazev_skoly} =~ s/\s+/ /g; # Zkontrolovat, že název není prázdný. if($konfig->{nazev_skoly} eq "") { push(@chyby, "chyba_nazev_skupiny"); } # Odstranit ze jména vyučujícího přebytečné mezery. $konfig->{vyucujici} =~ s/^\s+//; $konfig->{vyucujici} =~ s/\s+$//; $konfig->{vyucujici} =~ s/\s+/ /g; # Zkontrolovat, že jméno není prázdné. if($konfig->{vyucujici} eq "") { push(@chyby, "chyba_dospely"); } # Rozdělit jméno na slova, u každého zajistit první písmeno velké a ostatní malá. $konfig->{vyucujici} = join(" ", map{m/^(von|van|de[rn]?|d[ia])$/ ? $_ : ucfirst(lc($_))}(split(/\s+/, $konfig->{vyucujici}))); # Odstranit z věku žáků přebytečné mezery. $konfig->{vek} =~ s/^\s+//; $konfig->{vek} =~ s/\s+$//; $konfig->{vek} =~ s/\s+/ /g; # Zkontrolovat, že věk žáků není prázdný. if($konfig->{vek} eq "") { push(@chyby, "chyba_vek_deti"); } # Zkontrolovat, že počet žáků není prázdný. if($konfig->{pocet_zaku} eq "") { push(@chyby, "chyba_pocet_deti"); } # Zkontrolovat, že vybral alespoň jeden preferovaný den. my @dny; foreach my $den ('den1', 'den2', 'den3', 'den4', 'den5', 'nahradnik') { if($konfig->{$den}) { push(@dny, $den); } } if(!scalar(@dny)) { push(@chyby, "chyba_dny"); } # Odstranit z e-mailu přebytečné mezery. $konfig->{email} =~ s/^\s+//; $konfig->{email} =~ s/\s+$//; # E-mail musí vypadat jako běžný e-mail, tj. např. musí obsahovat zavináč a na konci musí být dva znaky nebo vyjmenované domény. # Generické domény nejvyššího řádu jsem zjišťoval 24.9.2008 podle Wikipedie (cs:Doména nejvyššího řádu). if($konfig->{email} !~ m/(\w|[-\._])+\@(\w|[-\._])+\.(\w\w|aero|biz|cat|com|coop|edu|gov|info|int|jobs|mil|mobi|museum|name|net|org|pro|travel)$/i) { push(@chyby, "chyba_email"); } # Převést e-mailovou adresu na malá písmena. $konfig->{email} = lc($konfig->{email}); # Odstranit z příchodu a odchodu přebytečné mezery. $konfig->{prichod} =~ s/^\s+//; $konfig->{prichod} =~ s/\s+$//; $konfig->{prichod} =~ s/\s+/ /g; $konfig->{odchod} =~ s/^\s+//; $konfig->{odchod} =~ s/\s+$//; $konfig->{odchod} =~ s/\s+/ /g; # Zkontrolovat, že čas příchodu a odchodu je zadán if($konfig->{prichod} eq "" or $konfig->{odchod} eq "") { push(@chyby, "chyba_prichod"); } return \@chyby; } #------------------------------------------------------------------------------ # Uloží údaje z přihlášky do databáze MySQL na serveru. Osobní údaje putují do # tabulky osoby_auto. Údaje o přihláškách (propojení osoby s akcemi) putují do # tabulky prihlasky_auto. #------------------------------------------------------------------------------ sub ulozit_prihlasku_do_databaze { my $databaze = shift; my $konfig = shift; # Před uložením data upravit. # Přejmenovat položku cas_odeslani_access na datum_prihlasky. $konfig->{datum_prihlasky} = $konfig->{cas_odeslani_access}; # Údaje o preferovaných dnech nemohou být prázdné řetězce, ale mohou to být nuly. foreach my $den ('den1', 'den2', 'den3', 'den4', 'den5') { if($konfig->{$den} eq "") { $konfig->{$den} = 0; } } # Přidat informace o přihláškách do tabulky skoly_auto. my @nazvy = qw(datum_prihlasky nazev_skoly email telefonni_cislo vek pocet_zaku den1 den2 den3 den4 poznamka cas_odeslani_access); my $seznam_poli = join(", ", @nazvy); # Řetězcové hodnoty musí být v apostrofech, číselné bez apostrofů. # A pozor, chce_platit_predem může být 1 nebo 0, ale ne prázdný řetězec! $konfig->{chce_platit_predem} = 0 unless($konfig->{chce_platit_predem}); my $hodnoty_pro_sql = dzsql::obalit_textove_hodnoty($konfig, ['clen', '_celkem_startovne', 'chce_platit_predem']); my @hodnoty = map {encode('utf8', $hodnoty_pro_sql->{$_})} (@nazvy); my $seznam_hodnot = join(', ', @hodnoty); my $dotaz = "INSERT INTO osoby_auto ($seznam_poli) VALUES ($seznam_hodnot);"; dzsql::do_or_mail($databaze, $dotaz, 'zemanovi@hrejsi.cz'); open(LOG, ">>prihlasky.log"); print LOG ("$dotaz\n"); print LOG ("$DBI::errstr\n"); # Přidat informace o jednotlivých přihláškách na akce do tabulky prihlasky_auto. foreach my $a (@{$konfig->{_akce}}) { # Může se stát, že v databázi je startovné prázdný řetězec (ne nula). To by způsobilo chybu v syntaxi SQL. $a->{startovne} = 0 if($a->{startovne} eq ""); # Připravit hash s daty do databáze. my %data = ( "datum_prihlasky" => $konfig->{cas_odeslani_access}, "rok" => $a->{rok}, "kod_hry" => $a->{hra}, "kod_turnaje" => $a->{turnaj}, "ma_dati" => $a->{startovne}, "volitelny_turnaj" => $a->{volitelny_turnaj}, ); @nazvy = keys(%data); $seznam_poli = join(", ", @nazvy); # Řetězcové hodnoty musí být v apostrofech, číselné bez apostrofů. @hodnoty = map{$_ =~ m/(rok|ma_dati|volitelny_turnaj)/ ? $data{$_} : "'$data{$_}'"}(@nazvy); $seznam_hodnot = join(", ", @hodnoty); $dotaz = "INSERT INTO prihlasky_auto ($seznam_poli) VALUES ($seznam_hodnot);"; dzsql::do_or_mail($databaze, $dotaz, 'zemanovi@hrejsi.cz'); print LOG ("$dotaz\n"); print LOG ("$DBI::errstr\n"); } close(LOG); } #------------------------------------------------------------------------------ # Odešle údaje z přihlášky e-mailem organizátorům. # Kopie se pošle i přihlášenému, ale e-mail je vždy česky, nelokalizuje se. #------------------------------------------------------------------------------ sub odeslat_prihlasku_e_mailem { my $databaze = shift; my $konfig = shift; my $sendmail; if(-e "/usr/lib/sendmail") { $sendmail = "|/usr/lib/sendmail -oi -t"; } else { $sendmail = ">posledni-prihlaska.txt"; } my $adresat = 'skoly@deskohrani.cz'; my $kopie = $konfig->{email}; # V předmětu zprávy chceme mít jméno přihlášeného. Protože je ale mnohem # obtížnější zajistit správné zobrazení diakritiky v předmětu, raději diakritiku odstraníme. my $jmeno_subject = "$konfig->{nazev_skoly}"; $jmeno_subject =~ tr/ÁČĎÉĚÍŇÓŘŠŤÚŮÝŽáčďéěíňóřšťúůýžß/ACDEEINORSTUUYZacdeeinorstuuyzs/; $jmeno_subject = encode("ascii", $jmeno_subject); my $mail; $mail .= "From: Robot Hrejsi \n"; $mail .= "Reply-to: \"$jmeno_subject\" <$konfig->{email}>\n"; $mail .= "To: $adresat\n"; $mail .= "Cc: $kopie\n" if($kopie ne ""); $mail .= "Subject: MSO prihlaska odpoledni skupiny: $jmeno_subject\n"; $mail .= "Content-Type: text/plain; charset=\"utf-8\"\n"; $mail .= "Content-Transfer-Encoding: 8bit\n\n"; # Sestavit tělo zprávy. $mail .= "Název školy/organizace: $konfig->{nazev_skoly}\n"; $mail .= "Jméno zodpovědné dospělé osoby: $konfig->{vyucujici}\n"; $mail .= "Věk dětí: $konfig->{vek} \n"; $mail .= "Počet dětí: $konfig->{pocet_zaku}\n"; $mail .= "Čas: $konfig->{prichod} - $konfig->{odchod}\n"; $mail .= "E-mail: $konfig->{email} \n"; $mail .= "Telefonní číslo: $konfig->{telefonni_cislo} \n"; # Připsat preferované dny, které vybral, ostatní neuvádět. my @dny; foreach my $den ('den1', 'den2', 'den3', 'den4', 'den5', 'nahradnik') { if($konfig->{$den}) { push(@dny, jazyky::zjistit($den)); } } $mail .= "Preferované dny: ".join(", ", @dny)."\n"; $mail .= "Poznámka: $konfig->{poznamka}\n"; $mail .= "Čas odeslání: $konfig->{cas_odeslani_access}\n \n"; $mail .= jazyky::zjistit("potvrzeni_skoly_mail")."\n"; # Odeslat zprávu organizátorům. open(SENDMAIL, $sendmail) or print "Nemůžu najít sendmail: $!\n"; print SENDMAIL ($mail); close(SENDMAIL); open(KOPIE, ">posledni-prihlaska.txt"); print KOPIE ($mail); close(KOPIE); open(KOPIE, ">>archiv_prihlasek.txt"); print KOPIE ("----------------------------------------------------------------------\n"); print KOPIE ($mail); close(KOPIE); } #------------------------------------------------------------------------------ # Vygeneruje pro uživatele stránku se zprávou o úspěchu či neúspěchu jím # odeslané přihlášky. #------------------------------------------------------------------------------ sub zobrazit_potvrzovaci_stranku { my $databaze = shift; my $konfig = shift; my $chyby = shift; my $nadpis; my $stranka; # Pokud byly v přihlášce nalezeny chyby, upozornit uživatele, že přihláška nebyla přijata. if(scalar(@{$chyby})) { $nadpis = jazyky::zjistit("prihlaska_nadpis_chyba"); $stranka .= "

".jazyky::zjistit("prihlaska_nadpis2_chyba")."

\n"; $stranka .= "\n"; } # Pokud byla přihláška bez chyb, ukázat uživateli přehled údajů a oznámit mu, že přihláška byla přijata. else { $nadpis = jazyky::zjistit("potvrzeni"); $stranka .= jazyky::zjistit("potvrzeni_nadpis"); $stranka .= "\n"; $stranka .= " \n"; $stranka .= " \n"; $stranka .= " \n"; $stranka .= " \n"; $stranka .= " \n"; my @dny; foreach my $den ('den1', 'den2', 'den3', 'den4', 'den5', 'nahradnik') { if($konfig->{$den}) { push(@dny, jazyky::zjistit($den)); } } $stranka .= " \n"; $stranka .= " \n"; $stranka .= " \n"; $stranka .= "
".jazyky::zjistit("nazev_skupiny").": $konfig->{nazev_skoly}
".jazyky::zjistit("jmeno_dospeleho").": $konfig->{vyucujici}
".jazyky::zjistit("vek_deti").": $konfig->{vek}
".jazyky::zjistit("pocet_deti").": $konfig->{pocet_zaku}
E-mail: $konfig->{email}
".jazyky::zjistit("telefonni_cislo").": $konfig->{telefonni_cislo}
".jazyky::zjistit("preferovane_dny").": ".join(", ", @dny)."
".jazyky::zjistit("cas").": $konfig->{prichod} - $konfig->{odchod}
".jazyky::zjistit("poznamka").": $konfig->{poznamka}
\n"; } # Obalit stránku jednotným záhlavím a zápatím a poslat ji na výstup. mso::vypsat_stranku( { "nazev" => "MSO: $konfig->{rok}: ".jazyky::zjistit("Prihlaska_skupiny"), "nadpis" => $nadpis, "telo" => $stranka, "rok" => $konfig->{rok} }); }