#!/usr/bin/perl # Umožňuje pořadatelům kontrolovat přihlášky před jejich importem do Accessu. # Copyright © 2006-2011 Dan Zeman # Licence: GNU GPL use utf8; # říct Perlu, že konstantní řetězce ve zdrojáku jsou v UTF use DBI; # spolupráce se serverem MySQL use lib '/s/w/lib/dan'; use lib '/s/w/lib/cgi/mso'; use lib '/s/w/lib/cgi/mso/vnitro'; use dancgi; # čtení parametrů z webu nebo z ARGV use jazyky; # jazykové verze textů use mso; # funkce pro generování stránek o olympiádě binmode(STDOUT, ":utf8"); # říct Perlu, že UTF chceme i na výstupu # Připojit se k databázi. $databaze = mso::pripojit_se_k_databazi(); # Výchozí nastavení parametru. Muže být pořbito parametry z URL/ARGV. mso::provest_vychozi_nastaveni_parametru(\%konfig, $databaze); # 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 prihlaseni.pl akce=caroly). dancgi::rozebrat_parametry($ARGV[0], \%konfig); if($konfig{jazyk} eq "") { $konfig{jazyk} = "cs"; } $jazyky::jazyk = $konfig{jazyk}; # Poslat MIME záhlaví dokumentu. print("Content-Type: text/html; charset=utf-8\n\n"); # Poslat začátek stránky. print < Přehled nových přihlášek

Přehled nových přihlášek

Následující tabulka obsahuje seznam osob automaticky uložených přihlašovacím formulářem. Pokud některá osoba odeslala několik přihlášek, objeví se v seznamu několikrát. U každé osoby může následovat jeden nebo několik záznamů nalezených v databázi, které se s osobou více či méně shodují. Zaškrtněte záznamy, které podle vás skutečně patří osobě, jež odeslala přihlášku. Potom stiskněte tlačítko Uložit na konci stránky. Databáze na kub.cz si zapamatuje přihlášky, které jste přiřadili k nějakému záznamu, a zapamatuje si také ke kterému. Později budete moci takové přihlášky načíst do Accessu a trvale je přiřadit k dotyčné osobě. Pozor! Načtení přihlášek na akce nemá nic společného s údaji o osobě (jako je např. obec nebo e-mail). Pokud se tyto údaje v přihlášce liší od údajů uvedených u této osoby v databázi, a pokud se domníváte, že údaje z přihlášky jsou správné a údaje v databázi se mají opravit, musíte to udělat ručně. Mějte také na paměti, že zde porovnáváme přihlášky s databází vyexportovanou z Accessu na kub.cz. Pokud jste od posledního exportu prováděli v Accessu změny, toto porovnání nemusí být přesné.

EOF ; # Získat z databáze přehled nových přihlášek. # Načíst přihlášky, které ještě v Accessu nejsou, ale přihlašovací skript je uložil do MySQL. my $prihlasky = mso::dotazat_se_databaze($databaze, 'jmeno', 'prijmeni', 'obec', 'zeme', 'pohlavi', 'kategorie', 'clenpaluba', 'clenscrabble', 'clendama', 'clendama2', 'clengo', 'clenothello', 'clenhadanka', 'email', 'poznamka', 'cas_odeslani_access', 'vs', 'zaplaceno_dne', 'kod_osoby', 'osoby_auto ORDER BY zaplaceno_dne DESC, vs'); # Jestliže reagujeme na odeslání formuláře, zpracovat údaje. if($konfig{zpracovat}) { zpracovat_udaje(\%konfig, $prihlasky); } # Vypsat přehled objednávek. vypsat_prehled_prihlasek($prihlasky); # Poslat konec stránky. print <

Zpracované přihlášky (tj. takové, které už jste si načetli do Accessu) můžete odstranit z tohoto dočasného úložiště. Stisknutím následujícího tlačítka odstraníte ty přihlášky, které jsou nahoře zaškrtnuté. To znamená, že odstraníte příslušné záznamy z tabulky kub.cz/mso/osoby_auto a související záznamy z tabulky kub.cz/mso/prihlasky_auto. Záznamy z tabulky kub.cz/mso/osoby, které nahoře rovněž vidíte vedle zaškrtávátek, zůstanou nedotčeny, stejně jako záznamy z tabulky kub.cz/mso/prihlasky, tedy z trvalého úložiště přihlášek.

EOF ; ############################################################################## # PODPROGRAMY ############################################################################## #----------------------------------------------------------------------------- # Vypíše přehled přihlášek. #----------------------------------------------------------------------------- sub vypsat_prehled_prihlasek { my $prihlasky = shift; # Vypsat přihlášky seřazené vzestupně podle okamžiku přihlášení (seřazené jsme je už dostali z databáze). my $irstart = 0; # číslo řádku, kterým začneme (ty před ním přeskočíme) my $nrmax = 50; # maximální počet řádků, které zobrazíme $irstart = $konfig{irstart} if(defined($konfig{irstart}) && $konfig{irstart} =~ m/^[0-9]+$/); $nrmax = $konfig{nrmax} if(defined($konfig{nrmax}) && $konfig{nrmax} =~ m/^[1-9][0-9]*$/); printf("

Zobrazuji nejvýše $nrmax řádků počínaje řádkem č. %d.

\n", $irstart+1); print(" \n"); my $i_radek = 0; my $preruseno = 0; foreach my $p (@{$prihlasky}) { # Příliš dlouhý webový formulář může být moc velké sousto pro Firefox na Klářině notebooku. # Pokud je přihlášek moc, zobrazit jen začátek seznamu, po jeho zpracování se objeví zbytek. if($i_radek < $irstart) { $i_radek++; next; } if($i_radek >= $irstart+$nrmax) { $preruseno = 1; last; } my $tdatr = ++$i_radek % 2 ? " bgcolor=#D5D5D5" : " bgcolor=#E5E5E5"; $tdatr .= " valign=top"; print(" \n"); print(" {vs}\" value=\"novy\">\n"); print(" nový\n"); my $formdatum; my $formcas; if($p->{cas_odeslani_access} =~ m/(\d+)\.(\d+)\.(\d+)(?:\s+(\d+):(\d+):(\d+))?/) { $formdatum = sprintf("%d.%d.%d", $1, $2, $3); $formcas = sprintf("%d:%02d:%02d", $4, $5, $6); } else { $formdatum = $p->{cas_odeslani_access}; } print(" $formdatum\n"); print(" $formcas\n"); my $cele_jmeno = "$p->{jmeno} $p->{prijmeni}"; $cele_jmeno =~ s/^\s+//; $cele_jmeno =~ s/\s+/ /g; $cele_jmeno =~ s/\s+$//; print(" $cele_jmeno\n"); print(" $p->{obec}\n"); print(" $p->{zeme}\n"); print(" $p->{email}\n"); print(" $p->{pohlavi}\n"); print(" $p->{kategorie}\n"); # Údaje o členství v organizacích seskupit do jedné buňky. my @clenstvi = map { if($_ eq "clenpaluba") { $_ = "Paluba" } elsif($_ eq "clenscrabble") { $_ = "ČAS" } elsif($_ eq "clendama") { $_ = "ČFD" } elsif($_ eq "clendama2") { $_ = "ČUD" } elsif($_ eq "clengo") { $_ = "ČAGo" } elsif($_ eq "clenothello") { $_ = "ČFO" } elsif($_ eq "clenhadanka") { $_ = "SČHaK" } } (grep{m/^clen/ && $p->{$_}}(keys(%{$p}))); my $clenstvi; if(scalar(@clenstvi)) { $clenstvi = "Člen ".join(", ", @clenstvi); } print(" $clenstvi\n"); print(" $p->{poznamka}\n"); print(" $p->{vs}\n"); print(" $p->{zaplaceno_dne}\n"); print(" \n"); # Pokusit se tuto osobu najít v tabulce osob. my $nalezy = mso::najit_osobu($p, $databaze); foreach my $nalez (@{$nalezy}) { print(" \n"); my $checked = $p->{kod_osoby}==$nalez->{kod} ? " checked=\"1\"" : ""; print(" {vs}\" value=\"$nalez->{kod}\"$checked>\n"); print(" $nalez->{kod}\n"); print(" \n"); print(" \n"); $cele_jmeno = "$nalez->{jmeno} $nalez->{prijmeni}"; $cele_jmeno =~ s/^\s+//; $cele_jmeno =~ s/\s+/ /g; $cele_jmeno =~ s/\s+$//; print(" $cele_jmeno\n"); print(" $nalez->{obec}\n"); print(" $nalez->{zeme}\n"); print(" $nalez->{e_mail}\n"); print(" $nalez->{pohlavi}\n"); print(" $nalez->{kategorie}\n"); # Údaje o členství v organizacích seskupit do jedné buňky. my @clenstvi = map { if($_ eq "clen_paluba") { $_ = "Paluba" } elsif($_ eq "clen_scrabble") { $_ = "ČAS" } elsif($_ eq "clen_dama") { $_ = "ČFD" } elsif($_ eq "clen_dama2") { $_ = "ČUD" } elsif($_ eq "clen_go") { $_ = "ČAGo" } elsif($_ eq "clen_othello") { $_ = "ČFO" } elsif($_ eq "clen_hadanka") { $_ = "SČHaK" } } (grep{m/^clen_/ && $nalez->{$_}}(keys(%{$nalez}))); my $clenstvi; if(scalar(@clenstvi)) { $clenstvi = "Člen ".join(", ", @clenstvi); } print(" $clenstvi\n"); print(" \n"); } } print("

\n"); if($preruseno) { print("

Upozornění: Nezpracovaných přihlášek bylo příliš mnoho. Abychom nespotřebovali všechny zdroje na vašem počítači, zobrazili jsme pouze začátek seznamu. Nedivte se proto, že až tyto přihlášky zpracujete, objeví se tu další!

\n"); } my $irpredch = $irstart-$nrmax; $irpredch = 0 if($irpredch<0); my $predchozi = $irpredch<$irstart ? "Předchozí" : 'Předchozí'; my $irnasled = $irstart+$nrmax; my $nasledujici = $preruseno ? "Následující" : 'Následující'; print("

<<< $predchozi | $nasledujici >>>

\n"); } #------------------------------------------------------------------------------ # Zpracuje údaje z vyplněného formuláře a uloží je do databáze. #------------------------------------------------------------------------------ sub zpracovat_udaje { my $konfig = shift; # odkaz na hash my $prihlasky = shift; # odkaz na pole hashů # Buď chceme uložit zobrazení variabilních symbolů na kódy osob, nebo chceme # záznamy, na kterých je toto zobrazení definováno, odstranit. if($konfig->{odstranit}) { for(my $i = 0; $i<=$#{$prihlasky}; $i++) { my $p = $prihlasky->[$i]; if($konfig->{$p->{vs}}) { # Nejdříve odstranit související záznamy z tabulky prihlasky_auto. my $sql = "DELETE FROM prihlasky_auto WHERE datum_prihlasky = '$p->{cas_odeslani_access}';"; $databaze->prepare($sql)->execute(); # Odstranit hlavní záznam z tabulky osoby_auto. $sql = "DELETE FROM osoby_auto WHERE cas_odeslani_access = '$p->{cas_odeslani_access}' LIMIT 1;"; $databaze->prepare($sql)->execute(); # Odstranit záznam z paměti, aby se později nezobrazil. splice(@{$prihlasky}, $i--, 1); } } } else { # Ke každé přihlášce uložit kód osoby odpovídající jejímu variabilnímu symbolu. # Pokud jejímu variabilnímu symbolu žádný kód osoby neodpovídá, uložit nulu. foreach my $p (@{$prihlasky}) { if($konfig->{$p->{vs}} eq "nový") { # Budeme chtít do databáze zkopírovat informace o osobě a posléze i její přihlášky. $p->{kod_osoby} = -1; } elsif($konfig->{$p->{vs}}) { # K příslušnému kódu osoby do databáze budeme kopírovat pouze přihlášky. $p->{kod_osoby} = $konfig->{$p->{vs}}; } else { # Zatím nebudeme chtít dělat nic. $p->{kod_osoby} = 0; } # Uložit přiřazení kódů osob variabilním symbolům do databáze. my $sql = "UPDATE osoby_auto SET kod_osoby = $p->{kod_osoby} WHERE vs = $p->{vs} LIMIT 1;"; $databaze->prepare($sql)->execute(); } } }