#!/usr/bin/perl # Vypíše prezenční listinu turnaje. # Copyright © 2006-2013 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 csort; # české a anglické abecední řazení UTF znaků use dancgi; # čtení parametrů z webu nebo z ARGV 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); # Přímo tenhle skript sice není lokalizovaný, ale když nenastavíme jazyk, nebude fungovat mso::nacist_akce()! 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"); # Vypsat seznam akcí nebo prezenční listinu na vybranou akci. if($konfig{rok} && $konfig{hra} && $konfig{turnaj}) { vypsat_prezencku($konfig{rok}, $konfig{hra}, $konfig{turnaj}); } else { vypsat_seznam($konfig{rok}); } ############################################################################### # PODPROGRAMY ############################################################################### #------------------------------------------------------------------------------ # Vypíše seznam všech akcí v letošním roce. #------------------------------------------------------------------------------ sub vypsat_seznam { my $rok = shift; # Poslat začátek stránky. print < Přehled akcí (odkazy na prezenční listiny) [ Seznam osob | Přihláška ]

Přehled prezenčních listin

EOF ; print("

$a->{_nazev_hry}: {rok}&hra=$a->{kod_hry}&turnaj=$a->{kod_turnaje}\">$a->{nazev}

EOF ; } #------------------------------------------------------------------------------ # Vypíše prezenčku na konkrétní akci. #------------------------------------------------------------------------------ sub vypsat_prezencku { my $rok = shift; my $hra = shift; my $turnaj = shift; # Poslat začátek stránky. print < Prezenční listina: $rok $hra $turnaj [ Seznam osob | Přihláška | Prezenční listiny ] Vyplňte prosím dotazník na http://www.dotaznik.deskohrani.cz/. EOF ; my $prihlasene_osoby = zjistit_osoby_prihlasene_na_akci($databaze, $rok, $hra, $turnaj); # Seřadit přihlášky podle příjmení a jména hráčů. foreach my $jmeno (keys(%{$prihlasene_osoby})) { my $prihlaska = $prihlasene_osoby->{$jmeno}; $prihlaska->{_trid} = csort::zjistit_tridici_hodnoty($prihlaska->{prijmeni}.$prihlaska->{jmeno}, 'cs'); } my @setridene_prihlasky = sort{$prihlasene_osoby->{$a}{_trid} cmp $prihlasene_osoby->{$b}{_trid}}(keys(%{$prihlasene_osoby})); # Zjistit podrobnosti o akci. my $akce = mso::dotazat_se_databaze($databaze, 'nazev', 'zacatek', 'konec', 'startovne', 'startovne_2', 'startovne_3', 'plus_vstup', "akce WHERE (rok = '$rok') AND (kod_hry = '$hra') AND (kod_turnaje = '$turnaj')")->[0]; # Umazat z času začátku vteřiny. $akce->{zacatek} =~ s/(\s+\d+:\d+):\d+.*$/$1/; $akce->{konec} =~ s/(\s+\d+:\d+):\d+.*$/$1/; my $datum_zacatku; if($akce->{zacatek} =~ m/^(\d+\.\d+\.\d+)/) { $datum_zacatku = $1; } $akce->{konec} =~ s/^$datum_zacatku\s+//; # Vypsat přehled výše startovného na tento turnaj a vstupného na daný den (u vícedenních turnajů na první den). my $den; if($akce->{zacatek} =~ m/^(\d+)\./) { $den = $1; } my $lkod = sprintf('l%02d', $den); my $lakce = mso::dotazat_se_databaze($databaze, 'startovne', 'startovne_2', 'startovne_3', "akce WHERE (rok = '$rok') AND (kod_hry = 'lud') AND (kod_turnaje = '$lkod')")->[0]; foreach my $polozka ('startovne', 'startovne_2', 'startovne_3') { if($akce->{polozka} !~ m/\d/) { $akce->{polozka} = 0; } if($lakce->{polozka} !~ m/\d/) { $lakce->{polozka} = 0; } } print("Startovné $akce->{startovne}/$akce->{startovne_2}/$akce->{startovne_3}"); if($akce->{plus_vstup}) { print(" + vstup $lakce->{startovne}/$lakce->{startovne_2}/$lakce->{startovne_3}"); my ($c1, $c2, $c3) = ($akce->{startovne}+$lakce->{startovne}, $akce->{startovne_2}+$lakce->{startovne_2}, $akce->{startovne_3}+$lakce->{startovne_3}); print(" = $c1/$c2/$c3."); } else { print(". Vstup není započítán."); } print("\n"); ###!!! my $x; # for(my $i = 9771; $i<=10017; $i++) # { # $x .= sprintf("%X\t%d\t%s
\n", $i, $i, chr($i)); # } print("

Prezenční listina na $akce->{nazev} $akce->{zacatek} – $akce->{konec}

$x\n"); ###!!! print(" \n"); print(" \n"); # Přidat na konec pár prázdných řádků pro osoby přihlášené na místě. for(my $i = 0; $i<=$#setridene_prihlasky+5; $i++) { my $prihlaska = $prihlasene_osoby->{$setridene_prihlasky[$i]}; my $email = $prihlaska->{e_mail}; $email = ' ' if($email eq ''); # kvůli vnitřnímu orámování buňky my $kategorie = $prihlaska->{kategorie}; $kategorie = 'dospělý' if($kategorie eq 'normální'); $kategorie = 'studuch' if($kategorie eq 'student, důchodce'); # Ú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_/ && $prihlaska->{$_}}(keys(%{$prihlaska}))); my $clenstvi; if(scalar(@clenstvi)) { $clenstvi = " člen ".join(', ', @clenstvi); } my $datum = $prihlaska->{datum_prihlasky}; my $cas; if($datum =~ m/^(\d+\.\d+\.\d+)(?:\s+(\d+:\d+:\d+))?$/) { $datum = $1; $cas = $2; } # Pokud zaplatil včas předem převodem, snížit částku "má dáti" o slevu 20 %. my $ma_dati = $prihlaska->{ma_dati}; my $vcasne_prihlasky_do = mso::zjistit_datum_vcasneho_prihlaseni($databaze, $rok); if($prihlaska->{dal} == 0.8 * $prihlaska->{ma_dati} && $prihlaska->{zpusob_placeni} =~ m/^převodem (\d+)-(\d+)-(\d+)$/) { my $zaplatil_rok = $1; my $zaplatil_mesic = $2; my $zaplatil_den = $3; my $zaplatil = sprintf('%04d%02d%02d', $zaplatil_rok, $zaplatil_mesic, $zaplatil_den); $vcasne_prihlasky_do =~ m/(\d+)\.(\d+)\.(\d+)/; my $termin_den = $1; my $termin_mesic = $2; my $termin_rok = $3; my $termin = sprintf('%04d%02d%02d', $termin_rok, $termin_mesic, $termin_den); if($zaplatil<=$termin) { $ma_dati *= 0.8; } } # Pokud zatím nic nezaplatil, nepsat nulu, nechat prázdné políčko, aby se do něj dalo psát ručně. # Leda pokud víme, že má platit nulu (slevy, organizátoři), vyplnit nulu i do políčka dal. my $dal; if($prihlaska->{dal}) { $dal = "$prihlaska->{dal} Kč"; if($prihlaska->{dal}>=$ma_dati) { $dal .= ' '.chr(10004); # zaškrtnutí } else { $dal .= ' '.chr(9756); # ruka ukazující doleva } } elsif($prihlaska->{ma_dati} eq '0') { $dal = '0 Kč '.chr(10004); # zaškrtnutí } else { $dal = ' '; } print(" \n"); } print("

Č.	Jméno	Obec	Země	E-mail	Kategorie	Datum a čas přihlášky	Má dáti	Dal	Způsob placení	Podpis
", $i+1, ".	$prihlaska->{cele_jmeno}	$prihlaska->{obec}	$prihlaska->{zeme}	$email	$kategorie$clenstvi	$datum	$cas	$ma_dati Kč	$dal	$prihlaska->{zpusob_placeni}

\n"); # Poslat konec stránky. print < EOF ; } #------------------------------------------------------------------------------ # Získá údaje o osobách přihlášených na konkrétní akci ze všech tří tabulek # (prihlasky, tj. ty, co už prošly Accessem; prihlasky_zmeny, tj. změny # provedené přes toto webové rozhraní; a konečně prihlasky_auto, tj. nové # přihlášky přes web; ty ještě nemají kód osoby). #------------------------------------------------------------------------------ sub zjistit_osoby_prihlasene_na_akci { my $databaze = shift; my $rok = shift; my $hra = shift; # kód hry my $turnaj = shift; # kód akce # Načíst osoby vyexportované z Klářina Accessu. my @nazvy = qw(kod jmeno prijmeni obec zeme e_mail kategorie clen_paluba clen_scrabble clen_dama clen_dama2 clen_go clen_othello clen_hadanka); my $osoby0 = mso::dotazat_se_databaze($databaze, @nazvy, 'osoby'); # Přeskládat osoby, aby k nim bylo možné přistupovat přes kód. my @osoby; foreach my $osoba (@{$osoby0}) { $osoby[$osoba->{kod}] = $osoba; } # Načíst změny osob provedené přes webové rozhraní. my $osoby1 = mso::dotazat_se_databaze($databaze, @nazvy, 'osoby_zmeny'); # Přepsat v poli indexovaném kódy změněné osoby. foreach my $osoba (@{$osoby1}) { $osoby[$osoba->{kod}] = $osoba; } # Načíst přihlášky vyexportované z Klářina Accessu. @nazvy = qw(rok kod_hry kod_turnaje kod_osoby datum_prihlasky ma_dati dal zpusob_placeni); my $filtr = "WHERE (rok = '$rok') AND (kod_hry = '$hra') AND (kod_turnaje = '$turnaj')"; my $prihlasky0 = mso::dotazat_se_databaze($databaze, @nazvy, "prihlasky $filtr"); # Nahashovat přihlášky podle jména osoby (případní jmenovci se ztratí, ale je to velmi nepravděpodobné a oni to pochopí). # Stejně budeme muset nakonec přidat nezpracované přihlášky osob, které nemají kódy, a nebudeme vědět, jestli jde # o duplikáty přihlášek, nebo o jmenovce. my %prihlasene_osoby; foreach my $prihlaska (@{$prihlasky0}) { zkopirovat_osobu_do_prihlasky($prihlaska, \@osoby); $prihlasene_osoby{$prihlaska->{cele_jmeno}} = $prihlaska; } # Načíst přihlášky přidané do MySQL prostřednictvím webového rozhraní. Můžou tam být i odhlášení. @nazvy = ('rok', 'kod_hry', 'kod_turnaje', 'kod_osoby', 'datum_zmeny AS datum_prihlasky', 'odhlasit', 'ma_dati', 'dal', 'zpusob_placeni'); my $prihlasky1 = mso::dotazat_se_databaze($databaze, @nazvy, "prihlasky_zmeny $filtr"); # Přidat nové přihlášky do hashe a odstranit z něj osoby, které se zase odhlásily. foreach my $prihlaska (@{$prihlasky1}) { zkopirovat_osobu_do_prihlasky($prihlaska, \@osoby); if($prihlaska->{odhlasit}) { delete($prihlasene_osoby{$prihlaska->{cele_jmeno}}); } else { $prihlasene_osoby{$prihlaska->{cele_jmeno}} = $prihlaska; } } # Načíst přihlášky uložené do MySQL přihlašovacím skriptem. Musíme je načíst rovnou i s osobami, protože tyto osoby nemusí mít kód. @nazvy = ('rok', 'kod_hry', 'kod_turnaje', 'prihlasky.datum_prihlasky AS datum_prihlasky', 'jmeno', 'prijmeni', 'obec', 'zeme', 'email AS e_mail', 'kategorie', 'clenpaluba AS clen_paluba', 'clenscrabble AS clen_scrabble', 'clendama AS clen_dama', 'clendama2 AS clen_dama2', 'clengo AS clen_go', 'clenothello AS clen_othello', 'clenzatre AS clen_zatre', 'clenhadanka AS clen_hadanka', 'ma_dati', 'dal', 'zpusob_placeni'); my $tabulky = "prihlasky_auto AS prihlasky INNER JOIN osoby_auto ON prihlasky.datum_prihlasky = osoby_auto.datum_prihlasky"; my $prihlasky2 = mso::dotazat_se_databaze($databaze, @nazvy, "$tabulky $filtr"); # Přidat nové přihlášky do hashe. Případné duplikáty se přepíšou jeden druhým. foreach my $prihlaska (@{$prihlasky2}) { $prihlaska->{cele_jmeno} = join(' ', ($prihlaska->{jmeno}, $prihlaska->{prijmeni})); # Jestliže osoba nezaplatila převodem, položky "dal" a "zpusob_placeni" v prihlasky_auto jsou prázdné. # Jestliže zaplatila v infu, mohou být tyto položky neprázdné v prihlasky_zmeny. # Než tedy přepíšeme případný existující záznam o přihlášce, musíme tyto údaje zachránit. # Předpokládáme, že buď jsou vyplněné obě položky, nebo žádná. Kombinovat "dal" z jednoho zdroje a "zpusob_placeni" ze druhého nedává smysl. if(exists($prihlasene_osoby{$prihlaska->{cele_jmeno}}) && ($prihlasene_osoby{$prihlaska->{cele_jmeno}}{dal} ne '' || $prihlasene_osoby{$prihlaska->{cele_jmeno}}{zpusob_placeni} ne '') && ($prihlaska->{dal} eq '' || $prihlaska->{zpusob_placeni} eq '')) { $prihlaska->{dal} = $prihlasene_osoby{$prihlaska->{cele_jmeno}}{dal}; $prihlaska->{zpusob_placeni} = $prihlasene_osoby{$prihlaska->{cele_jmeno}}{zpusob_placeni}; } $prihlasene_osoby{$prihlaska->{cele_jmeno}} = $prihlaska; } return \%prihlasene_osoby; } #------------------------------------------------------------------------------ # Zkopíruje informace o osobě přímo k přihlášce, aby byly při vypisování po # ruce. Předpokládá, že přihláška už obsahuje kód osoby, nemůže jít tedy o # prvotní přihlášku z webu, která ještě není propojena s databází osob jinak # než jménem. #------------------------------------------------------------------------------ sub zkopirovat_osobu_do_prihlasky { my $prihlaska = shift; my $osoby = shift; # odkaz na pole záznamů o osobách my $osoba = $osoby->[$prihlaska->{kod_osoby}]; foreach my $atribut (qw(jmeno prijmeni obec zeme e_mail kategorie clen_paluba clen_scrabble clen_dama clen_dama2 clen_go clen_othello clen_hadanka)) { $prihlaska->{$atribut} = $osoba->{$atribut}; } $prihlaska->{cele_jmeno} = join(' ', ($prihlaska->{jmeno}, $prihlaska->{prijmeni})); }