#!/usr/bin/perl
# Zobrazí globální tabulku (řádky: časové bloky, sloupce: místnosti, v buňkách názvy akcí).
# Copyright © 2004-2012 Dan Zeman <zeman@ufal.mff.cuni.cz>
# Licence: GNU GPL

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ě.
BEGIN {unshift(@INC, '/s/w/lib/dan') unless(grep {$_ eq '/s/w/lib/dan'} @INC)}
use dancgi; # čtení parametrů z webu nebo z ARGV
use cas; # práce s daty a časem
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í parametrů. Může být přebito 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 partie.pl zdroj=cas).
dancgi::rozebrat_parametry($ARGV[0], \%konfig);
if($konfig{jazyk} eq "")
{
    $konfig{jazyk} = "cs";
}
$jazyky::jazyk = $konfig{jazyk};



# Vytvořit a vypsat HTML stránku.
mso::vypsat_stranku(
{
    "nazev"  => "MSO: $konfig{rok}: ".jazyky::zjistit("globalni_tabulka"),
    "nadpis" => jazyky::zjistit("globalni_tabulka"),
    "telo"   => sestavit_tabulku($databaze, \%konfig),
    "rok"    => $konfig{rok}
});



###############################################################################
# PODPROGRAMY
###############################################################################



#------------------------------------------------------------------------------
# Načte z databáze tabulku rezervací (akce/blok/čas/místnost), vyrobí z nich
# tabulku v HTML a tu vrátí.
#------------------------------------------------------------------------------
sub sestavit_tabulku
{
    my $databaze = shift;
    my $konfig = shift;
    # Načíst tabulku rezervací.
    my $nazev_jazyk = jazyky::zjistit('klic_nazev');
    my $rezervace = mso::dotazat_se_databaze($databaze, 'rok', 'kod_hry', 'kod_turnaje', 'den', 'blok', 'zacatek', 'konec', 'mistnost_kratce', $nazev_jazyk, "rezervace WHERE rok = '$konfig->{rok}'");
    # Pokud nejsou k dispozici údaje pro daný rok (starší ročníky), pokusit se
    # tabulku rezervací dopočítat.
    if(scalar(@{$rezervace})==0)
    {
        $rezervace = dopocitat_rezervace($databaze, $konfig);
    }
    # Sestavit tabulku.
    my %tabulka;
    my %mistnosti;
    my %trideni;
    foreach my $r (@{$rezervace})
    {
        my $blok = jazyky::zjistit("den".cas::den_v_tydnu(cas::datum2eden($r->{den})))."<br/>".$r->{den}."<br/>".jazyky::zjistit("blok_$r->{blok}");
        $tabulka{$blok}{datum} = $r->{den};
        $tabulka{$blok}{blok} = $r->{blok};
        # Přeskládat si datum tak, aby se podle něj dalo třídit.
        if(!exists($trideni{$blok}))
        {
            $r->{den} =~ m/(\d+)\.(\d+)\.(\d+)/;
            my $trid = sprintf("%04d%02d%02d%s", $3, $2, $1, $r->{blok});
            $trideni{$blok} = $trid;
        }
        my $mistnost = $r->{mistnost_kratce};
        # Pozor! Teoreticky se může stát, že v databázi máme na stejný čas do stejné místnosti více než jednu akci.
        # Může to být chyba, ale také volitelný turnaj.
        my %akce =
        (
            'hra'       => $r->{kod_hry},
            'turnaj'    => $r->{kod_turnaje},
            'nazev'     => $r->{$nazev_jazyk},
            'zacatek'   => $r->{zacatek}
        );
        $akce{zacatek} =~ s/^\d+\.\d+\.\d+\s+(\d+):(\d+):\d+$/$1:$2/;
        $akce{zacatek} = '0'.$akce{zacatek} if(length($akce{zacatek})==4);
        push(@{$tabulka{$blok}{$mistnost}}, \%akce);
        # Zapamatovat si, s jakými všemi místnostmi jsme se setkali.
        $mistnosti{$mistnost}++;
    }
    # Seřadit bloky chronologicky.
    my @kr = sort{$trideni{$a} cmp $trideni{$b}}(keys(%tabulka));
    # Seřadit místnosti, aby byly např. všechny Michnovy paláce u sebe.
    my @ks = sort(keys(%mistnosti));
    # V některých buňkách tabulky (blok a místnost) může být více než jedna akce (několik krátkých akcí během jednoho bloku).
    # V takovém případě seřadit akce podle času začátku.
    foreach my $i (@kr)
    {
        foreach my $j (@ks)
        {
            my @akce = @{$tabulka{$i}{$j}};
            if(scalar(@akce)>1)
            {
                @{$tabulka{$i}{$j}} = sort {$a->{zacatek} cmp $b->{zacatek}} (@akce);
            }
            foreach my $a (@akce)
            {
                $a->{nazev} = $a->{zacatek}.' '.$a->{nazev};
            }
        }
    }
    # Převést tabulku do HTML.
    my $html;
    # Předsadit odkazy na všechny roky, o kterých zatím víme.
    my $roky = mso::dotazat_se_databaze($databaze, "rok", "rocniky ORDER BY rok");
    my @odkazy_na_jine_roky;
    foreach my $rok (map{$_->{rok}}(@{$roky}))
    {
        if($rok==$konfig->{rok})
        {
            push(@odkazy_na_jine_roky, $rok);
        }
        else
        {
            my $parametry = dancgi::sestavit_parametry_odkaz($konfig, "telo=globtabl.pl", "rok=$rok");
            push(@odkazy_na_jine_roky, "<a href=\"index.pl?$parametry\" target=\"_top\">$rok</a>");
        }
    }
    $html .= "<style type=text/css>\n";
    $html .= ".big #content {width: 1200px !important}\n";
    $html .= ".big .wrapper {width: 1370px !important}\n";
    $html .= ".big #top, .big #footer {width: 1400px !important}\n";
    $html .= "</style>\n";
    $html .= "<p><b>".jazyky::zjistit("pentamind").":</b> <a ".mso::odkaz(\%konfig, "telo=propozice.pl", "hra=pet").">".jazyky::zjistit("propozice")."</a>, <a ".mso::odkaz(\%konfig, "telo=pentamind.pl").">".jazyky::zjistit("vysledky")."</a></p>\n";
    $html .= "<p id=\"odkazy_na_jine_roky\">".join(" ", @odkazy_na_jine_roky)."</p>\n";
    $html .= "<table border=\"1\" class=\"smallest globtabl\">\n";
    $html .= "  <tr>\n";
    $html .= "    <td></td>\n";
    for(my $j = 0; $j<=$#ks; $j++)
    {
        $html .= "    <th class=\"globtabl\">$ks[$j]</th>\n";
    }
    $html .= "  </tr>\n";
    for(my $i = 0; $i<=$#kr; $i++)
    {
        # Na začátek nového dne zopakovat řádek s názvy místností.
        if($i>0 && substr($kr[$i], 0, 1) ne substr($kr[$i-1], 0, 1))
        {
            $html .= "  <tr>\n";
            $html .= "    <td></td>\n";
            for(my $j = 0; $j<=$#ks; $j++)
            {
                $html .= "    <th class=\"globtabl\">$ks[$j]</th>\n";
            }
            $html .= "  </tr>\n";
        }
        # Zjistit, zda daný blok neprobíhá právě teď. Mělo by to vliv na jeho vybarvení.
        my $ted_hash = cas::ted();
        my $dnes = $ted_hash->{datum} eq $tabulka{$kr[$i]}{datum};
        # Podle bloku vybrat barvu pozadí a textu.
        my $styl;
        if($tabulka{$kr[$i]}{blok} eq "dop")
        {
            my $ted = $dnes && $ted_hash->{hod}>=8 && $ted_hash->{hod}<14;
            $styl = $ted ? "gtted" : "gtdop";
        }
        elsif($tabulka{$kr[$i]}{blok} eq "odp")
        {
            my $ted = $dnes && $ted_hash->{hod}>=14 && $ted_hash->{hod}<18;
            $styl = $ted ? "gtted" : "gtodp";
        }
        else
        {
            my $ted = $dnes && $ted_hash->{hod}>=18 && $ted_hash->{hod}<23;
            $styl = $ted ? "gtted" : "gtvec";
        };
        # Přidat řádek tabulky.
        $html .= "  <tr class=\"$styl\">\n";
        $html .= "    <th class=\"globtabl\">$kr[$i]</th>\n";
        for(my $j = 0; $j<=$#ks; $j++)
        {
            # Zjistit, zda všechny akce, které patří do této buňky tabulky, jsou volitelné turnaje se stejným číslem.
            my $je_volitelny_turnaj = 1;
            my $cislo_volitelneho_turnaje;
            foreach my $akce (@{$tabulka{$kr[$i]}{$ks[$j]}})
            {
                my $vysledek_dotazu = mso::dotazat_se_databaze($databaze, 'prihlasky', "akce WHERE (rok = '$konfig->{rok}') AND (kod_hry = '$akce->{hra}') AND (kod_turnaje = '$akce->{turnaj}')");
                my $druh = $vysledek_dotazu->[0]{prihlasky};
                if($druh =~ m/^volitelny(\d+)$/)
                {
                    if($cislo_volitelneho_turnaje eq '')
                    {
                        $cislo_volitelneho_turnaje = $1;
                    }
                    elsif($cislo_volitelneho_turnaje != $1)
                    {
                        $je_volitelny_turnaj = 0;
                        last;
                    }
                }
                else
                {
                    $je_volitelny_turnaj = 0;
                    last;
                }
            }
            if($cislo_volitelneho_turnaje eq '')
            {
                $je_volitelny_turnaj = 0;
            }
            # Projít všechny akce, které patří do této buňky tabulky (typicky nejvýše jedna akce).
            my $obsah_bunky;
            if($je_volitelny_turnaj)
            {
                $obsah_bunky = "Volitelný turnaj:<br/>\n<ul>\n";
            }
            foreach my $akce (@{$tabulka{$kr[$i]}{$ks[$j]}})
            {
                # Název akce bude současně odkaz na propozice nebo výsledky této akce.
                # Nejdřív zjistit, jestli k této akci existují výsledky.
                my $dotaz = "SELECT COUNT(kod_osoby) AS pocet FROM vysledky WHERE (rok = '$konfig->{rok}') AND (kod_hry = '$akce->{hra}') AND (kod_akce = '$akce->{turnaj}')";
                my $dtzobj = $databaze->prepare($dotaz);
                $dtzobj->execute();
                my @radek = map{decode("utf8", $_)}($dtzobj->fetchrow_array());
                my $n_vysledku = $radek[0];
                my $parametry;
                if($n_vysledku)
                {
                    $parametry = dancgi::sestavit_parametry_odkaz($konfig, "telo=vysledky.pl", "rok=$konfig->{rok}", "hra=$akce->{hra}", "turnaj=$akce->{turnaj}");
                }
                else
                {
                    $parametry = dancgi::sestavit_parametry_odkaz($konfig, "telo=propozice.pl", "rok=$konfig->{rok}", "hra=$akce->{hra}", "turnaj=$akce->{turnaj}");
                }
                my $nazev = $akce->{nazev};
                # U názvu eeských turnaju nahradit mezery za neslabienými poedložkami neoddilitelnými mezerami.
                # Tohle muže být problém i jinde, ale v globální tabulce se objevuje v na konci oádku zvlášti easto a je to ošklivé.
                if($jazyky::jazyk eq "cs")
                {
                    $nazev =~ s/\s([ksvz])\s/ $1&nbsp;/g;
                }
                my $odkaz = "<a href=\"index.pl?$parametry\" target=\"_top\" style=\"color:$fgcolor\">$nazev</a>";
                if($je_volitelny_turnaj)
                {
                    $odkaz = "<li>$odkaz</li>\n";
                }
                elsif($obsah_bunky)
                {
                    $obsah_bunky .= "<br/>\n";
                }
                $obsah_bunky .= $odkaz;
            }
            if($je_volitelny_turnaj)
            {
                $obsah_bunky .= "</ul>\n";
            }
            # Pokud bude buňka prázdná, žádné styly neaplikovat.
            my $bunka;
            if($obsah_bunky =~ m/^\s*$/)
            {
                $bunka = "<td></td>";
            }
            else
            {
                $bunka .= "<td>$obsah_bunky</td>";
            }
            $html .= "    $bunka\n";
        }
        $html .= "    <th class=\"globtabl\">$kr[$i]</th>\n";
        $html .= "  </tr>\n";
    }
    $html .= "  <tr>\n";
    $html .= "    <td></td>\n";
    for(my $j = 0; $j<=$#ks; $j++)
    {
        $html .= "    <th class=\"globtabl\">$ks[$j]</th>\n";
    }
    $html .= "  </tr>\n";
    $html .= "</table>\n";
    return $html;
}



#------------------------------------------------------------------------------
# Pokusit se dopočítat rezervace podle údajů o čase a místnosti u akce.
#------------------------------------------------------------------------------
sub dopocitat_rezervace
{
    my $databaze = shift;
    my $konfig = shift;
    my $nazev_jazyk = jazyky::zjistit("klic_nazev");
    my $akce = mso::dotazat_se_databaze($databaze, "rok", "kod_hry", "kod_turnaje", $nazev_jazyk, "zacatek", "konec", "mistnost", "akce WHERE rok = '$konfig->{rok}'");
    my @rezervace;
    foreach my $a (@{$akce})
    {
        # Zjistit, ve kterém bloku akce začíná.
        # Dopolední turnaje končí kolem 13:00, odpolední začínají typicky ve 14:00, ale mohou i v 13:30.
        # Odpolední turnaje končí kolem 17:00, večerní začínají typicky v 18:00, ale mohou i v 17:30.
        my $zac = cas::esek2hash(cas::datumcas2esek($a->{zacatek}));
        $zac->{blok} = $zac->{hod}<13 ? 0 : $zac->{hod}<17 ? 1 : 2;
        # Zjistit, ve kterém bloku akce končí.
        my $kon = cas::esek2hash(cas::datumcas2esek($a->{konec}));
        $kon->{blok} = $kon->{hod}<14 ? 0 : $kon->{hod}<18 ? 1 : 2;
        # Zarezervovat všechny bloky mezi počátečním a koncovým. To je samozřejmě
        # jen odhad, který nemusí odpovídat skutečnosti, protože turnaj může běžet
        # celý týden, ale jen po večerech.
        my @bloky = ("dop", "odp", "več");
        for(my $den = $zac->{eden}; $den<=$kon->{eden}; $den++)
        {
            my $blok0 = $den==$zac->{eden} ? $zac->{blok} : 0;
            my $blok1 = $den==$kon->{eden} ? $kon->{blok} : 2;
            for(my $blok = $blok0; $blok<=$blok1; $blok++)
            {
                my %zaznam =
                (
                    "rok" => $a->{rok},
                    "kod_hry" => $a->{kod_hry},
                    "kod_turnaje" => $a->{kod_turnaje},
                    "den" => cas::eden2datum($den),
                    "mistnost" => $a->{mistnost},
                    "blok" => $bloky[$blok],
                    $nazev_jazyk => $a->{$nazev_jazyk}
                );
                push(@rezervace, \%zaznam);
            }
        }
    }
    return \@rezervace;
}