#!/usr/bin/perl # Zpracuje akci s databází objednávek na serveru MySQL na kub.cz. # Zkouším oddělit skript, který manipuluje s databází, od skriptů, které jen něco zobrazují. # Aby se to uživatelům nepletlo a aby bylo také jasně dáno, které stránky se mohou beztrestně obnovovat a které ne. # Na tuto stránku by také měly vést pouze odkazy action z formulářů s metodou post. # Copyright © 2009-2015 Dan Zeman # 6.12.2009: vytvořeno # 7.8.2015: přechod na nový kub.cz use utf8; # Přidat Danovy sdílené knihovny. Skript běžící pod uživatelem apache by je jinak nenašel. use lib '/s/w/lib/dan'; use lib '/s/w/lib/cgi/hry'; use lib '/s/w/lib/cgi/hry/vnitro'; use dzcgi; use dzsql; use sitesql; use dbobj; use mail; use cas; use zasilkovna; # Přinutit Perl, aby UTF8 vypisoval jako UTF8 a nevymýšlel pro mě "vhodné" osmibitové kódování. binmode(STDOUT, ':utf8'); binmode(STDERR, ':utf8'); # Používání absolutních URL místo relativních údajně zvyšuje šance, že prohlížeč nepoužije cache. my $urlbase = 'http://hrejsi.cz/cgi/hry/vnitro'; # Zapamatovat si, kdy jsme s generováním stránky začali, abychom na konci mohli # zjistit, jak dlouho nám to trvalo. $starttime = time(); # Poslat MIME záhlaví dokumentu. print("Content-Type: text/html; charset=utf-8\n\n"); # Přečíst parametry. dzcgi::cist_parametry(\%konfig); dzcgi::cist_formular_post(\%konfig); # Poslat začátek stránky. print < Operace s databází objednávek EOF ; # Připojit se k databázi. V tomto skriptu potřebujeme většinou sahat jen na objednávky a ty jsou v databázi obchod. # (Databázi her potřebujeme pouze když získáváme údaje o objednávce pro vytvoření CSV.) # $hdb ... obsahuje katalog a ceník her # $odb ... obsahuje katalog a ceník ostatního zboží $hdb = sitesql::connect_obchod('hry'); $odb = sitesql::connect_obchod('web_hrejsi_obchod'); # Hlavní část: zjistit, jaká akce se po nás požaduje, provést ji a vypsat stránku s výsledkem. provest_akci(); # Zjistit, jak dlouho nám to trvalo, a vypsat to na konec stránky. my $hlaseni = cas::sestavit_hlaseni_o_trvani_programu($starttime); print("

$hlaseni

\n"); # Poslat konec stránky. print < EOF ; ############################################################################### # PODPROGRAMY ############################################################################### #------------------------------------------------------------------------------ # Zjistí, jaká akce se po nás požaduje, provede ji a vypíše stránku # s výsledkem. #------------------------------------------------------------------------------ sub provest_akci { ###!!! print("

Parametry operace:

\n"); print("\n"); foreach my $klic (sort(keys(%konfig))) { print("\n"); } print("

$klic

$konfig{$klic}

\n"); ###!!! # Z názvu tlačítka zjistit požadovanou akci. my @submits = grep {m/^submit/} (keys(%konfig)); my @chyby; my $akce = $konfig{$submits[0]}; if($akce eq 'Uzavřít zaškrtnuté') { print("

Uzavřít zaškrtnuté

\n"); # Přečíst z formuláře čísla objednávek, které se mají uzavřít. my @cobj = grep {$konfig{$_} eq 'on'} (sort(keys(%konfig))); my @oobj = map {"$_"} (@cobj); my $nobj = scalar(@cobj); if($nobj==0) { print('

Žádná objednávka nebude uzavřena, protože nebyla žádná zaškrtnuta.'); } elsif($nobj==1) { print('

Tato objednávka bude uzavřena: '); } elsif($nobj>=2 && $nobj<=4) { print("

Tyto $nobj objednávky budou uzavřeny: "); } else { print("

Těchto $nobj objednávek bude uzavřeno: "); } print(join(', ', @oobj)); print("

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

Uzavírají se objednávky...

"); foreach my $co (@cobj) { my $vysledek = dbobj::zmenit_stav_objednavky($odb, $co, 'uzavřeno'); if(!$vysledek) { push(@chyby, "

Nepodařilo se uzavřít objednávku č. $co: $dbobj::chyba.

\n"); } } } my $filtr = $konfig{filtr} ? "?filtr=$konfig{filtr}" : ''; print("

Zpět na seznam

\n"); } elsif($akce eq 'CSV') { print("

CSV pro Uloženku

\n"); print("

Níže uvedená data zkopírujte přes schránku do textového editoru podporujícího kódování UTF-8, uložte na disk a dotyčný soubor potom nahrajte na Uloženku.

\n"); print("

Stav objednávek zahrnutých do tohoto exportu byl změněn na vytištěno nebo vytištěno před zaplacením.

\n"); # Přečíst z formuláře čísla objednávek, které se mají zahrnout do CSV. my @cobj = grep {$konfig{$_} eq 'on'} (sort(keys(%konfig))); my $csv = ''; if(@cobj) { # Načíst katalog zboží. Zejména potřebujeme ke kódům zboží názvy zboží. my $katalog = dbobj::nacist_katalog($hdb, $odb); my $header = 1; foreach my $co (@cobj) { my $objednavka = dbobj::zjistit_objednavku($odb, $katalog, $co); $csv .= dbobj::sestavit_csv_pro_ulozenku($objednavka, $header); $header = 0; # Klárka si přeje převést objednávky, pro které vygenerovala CSV, do stavu "vytištěno" (ve skutečnosti si později vytiskne štítky, které jí vygeneruje Uloženka). # Má se to dělat jen s objednávkami, jejichž aktuální stav je "máme" nebo "zaplaceno". Ostatní by se tu ani neměly objevit. my $stary_stav = dbobj::zjistit_stav_objednavky($odb, $co); my $novy_stav; $novy_stav = 'vytištěno' if($stary_stav =~ m/^(máme|zaplaceno)$/); $novy_stav = 'vytištěno před zaplacením' if($stary_stav eq 'zaplaťte'); if(defined($novy_stav)) { my $vysledek = dbobj::zmenit_stav_objednavky($odb, $co, $novy_stav, 1); if(!$vysledek) { push(@chyby, "

Nepodařilo se převést objednávku č. $co do stavu $novy_stav: $dbobj::chyba.

\n"); } } } } print("

$csv

\n"); } elsif($akce eq 'Nahrát do Zásilkovny') { print("

Nahrávám do Zásilkovny

\n"); # Přečíst z formuláře čísla objednávek, které se mají nahrát. my @cobj = grep {$konfig{$_} eq 'on'} (sort(keys(%konfig))); if(@cobj) { # Načíst katalog zboží. Zejména potřebujeme ke kódům zboží názvy zboží. my $katalog = dbobj::nacist_katalog($hdb, $odb); foreach my $co (@cobj) { my $objednavka = dbobj::zjistit_objednavku($odb, $katalog, $co); my $vysledek; if($objednavka->{odber} eq 'zasilkovna') { $vysledek = zasilkovna::create_packet($objednavka, 0); } elsif($objednavka->{odber} eq 'posta') { $vysledek = zasilkovna::create_packet($objednavka, 1); } else { push(@chyby, "

Objednávka č. $co není dodávána Zásilkovnou.

\n"); } if($vysledek) { if($vysledek->{status} eq "ok") { print("Objednávka č. $co úspěšně nahrána.
"); $objednavka->{podaci_cislo} = $vysledek->{id}; # Klárka si přeje převést objednávky, pro které byly nahrány, do stavu "vytištěno" (ve skutečnosti si později vytiskne štítky, které jí vygeneruje Zásilkovna). # Má se to dělat jen s objednávkami, jejichž aktuální stav je "máme" nebo "zaplaceno". Ostatní by se tu ani neměly objevit. my $stary_stav = dbobj::zjistit_stav_objednavky($odb, $co); my $novy_stav; $novy_stav = 'vytištěno' if($stary_stav =~ m/^(máme|zaplaceno)$/); $novy_stav = 'vytištěno před zaplacením' if($stary_stav eq 'zaplaťte'); if(defined($novy_stav)) { my $vysledek = dbobj::zmenit_stav_objednavky($odb, $co, $novy_stav, 1); if(!$vysledek) { push(@chyby, "

Nepodařilo se převést objednávku č. $co do stavu $novy_stav: $dbobj::chyba.

\n"); } } } else { push(@chyby, "

Objednávka č. $co vyhodila při nahrávání tuto chybu: \"$vysledek->{chyba}\".