#!/usr/bin/perl
# Jednorázový skript pro přechod na novou verzi obchodu se Zuzčinými trpaslíky.
# Zkopíruje údaje o dosavadních objednávkách z databáze hry do databáze obchod.
# Copyright © 2013 Daniel Zeman <zeman@ufal.mff.cuni.cz>
# Licence: GNU GPL

use utf8;
use Encode;
use DBI;
use dzsql;
binmode(STDOUT, ':utf8');
$jmeno = 'root';
$heslo = 'blue85';



# Povinný argument: rok, který se má zkopírovat. Současně je to tak trochu ochrana proti spuštění skriptu omylem. Mohl by v databázi napáchat dost škod!
if(scalar(@ARGV)!=1)
{
    die("Musíte říct rok, pro který se mají zkopírovat data o objednávkách z databáze hry do databáze obchod.\n");
}
$rok = $ARGV[0];
$dbh = DBI->connect('DBI:mysql:hry', $jmeno, $heslo)
  or die("Nelze se pripojit k databazi: $DBI::errstr\n");
$dbo = DBI->connect('DBI:mysql:obchod', $jmeno, $heslo)
  or die("Nelze se pripojit k databazi: $DBI::errstr\n");
# Nastavit kódování klienta, spojení a výsledků.
$dbh->prepare("SET NAMES 'utf8'")->execute();
$dbo->prepare("SET NAMES 'utf8'")->execute();
# Budeme to dělat opatrně po jednotlivých rocích. Nastavit část filtru SQL za operátorem LIKE.
$like = "\"$rok%\"";
# Načíst obsah tabulky objednavky z databáze hry.
@nazvy = ('cas', 'gencas', 'jmeno', 'prijmeni', 'ulice_a_dum', 'obec', 'psc', 'email', 'telefon', 'poznamka', 'poznamka2', 'odber', 'platba', 'sms', 'rychlost', 'mezisoucet', 'mnozstevni_sleva', 'postovne', 'celkem', 'sleva_org_deti', 'ico', 'slevkod', 'stav', 'varsymbol', 'datum_odeslani', 'podaci_cislo', 'pilne', 'hmotnost', 'zaplacene_postovne', 'poznamka_obchod');
$zaznamy = dzsql::dotaz($dbh, @nazvy, 'objednavky WHERE cas LIKE '.$like);
# U roků 2005 a 2006 se pokusit opravit diakritiku.
if($rok<2007)
{
    foreach my $z (@{$zaznamy})
    {
        # Počínaje objednávkou 30.9.2006 21:04:40 je diakritika kódovaná jinak a nemá se opravovat touto funkcí.
        next if($z->{cas}>20060929000000);
        foreach my $n (@nazvy)
        {
            $z->{$n} = opravit_diakritiku($z->{$n});
        }
    }
}
print("Nalezeno ", scalar(@{$zaznamy}), " objednávek z roku $rok.\n");
# Uložit načtené záznamy do tabulky objednavky v databázi obchod.
ulozit_zaznamy($dbo, $zaznamy, \@nazvy, 'objednavky');
# Načíst obsah tabulky objzbozi z databáze hry.
@nazvy = ('cas', 'kod_zbozi', 'jednotkova_cena', 'pocet', 'cena_celkem', 'chybi');
$zaznamy = dzsql::dotaz($dbh, @nazvy, 'objzbozi WHERE cas LIKE '.$like);
print("Nalezeno ", scalar(@{$zaznamy}), " položek objednávek z roku $rok.\n");
# Uložit načtené záznamy do tabulky objzbozi v databázi obchod.
ulozit_zaznamy($dbo, $zaznamy, \@nazvy, 'objzbozi');
# Načíst obsah tabulky objstavy z databáze hry.
@nazvy = ('cobj', 'cas_zmeny', 'novy_stav', 'nomail');
$zaznamy = dzsql::dotaz($dbh, @nazvy, 'objstavy WHERE cobj LIKE '.$like);
print("Nalezeno ", scalar(@{$zaznamy}), " stavů objednávek z roku $rok.\n");
# Uložit načtené záznamy do tabulky objstavy v databázi obchod.
ulozit_zaznamy($dbo, $zaznamy, \@nazvy, 'objstavy');



sub ulozit_zaznamy
{
    my $dbo = shift;
    my $zaznamy = shift;
    my $nazvy = shift;
    my $tabulka = shift;
    foreach my $z (@{$zaznamy})
    {
        my $seznam_poli = join(', ', @{$nazvy});
        # Zdvojený apostrof neukončuje řetězec.
        my $seznam_hodnot = join(', ', map {$z->{$_} =~ s/'/''/g; "_utf8'$z->{$_}'"} @{$nazvy});
        my $dotaz = "INSERT INTO $tabulka ($seznam_poli) VALUES ($seznam_hodnot);";
        print("$dotaz\n");
        $dbo->do($dotaz) or die("Nelze spustit dotaz: $DBI::errstr");
    }
}



sub opravit_diakritiku
{
    # Záznamy z let 2005 až 2008 mají poškozené kódování českých písmen s diakritikou.
    # Záznamy z let 2007 a 2008 nelze jednoznačně rekonstruovat, protože všechna písmena s diakritikou v nich byla nahrazena otazníkem.
    # U záznamů z let 2005 a 2006 je záchrana možná, protože tam došlo ke zdvojenému zakódování UTF-8.
    # Např. hned první záznam zní na jméno "Petr Matejovič". Místo písmena "č" najdeme dva znaky, "Ä" (U+00C4) a něco kontrolního (U+008D).
    # Ve skutečnosti tu měl být jeden znak s kódem 269 (U+010D), kterému v UTF-8 odpovídají 2 bajty: C4 8D.
    # Takže musíme
    # 1. z každého znaku vzít jeho kód;
    #    Pozor, ve skutečnosti to nejsou vždy kódy podle Unicodu ale spíš podle nějaké windowsové kódové stránky, asi 1250 nebo 1252.
    #    Projeví se to zřídka. Např. "ř" je zakódováno jako Aring+TM, přičemž znak TM (trade mark) má unikódový kód 8482, ale zde zřejmě představuje windowsové 153.
    # 2. ověřit, že opravdu žádný kód není roven nebo vyšší než 256;
    # 3. vytvořit řetězec z těchto kódů a ujistit se, že ho Perl bude chápat jako řetězec bajtů, nikoli znaků;
    # 4. tento řetězec dekódovat jako řetězec znaků v UTF-8. Tím dojde ke spojení bajtů reprezentujících jeden český znak.
    my $x = shift;
    my $debug = 0;
    # Stav objednávky "uzavřeno" byl vyplňován až dodatečně a "ř" má v pořádku. Náš pokus o opravu by ho naopak zkazil.
    if($x =~ m/^(objednáno|částečně vyřízeno|uzavřeno)$/)
    {
        return $x;
    }
    # Získat kódy jednotlivých znaků ve vadném řetězci.
    my @kody = map {ord($_)} (split(//, $x));
    # Jestliže ani jeden znak nemá kód vyšší než 127 (tj. ne-ASCII), pak řetězec neobsahuje stopy po diakritice a není co opravovat.
    # Pokud takových znaků není sudý počet, pak se stalo něco nečekaného, protože všechna česká písmena s diakritikou mají v UTF-8 2 bajty.
    my @vysoke_kody = grep {$_>127} (@kody);
    if(scalar(@vysoke_kody)==0)
    {
        return $x;
    }
    print("length($x)=", length($x), "\n") if($debug);
    # Kódy vyšší než 127 se do řetězce dostaly takto:
    # Mám české písmeno s diakritikou, např. "č". Jeho unikódový kód je 269 (U+010D).
    # V UTF-8 tomuto kódu odpovídají 2 bajty: C4 8D (desítkově 196 141).
    # Každý z těchto dvou bajtů vezmu samostatně a představím si, že je to kód znaku v kódové stránce Windows 1252.
    # V našem případě tedy C4 odpovídá znaku Ä a 8D odpovídá nějakému kontrolnímu či nedefinovanému znaku.
    # Každý z těchto znaků zvlášť najdu v Unicodu. Ä má kód U+00C4. Ten nedefinovaný znak je problém, protože je nedefinovaný. Zůstane mu U+008D, to je v Unicodu kontrolní znak.
    # Ve výsledném řetězci jsou tedy dva znaky s vysokými kódy, a to 196 a 141.
    # Analogicky s písmenem "ř": V UTF-8 mu odpovídají bajty C5 99 (desítkově 197 153, ve Windows 1252 je to &Aring; a TRADE MARK SIGN.
    # Oproti "č" je tu ale rozdíl. První znak má kód U+00C5, druhý však U+8482.
    # Získané kódy si tedy upravíme takto:
    # Pokud je kód menší než 256, nechat být. Buď je to ASCII, nebo odpovídá unikódovému Latin 1, případně je to kontrolní/nedefinovaný znak.
    # Pokud je kód větší nebo roven 256, mohl by to být TRADE MARK SIGN nebo něco, co se chová podobně. Pokusíme se najít odpovídající kód v kódové stránce Windows.
    print('kody = ', join(', ', @kody), "\n") if($debug);
    @kody = map {if($_>=256) {my $znak = chr($_); my $win = encode('cp1252', $znak); $_ = ord($win);} $_} (@kody);
    print('kody = ', join(', ', @kody), "\n") if($debug);
    # Vytvořit řetězec, který bude Perl chápat jako bajtový, ne znakový.
    my $bs = encode('utf8', '');
    foreach my $kod (@kody)
    {
        $bs .= chr($kod);
    }
    print("length(bs $bs)=", length($bs), "\n") if($debug);
    # Zpětně dekódovat řetězec bajtů jako UTF-8, tj. zapnout příznak UTF-8.
    my $cs = decode('utf8', $bs);
    print("length(cs $cs)=", length($cs), "\n") if($debug);
    return $cs;
}