#!/usr/bin/perl # Zobrazí přehled rozdílů databáze MSO na MySQL oproti exportu z 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 csort; # české a anglické abecední řazení UTF znaků 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 změn v databázi

Přehled změn v databázi

EOF ; # Zjistit z databáze seznam změn údajů u osob. print("

Přehled změn v osobách

\n"); my @nazvy = (qw(kod jmeno prijmeni obec zeme pohlavi kategorie clen_paluba clen_scrabble clen_dama clen_dama2 clen_go clen_othello clen_zatre clen_hadanka e_mail)); my $osoby_zmeny = mso::dotazat_se_databaze($databaze, @nazvy, "osoby_zmeny"); # Seřadit změněné osoby podle příjmení a jména. map{$_->{_trid} = csort::zjistit_tridici_hodnoty($_->{prijmeni}." ".$_->{jmeno}, "cs")}(@{$osoby_zmeny}); my @osoby_zmeny = sort{$a->{_trid} cmp $b->{_trid}}(@{$osoby_zmeny}); print(" \n"); my $i_radek = 0; foreach my $osoba (@osoby_zmeny) { my $bshoda = ++$i_radek % 2 ? " bgcolor=#D5D5D5" : " bgcolor=#E5E5E5"; my $bzmena = " bgcolor=yellow"; # Vyhledat původní údaje o této osobě před změnami. my $osoba0 = mso::dotazat_se_databaze($databaze, @nazvy, "osoby WHERE kod = $osoba->{kod}")->[0]; # Připravit údaje k zobrazení. $osoba->{_cele_jmeno} = "$osoba->{jmeno} $osoba->{prijmeni}"; $osoba->{_cele_jmeno} =~ s/^\s+//; $osoba->{_cele_jmeno} =~ s/\s+/ /g; $osoba->{_cele_jmeno} =~ s/\s+$//; $osoba0->{_cele_jmeno} = "$osoba0->{jmeno} $osoba0->{prijmeni}"; $osoba0->{_cele_jmeno} =~ s/^\s+//; $osoba0->{_cele_jmeno} =~ s/\s+/ /g; $osoba0->{_cele_jmeno} =~ s/\s+$//; # Ú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_zatre") { $_ = "ČFZ" } elsif($_ eq "clen_hadanka") { $_ = "SČHaK" } } (grep{m/^clen/ && $osoba->{$_}}(keys(%{$osoba}))); if(scalar(@clenstvi)) { $osoba->{_clenstvi} = "Člen ".join(", ", @clenstvi); } @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_zatre") { $_ = "ČFZ" } elsif($_ eq "clen_hadanka") { $_ = "SČHaK" } } (grep{m/^clen/ && $osoba0->{$_}}(keys(%{$osoba0}))); if(scalar(@clenstvi)) { $osoba0->{_clenstvi} = "Člen ".join(", ", @clenstvi); } # Zjistit, kde došlo ke změně a nastavit podle toho barvy. my $jsou_zmeny; my %atr; $atr{vychozi} = "$bshoda valign=top"; foreach my $klic (qw(_cele_jmeno obec zeme pohlavi kategorie _clenstvi e_mail)) { if($osoba->{$klic} eq $osoba0->{$klic}) { $atr{$klic} = $bshoda; } else { $atr{$klic} = $bzmena; $jsou_zmeny = 1; } $atr{$klic} .= " valign=top"; } # Vypsat řádek změněných údajů. print(" \n"); print(" web\n"); print(" $osoba->{kod}\n"); print(" $osoba->{_cele_jmeno}\n"); print(" $osoba->{obec}\n"); # obec print(" $osoba->{zeme}\n"); print(" $osoba->{pohlavi}\n"); print(" $osoba->{kategorie}\n"); print(" $osoba->{_clenstvi}\n"); print(" $osoba->{e_mail}\n"); unless($jsou_zmeny) { print(" \n"); # Vymazat záznam o osobě ze seznamu změn. my $sql = "DELETE FROM osoby_zmeny WHERE kod = $osoba->{kod};"; $databaze->do($sql) or print("\n"); } print(" \n"); # Na druhém řádku vypsat původní údaje před změnami. print(" \n"); print(" access\n"); print(" $osoba0->{kod}\n"); print(" $osoba0->{_cele_jmeno}\n"); print(" $osoba0->{obec}\n"); # obec print(" $osoba0->{zeme}\n"); print(" $osoba0->{pohlavi}\n"); print(" $osoba0->{kategorie}\n"); print(" $osoba0->{_clenstvi}\n"); print(" $osoba0->{e_mail}\n"); print(" \n"); } print("

smazat

Chyba: Nepodařilo se odstranit změny osob z tabulky osoby_zmeny: ", $DBI::errstr, "
$sql

\n"); # Vypsat nové, změněné a odstraněné přihlášky. print("

Přehled změn v přihláškách

\n"); # Zjistit z databáze seznam změn údajů u přihlášek. @nazvy = ("kod_osoby", "prihlasky_zmeny.kod_hry AS kod_hry", "prihlasky_zmeny.kod_turnaje AS kod_turnaje", "odhlasit", "datum_zmeny", "ma_dati", "dal", "zpusob_placeni", "jmeno", "prijmeni", "nazev"); my $prihlasky_zmeny = mso::dotazat_se_databaze($databaze, @nazvy, "(prihlasky_zmeny LEFT JOIN osoby ON prihlasky_zmeny.kod_osoby = osoby.kod) LEFT JOIN akce ON (prihlasky_zmeny.rok = akce.rok) AND (prihlasky_zmeny.kod_hry = akce.kod_hry) AND (prihlasky_zmeny.kod_turnaje = akce.kod_turnaje)"); # Seřadit změny podle příjmení a jména. map{$_->{_trid} = csort::zjistit_tridici_hodnoty($_->{prijmeni}." ".$_->{jmeno}, "cs")}(@{$prihlasky_zmeny}); my @zmeny = sort{$a->{_trid} cmp $b->{_trid}}(@{$prihlasky_zmeny}); print(" \n"); my $i_osoba; my $posledni_kod; foreach my $zmena (@zmeny) { # Vyhledat původní údaje o této přihlášce před změnami. @nazvy = ("kod_osoby", "datum_prihlasky", "ma_dati", "dal", "zpusob_placeni"); my $puvodni = mso::dotazat_se_databaze($databaze, @nazvy, "prihlasky WHERE (kod_osoby = $zmena->{kod_osoby}) AND (rok = $konfig{rok}) AND (kod_hry = '$zmena->{kod_hry}') AND (kod_turnaje = '$zmena->{kod_turnaje}')")->[0]; # Připravit data k zobrazení. $i_osoba++ if($zmena->{kod_osoby}!=$posledni_kod); my $bshoda = $i_osoba % 2 ? " bgcolor=#D5D5D5" : " bgcolor=#E5E5E5"; $zmena->{_cele_jmeno} = "$zmena->{jmeno} $zmena->{prijmeni}"; $zmena->{_cele_jmeno} =~ s/^\s+//; $zmena->{_cele_jmeno} =~ s/\s+/ /g; $zmena->{_cele_jmeno} =~ s/\s+$//; my ($str1, $str0); if($zmena->{odhlasit}) { $str1 = "~~"; $str0 = "~~"; } my $datum = $zmena->{datum_zmeny}; my $cas; if($datum =~ m/^(\d+\.\d+\.\d+)(?:\s+(\d+:\d+:\d+))?$/) { $datum = $1; $cas = $2; } print(" \n"); print(" $zmena->{kod_osoby}\n"); print(" $zmena->{_cele_jmeno}\n"); print(" $str1$zmena->{kod_hry}$str0\n"); print(" $str1$zmena->{kod_turnaje}$str0\n"); print(" $str1$zmena->{nazev}$str0\n"); print(" $datum\n"); print(" $cas\n"); print(" $str1$zmena->{ma_dati} Kč$str0\n"); print(" $zmena->{dal} Kč\n"); print(" $zmena->{zpusob_placeni}\n"); if($puvodni->{kod_osoby}==$zmena->{kod_osoby}) { print(" \n"); my $datum = $puvodni->{datum_prihlasky}; my $cas; if($datum =~ m/^(\d+\.\d+\.\d+)(?:\s+(\d+:\d+:\d+))?$/) { $datum = $1; $cas = $2; } print(" \n"); print(" \n"); print(" \n"); } else { # Jestliže nebyl nalezen původní záznam k odstraněné přihlášce, byla už odstraněna i u Kláry. # Záznam o odstranění se tedy může odstranit také. ###!!! NOJO. Ale tohle platilo za předpokladu, že změny neaplikujeme na přihlášky, které Klára v Accessu ještě vůbec nemá, na prihlasky_auto! ###!!! Jinak by si takhle Klára likvidovala odhlášky, které předtím pracně sama vyplnila! (2011) if($zmena->{odhlasit}) { ###!!!print(" \n"); # Vymazat záznam o osobě ze seznamu změn. ###!!!my $sql = "DELETE FROM prihlasky_zmeny WHERE (kod_osoby = $zmena->{kod_osoby}) AND (rok = $konfig{rok}) AND (kod_hry = '$zmena->{kod_hry}') AND (kod_turnaje = '$zmena->{kod_turnaje}');"; ###!!!$databaze->do($sql) or print("\n"); } } print(" \n"); $posledni_kod = $zmena->{kod_osoby}; } print("

původní

$datum

\n"); print("

$cas

\n"); print("

$puvodni->{ma_dati} Kč

$puvodni->{dal} Kč

$puvodni->{zpusob_placeni}

smazat

Chyba: Nepodařilo se odstranit změny přihlášek z tabulky prihlasky_zmeny: ", $DBI::errstr, "
$sql

\n"); # Poslat konec stránky. print < EOF ;