#!/usr/bin/perl # Zobrazí objednávku z databáze. Přístup by měli mít jen zaměstnanci obchodu. # Copyright © 2008-2009 Dan Zeman # Licence: GNU GPL # 14.2.2008: vytvořeno # 16.2.2009: odkaz pro snadnou kontrolu organizace podle iča # 16.2.2009: je možné poznamenat, že objednávka byla uzavřena (vyřízena) # 17.3.2009: je možné odeslat úvodní mail, že zboží máme skladem use utf8; use Encode; use DBI; # Přidat Danovy sdílené knihovny. Skript běžící pod uživatelem apache by je jinak nenašel. BEGIN {unshift(@INC, "/home/dan/lib") unless(grep {$_ =~ m-/home/dan/lib-} @INC);} use dzcgi; use sitesql; use dzsql; use mail; # Přinutit Perl, aby UTF8 vypisoval jako UTF8 a nevymýšlel pro mě "vhodné" osmibitové kódování. binmode(STDOUT, ":utf8"); # 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); if(exists($konfig{post})) { dzcgi::cist_formular_post(\%konfig); } # Poslat začátek stránky. print < Objednávka $konfig{cislo} EOF ; # Připojit se k databázi. $databaze = sitesql::connect("hry"); # Pokud jsme dostali požadavek na změnu stavu objednávky, splnit ho. if($konfig{akce} eq "Máme") { pripravit_mail($konfig{cislo}, 'máme'); } elsif($konfig{akce} eq 'Odeslat') { # Jestliže se chystáme přejít do nepovoleného stavu, nedovolit odeslání mailu. my $chyba; unless(proverit_pozadavek_na_zmenu_stavu($konfig{cislo}, $konfig{stav}, \$chyba)) { print("

$chyba

\n"); } else { odeslat_mail($konfig{cislo}, $konfig{text_mailu}); zmenit_stav_objednavky($konfig{cislo}, $konfig{stav}); print("

Zatím běží zkušební provoz, takže se odeslal mail pouze mně. Jinak by v tuto chvíli již mail byl na cestě k zákazníkovi.

\n"); } } elsif($konfig{akce} eq 'Uzavřít') { zmenit_stav_objednavky($konfig{cislo}, 'uzavřeno'); } # Vypsat přehled objednávek. vypsat_objednavku($konfig{cislo}); # Zjistit, jak dlouho nám to trvalo, a vypsat to na konec stránky. my $hlaseni = sestavit_hlaseni_o_trvani_programu($starttime); print("
$hlaseni
\n"); # Poslat konec stránky. print < EOF ; ############################################################################## # PODPROGRAMY ############################################################################## #----------------------------------------------------------------------------- # Vypíše údaje o objednávce. #----------------------------------------------------------------------------- sub vypsat_objednavku { my $cislo_objednavky = shift; # Získat z databáze informace o poslední objednávce. my @nazvy = qw(cas jmeno prijmeni ulice_a_dum obec psc email telefon poznamka poznamka2 odber platba mezisoucet mnozstevni_sleva postovne celkem sleva_org_deti ico); my $objednavky; if($cislo_objednavky) { $objednavky = dzsql::dotaz($databaze, @nazvy, "objednavky WHERE cas = '$cislo_objednavky'"); } else { $objednavky = dzsql::dotaz($databaze, @nazvy, "objednavky ORDER BY cas DESC LIMIT 1"); } my $objednavka = $objednavky->[0]; my $objzbozi = dzsql::dotaz($databaze, "kod_zbozi", "zbozi.nazev AS nazev", "kod_hry", "hry.nazev AS nazev_hry", "jednotkova_cena", "pocet", "cena_celkem", "objzbozi LEFT JOIN zbozi ON objzbozi.kod_zbozi = zbozi.kod LEFT JOIN hry ON zbozi.kod_hry = hry.kod WHERE cas = '$objednavka->{cas}'"); my $cele_jmeno = "$objednavka->{jmeno} $objednavka->{prijmeni}"; $cele_jmeno =~ s/^\s+//; $cele_jmeno =~ s/\s+/ /g; $cele_jmeno =~ s/\s+$//; print("

$cele_jmeno

\n"); # Zjistit aktuální stav objednávky. my $stav = 'objednáno'; my $cas = $objednavka->{cas}; my $objstavy = dzsql::dotaz($databaze, 'cas_zmeny', 'novy_stav', "objstavy WHERE cobj = '$cas' ORDER BY cas_zmeny DESC"); if(scalar(@{$objstavy})) { $stav = $objstavy->[0]{novy_stav}; } my %stavy = ( 'objednáno' => 'Zákazník čeká na naši první reakci.', 'máme' => 'Zákazník byl informován, že zboží máme a pošleme mu ho na dobírku.', 'zaplaťte' => 'Čekáme na peníze od zákazníka.', 'uzavřeno' => 'Objednávka je vyřízena a uzavřena.' ); print("

Stav: $stavy{$stav}

\n"); # Vypsat historii změn stavů objednávky. push(@{$objstavy}, {'cas_zmeny' => $cas, 'novy_stav' => 'objednáno'}); foreach my $zmena (@{$objstavy}) { my $cas = $zmena->{cas_zmeny}; $cas =~ m/(\d\d\d\d)(\d\d)(\d\d)(\d\d)(\d\d)(\d\d)/; my $formdatum = sprintf("%d.%d.%d", $3, $2, $1); my $formcas = sprintf("%d:%02d:%02d", $4, $5, $6); print("

$formdatum $formcas $zmena->{novy_stav}

\n"); } # Umožnit změnu stavu objednávky. print("
\n"); my @prvky; my $chyba; my $disabled; push(@prvky, ""); proverit_pozadavek_na_zmenu_stavu($cislo_objednavky, 'máme', \$chyba, \$disabled); push(@prvky, ""); push(@prvky, ""); push(@prvky, ""); push(@prvky, ""); push(@prvky, ""); print("

", join("\n ", @prvky), "

\n"); print("
\n"); # Vypsat údaje o objednávce. my $skype = $objednavka->{telefon}; $skype =~ s/[-\s\/\.]//g; if($skype !~ m/^\+/) { $skype = "+420".$skype; } print("\n"); print("\n"); print("\n"); print("\n"); print("\n"); print("
\n"); print("

Kontakty:
\n"); print(" E-mail: {email}\">$objednavka->{email}
\n"); print(" Telefon: $objednavka->{telefon}

\n"); print("

Dodací adresa:
\n"); print(" $objednavka->{ulice_a_dum}
\n"); print(" $objednavka->{psc} $objednavka->{obec}

\n"); print("		\n"); print(" \n"); print(" \n"); print(" \n"); print(" \n"); print(" \n"); print(" \n"); print(" \n"); print(" \n"); print(" \n"); print(" \n"); print(" \n"); print(" \n"); print(" \n"); print(" \n"); print("
\n"); if($objednavka->{odber} eq "cm") { print(" \n"); print(" \n"); print(" ČERNÝ MOST\n"); } elsif($objednavka->{odber} eq "paluba") { print(" \n"); print(" \n"); print(" PALUBA\n"); } else { print(" \n"); print(" \n"); print(" ZBOŽÍ POŠTOU\n"); } print("
\n"); if($objednavka->{platba} eq "hotově") { if($objednavka->{odber} =~ m/^(paluba|cm)$/) { print(" \n"); print(" \n"); print(" PENÍZE HOTOVĚ\n"); } else { print(" \n"); print(" \n"); print(" PENÍZE DOBÍRKOU\n"); } } else { print(" \n"); print(" \n"); print(" PENÍZE PŘEVODEM\n"); } print("
$objednavka->{celkem} Kč
\n"); print("

Kontrola: $objednavka->{odber} $objednavka->{platba}

\n"); print("

Poznámka: $objednavka->{\"objednavky.poznamka\"}

\n"); print("

Poznámka 2: $objednavka->{poznamka2}

\n"); print("

Sleva pro dětské organizace: $objednavka->{sleva_org_deti}

\n"); if($objednavka->{ico}) { my $url = 'http://wwwinfo.mfcr.cz/cgi-bin/ares/ares_es.cgi?jazyk=cz&obch_jm=&ico='.$objednavka->{ico}.'&cestina=cestina&obec=&k_fu=&maxpoc=200&ulice=&cis_or=&cis_po=&setrid=ZADNE&pr_for=&okec=&okec_h=&xml=1&filtr=0&nace=&nace_h='; print("

IČO: $objednavka->{ico}

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

Objednané zboží:

\n"); print("\n"); print(" \n"); print(" \n"); print(" \n"); print(" \n"); print(" \n"); print(" \n"); print(" \n"); foreach my $polozka (@{$objzbozi}) { print(" \n"); print(" \n"); print(" \n"); print(" \n"); print(" \n"); print(" \n"); print(" \n"); } print(" \n"); print(" \n"); print(" \n"); print(" \n"); print("
HraPoložkaPočetJednotková cenaCena
{kod_hry}\">$polozka->{nazev_hry}"); if($polozka->{kod_zbozi} eq "") { print("Varování: V databázi nám chybí kód objednaného zboží!"); } else { print($polozka->{nazev}); } print("$polozka->{pocet} × $polozka->{jednotkova_cena} Kč = $polozka->{cena_celkem} Kč
mezisoučet$objednavka->{mezisoucet} Kč
poštovné$objednavka->{postovne} Kč
množstevní sleva$objednavka->{mnozstevni_sleva} Kč
celkem$objednavka->{celkem} Kč
\n"); } #----------------------------------------------------------------------------- # Zjistí poslední stav objednávky. # Nepředpokládá, že by objednávka vůbec neexistovala. Jestliže nenajde žádný # záznam o změně stavu objednávky, předpokládá úvodní stav "objednáno". #----------------------------------------------------------------------------- sub zjistit_stav_objednavky { my $cislo_objednavky = shift; my $stav = 'objednáno'; my $objstavy = dzsql::dotaz($databaze, 'cas_zmeny', 'novy_stav', "objstavy WHERE cobj = '$cislo_objednavky' ORDER BY cas_zmeny DESC"); if(scalar(@{$objstavy})) { $stav = $objstavy->[0]{novy_stav}; } return $stav; } #----------------------------------------------------------------------------- # Ověří, zda je zamýšlená změna stavu přípustná. Zejména má zabránit tomu, # abychom témuž zákazníkovi opakovaně odeslali stejný mail a mátli ho. #----------------------------------------------------------------------------- sub proverit_pozadavek_na_zmenu_stavu { my $cislo_objednavky = shift; my $novy_stav = shift; # Chceme, aby se funkce dala snadno použít v podmínkách, proto vrací pouze 0 nebo 1. # Případné chybové hlášení zapíše do úložiště, na nějž dostane odkaz. my $refchyba = shift; my $uloziste; if(ref($refchyba) ne 'SCALAR') { $refchyba = \$uloziste; } ${$refchyba} = ''; # Obdobně volitelně rovnou nastavíme parametr disabled pro tlačítko webového formuláře. my $refdisabled = shift; my $uloziste_disabled; if(ref($refdisabled) ne 'SCALAR') { $refdisabled = \$uloziste_disabled; } ${$refdisabled} = ''; my $stary_stav = zjistit_stav_objednavky($cislo_objednavky); # Typicky se do každého stavu dá dostat jen z jednoho konkrétního předcházejícího stavu. if($novy_stav =~ m/^(máme|zaplaťte)$/ && $stary_stav ne 'objednáno') { ${$refchyba} = "Chyba: do stavu '$novy_stav' lze přejít pouze ze stavu 'objednáno', ale současný stav objednávky $cislo_objednavky je '$stary_stav'."; } # Vrátit výsledek. if(${$refchyba}) { ${$refdisabled} = ' disabled'; return 0; } else { return 1; } } #----------------------------------------------------------------------------- # Změní stav objednávky. #----------------------------------------------------------------------------- sub zmenit_stav_objednavky { my $cislo_objednavky = shift; my $novy_stav = shift; # Ověřit, že stav, který chceme objednávce přiřadit, je na seznamu známých stavů. unless($novy_stav =~ m/^(objednáno|máme|zaplaťte|uzavřeno)$/) { print("

Chyba: neznámý stav \"$novy_stav\"

\n"); return 0; } # Ověřit, že nový stav je opravdu nový, tj. že tohle už není současný stav. my $stav = zjistit_stav_objednavky($cislo_objednavky); if($novy_stav eq $stav) { print("

Chyba: objednávka už je ve stavu \"$novy_stav\"

\n"); return 0; } # Přidat do databáze nový stav objednávky s aktuálním časem. my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime(time()); my $cas_zmeny = sprintf("%04d%02d%02d%02d%02d%02d", $year+1900, $mon+1, $mday, $hour, $min, $sec); my @nazvy = qw(cobj cas_zmeny novy_stav); my $seznam_poli = join(", ", @nazvy); my @hodnoty = map{encode('utf8', "'$_'")}($cislo_objednavky, $cas_zmeny, $novy_stav); my $seznam_hodnot = join(", ", @hodnoty); my $dotaz = "INSERT INTO objstavy ($seznam_poli) VALUES ($seznam_hodnot);"; unless($databaze->do($dotaz)) { print("

Chyba: Nepodařilo se přidat záznam do tabulky objstavy: ", $DBI::errstr, "

\n"); print(decode('utf8', "

$dotaz

\n")); return 0; } # Aktualizovat stav objednávky v tabulce objednavky. my $dotaz = encode('utf8', "UPDATE objednavky SET stav = '$novy_stav' WHERE cas = '$cislo_objednavky';"); unless($databaze->do($dotaz)) { print("

Chyba: Nepodařilo se aktualizovat stav v tabulce objednavky: ", $DBI::errstr, "

\n"); print(decode('utf8', "

$dotaz

\n")); return 0; } return 1; } #----------------------------------------------------------------------------- # Připraví koncept dopisu pro zákazníka. #----------------------------------------------------------------------------- sub pripravit_mail { my $cislo_objednavky = shift; my $novy_stav = shift; # Vytáhnout z databáze informace o objednávce. my $objednavky = dzsql::dotaz($databaze, 'email', 'jmeno', 'prijmeni', 'ulice_a_dum', 'obec', 'psc', 'celkem', 'platba', "objednavky WHERE cas = '$cislo_objednavky'"); my $objednavka = $objednavky->[0]; my $dodaci_adresa; $dodaci_adresa .= "$objednavka->{jmeno} $objednavka->{prijmeni}\n"; $dodaci_adresa .= "$objednavka->{ulice_a_dum}\n"; $dodaci_adresa .= "$objednavka->{psc} $objednavka->{obec}"; # Jestliže jsme stiskli tlačítko "Máme", chceme obvykle do stavu "máme" (a pošleme). # Pokud se ale bude platit předem, chceme místo toho do stavu "zaplaťte". if($novy_stav eq 'máme' && $objednavka->{platba} eq 'převodem') { $novy_stav = 'zaplaťte'; } # Jestliže se chystáme přejít do nepovoleného stavu, ani nenabízet formulář na odeslání mailu. my $chyba; unless(proverit_pozadavek_na_zmenu_stavu($cislo_objednavky, $novy_stav, \$chyba)) { print("

$chyba

\n"); return; } # Připravit formulář se vzorem mailu. Uživatel bude moci mail upravit a odeslat. my $vzor_mailu = vzor_mailu($novy_stav, $objednavka->{celkem}, $dodaci_adresa); print <
Odesílatel:obchod\@hrejsi.cz
Adresát:$objednavka->{email}
Kopie:obchod\@hrejsi.cz
Předmět:Re: Objednavka her na hrejsi.cz
(experimentální provoz: zatím se mail odešle jen na obchod, stav objednávky se ale v databázi změní)
EOF ; } #----------------------------------------------------------------------------- # Vrátí vzor mailu pro konkrétní příležitost. #----------------------------------------------------------------------------- sub vzor_mailu { my $novy_stav = shift; my $celkova_cena = shift; my $dodaci_adresa = shift; my $vzor; my $podpis = <[0]; my %mail = ( 'From' => 'obchod@hrejsi.cz', 'To' => 'danzeman11@gmail.com', 'Cc' => 'obchod@hrejsi.cz', 'Subject' => 'Re: Objednavka her na hrejsi.cz', 'text' => "Až to nebude zkušební provoz, tak bude adresátem tohoto mailu $objednavka->{email}.\n".$text ); mail::odeslat(%mail); } #------------------------------------------------------------------------------ # Vypíše dobu, po kterou program běžel. K tomu potřebuje dostat časové otisky # začátku a konce. #------------------------------------------------------------------------------ sub sestavit_hlaseni_o_trvani_programu { my $starttime = shift; my $stoptime = time(); my $cas = $stoptime-$starttime; my $hod = int($cas/3600); my $min = int(($cas%3600)/60); my $sek = $cas%60; my $hlaseni; if($hod==0) { if($min==0) { $hlaseni = sprintf("Program běžel $sek vteřin%s.\n", $sek==1 ? "u" : $sek>=2 && $sek<=4 ? "y" : ""); } else { $hlaseni = sprintf("Program běžel %d:%02d minut.\n", $min, $sek); } } else { $hlaseni = sprintf("Program běžel %2d:%02d:%02d hodin.\n", $hod, $min, $sek); } return $hlaseni; }