#!/usr/bin/perl # Internetový obchod s hrami / funkce pro práci s databází objednávek na serveru. # Copyright © 2009-2015 Dan Zeman # 6.5.2012: dospěla sem přestavba, nyní se pracuje s databází "obchod" (ale "hry" mohou být potřeba kvůli detailům o zboží) # 18.10.2014: nyní je možné objednat doručení přes Uloženku # 25.7.2015: přechod na nový kub.cz package dbobj; use utf8; use open ':utf8'; use Encode; use lib '/s/w/lib/dan'; use dzsql; use sitesql; #------------------------------------------------------------------------------ # Globální seznam a popis stavů poskytujeme i ven z tohoto modulu. Pokud # přibude nový stav, mělo by pro všechny obslužné perlové skripty stačit přidat # ho tady. Mimo to se ale ještě musí přidat na serveru MySQL v definici tabulek # objednavky a objstavy. Pořadí, ve kterém zde stavy uvádíme, může mít vliv na # pořadí, v jakém se seznam stavů zobrazí uživateli. Mělo by jít více méně o # logickou posloupnost, částečné uspořádání tak, jak jdou jednotlivé akce při # zpracování objednávky po sobě. #------------------------------------------------------------------------------ BEGIN { @poradi_stavu = ('objednáno', 'nemáme', 'až bude', 'máme', 'zaplaťte', 'vytištěno před zaplacením', 'zaplaceno', 'vytištěno', 'odesláno', 'částečně vyřízeno', 'vráceno', 'uzavřeno'); %stavy = ( 'objednáno' => 'Zákazník čeká na naši první reakci.', 'nemáme' => 'Zákazník byl informován, že zboží nemáme a čekáme, až nám ho dodají.', 'až bude' => 'Zákazník byl informován, že zboží dlouhodobě nemáme. Až se zboží objeví, zeptáme se ho, zda ještě má zájem.', '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.', 'vytištěno před zaplacením' => 'Čekáme na peníze od zákazníka, ale tisky potřebné k zabalení a odeslání zásilky už jsou připravené.', 'zaplaceno' => 'Peníze od zákazníka dorazily, zboží je připraveno na Palubě.', # u zásilek místo tohohle stav 'máme' 'vytištěno' => 'Tisky potřebné k zabalení a odeslání zásilky už jsou hotové, zbývá zásilku zabalit a odnést na poštu.', 'odesláno' => 'Zásilka byla odeslána poštou, ale zatím nevíme, zda ji zákazník přijal.', 'částečně vyřízeno' => 'Částečně vyřízeno. Následuje po stavu odesláno, ale na rozdíl od stavu uzavřeno znamená, že jsme odeslali jen tu část zboží, které je skladem, a na zbytek ještě čekáme.', 'vráceno' => 'Zásilka se vrátila, protože si ji zákazník nepřevzal.', 'uzavřeno' => 'Objednávka je vyřízena a uzavřena.' ); } #----------------------------------------------------------------------------- # Zjistí z databáze údaje o objednávce. Pokud nedostane číslo objednávky, # vytáhne z databáze poslední objednávku. #----------------------------------------------------------------------------- sub zjistit_objednavku { my $databaze = shift; my $katalog = shift; my $cislo_objednavky = shift; my @nazvy = qw ( cas jmeno prijmeni ulice_a_dum obec psc email telefon poznamka poznamka2 odber ulozenka_branches zasilkovna_id zasilkovna_name platba sms rychlost mezisoucet mnozstevni_sleva postovne celkem sleva_org_deti ico slevkod varsymbol datum_odeslani podaci_cislo pilne hmotnost zaplacene_postovne poznamka_obchod ); 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 $cas = $objednavka->{cas}; my $objzbozi = dzsql::dotaz($databaze, 'databaze', 'kod_zbozi', 'jednotkova_cena', 'pocet', 'cena_celkem', 'chybi', "objzbozi WHERE cas = '$cas'"); # Doplnit názvy zboží z katalogu. foreach my $z (@{$objzbozi}) { my $kz = $katalog->{$z->{databaze}}{zbozi}{$z->{kod_zbozi}}; $z->{nazev} = $kz->{nazev}; if($z->{databaze} eq 'hry') { $z->{kod_hry} = $kz->{kod_hry}; $z->{nazev_hry} = $kz->{nazev_hry}; } } $objednavka->{zbozi} = $objzbozi; my $objstavy = dzsql::dotaz($databaze, 'cas_zmeny', 'novy_stav', "objstavy WHERE cobj = '$cas' ORDER BY cas_zmeny DESC"); $objednavka->{stavy} = $objstavy; if($objednavka->{odber} =~ m/^(ulozenka|intime|posta_na_postu)$/) { if(defined($objednavka->{ulozenka_branches}) && $objednavka->{ulozenka_branches} !~ m/^\s*$/) { # Zjistit název pobočky podle jejího kódu. Budeme se dívat do naší databáze, kde nemusí být údaje aktuální, # zatímco zákazník vybíral ze seznamu, který se teď stáhnul ze serveru Uloženky. Ale pobočky se nemění tak často. my $pobocky = dzsql::dotaz($databaze, 'name', 'link', 'lat', 'lng', "ulozenka_branches WHERE shortcut = '$objednavka->{ulozenka_branches}'"); if(scalar(@{$pobocky})>=1) { # Může se stát, že pobočku nenajdeme, ale nemělo by se stát, že jich najdeme více. $objednavka->{ulozenka_branches_name} = $pobocky->[0]{name}; $objednavka->{ulozenka_branches_link} = $pobocky->[0]{link}; # Některé pobočky (např. poštomaty) nemají odkaz na svou vlastní webovou stránku. # Mají ale souřadnice, takže vytvoříme alespoň odkaz na mapu. if(!defined($objednavka->{ulozenka_branches_link}) || $objednavka->{ulozenka_branches_link} =~ m/^\s*$/) { my $lat = $pobocky->[0]{lat}; my $lng = $pobocky->[0]{lng}; $objednavka->{ulozenka_branches_link} = "http://www.mapy.cz/zakladni?x=$lng&y=$lat&z=15&source=coor&id=$lng%2C$lat"; } } } } elsif($objednavka->{odber} eq 'zasilkovna') { $objednavka->{zasilkovna_link} = "https://www.zasilkovna.cz/pobocky/$objednavka->{zasilkovna_id}"; $objednavka->{zasilkovna_name} =~ s/,/, /g; } return $objednavka; } #----------------------------------------------------------------------------- # Načte z databází kompletní údaje o nabízeném zboží. Získávání těchto údajů # se zkomplikovalo, když jsou teď rozdělené do dvou různých databází (hry a # ostatní). Proto je radši načteme dvěma obřími dotazy do paměti, než abychom # se museli ptát na každou položku každé objednávky zvlášť. Druhů zboží budou # řádově jednotky tisíc, takže by to mělo být zvládnutelné. Dříve jsme mohli # tyto informace připojit pomocí JOIN přímo k dotazu na tabulku objzbozi. #----------------------------------------------------------------------------- sub nacist_katalog { my $hdb = shift; # databáze her my $odb = shift; # databáze ostatního zboží my %katalog = ( 'hry' => { 'databaze' => $hdb, 'sqlzdroj' => 'zbozi LEFT JOIN hry ON zbozi.kod_hry = hry.kod', 'sqlpole' => ['zbozi.kod AS kod', 'zbozi.nazev AS nazev', 'kod_hry', 'hry.nazev AS nazev_hry'] }, 'obchod' => { 'databaze' => $odb, 'sqlzdroj' => 'zbozi', 'sqlpole' => ['kod', 'nazev'] } ); foreach my $zdroj (qw(hry obchod)) { my $zd = $katalog{$zdroj}; $zd->{zbozi_pole} = dzsql::dotaz($zd->{databaze}, @{$zd->{sqlpole}}, $zd->{sqlzdroj}); # Nahashovat názvy zboží podle kódů. foreach my $zb (@{$zd->{zbozi_pole}}) { $zd->{zbozi}{$zb->{kod}} = $zb; } } return \%katalog; } #----------------------------------------------------------------------------- # 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 $databaze = shift; 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; } #----------------------------------------------------------------------------- # Změní stav objednávky. Pokud uspěje, vrátí 1. Jinak vrátí 0 a do globální # proměnné $dbobj::chyba uloží slovní popis chyby. #----------------------------------------------------------------------------- sub zmenit_stav_objednavky { my $databaze = shift; my $cislo_objednavky = shift; my $novy_stav = shift; my $nomail = shift; # došlo ke změně stavu bez odeslání mailu zákazníkovi? # Ověřit, že stav, který chceme objednávce přiřadit, je na seznamu známých stavů. unless(exists($stavy{$novy_stav})) { $chyba = "Neznámý stav \"$novy_stav\""; return 0; } # Ověřit, že nový stav je opravdu nový, tj. že tohle už není současný stav. my $stav = zjistit_stav_objednavky($databaze, $cislo_objednavky); if($novy_stav eq $stav) { $chyba = "Objednávka už je ve stavu \"$novy_stav\""; 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 nomail); my $seznam_poli = join(", ", @nazvy); my @hodnoty = map{encode('utf8', "'$_'")}($cislo_objednavky, $cas_zmeny, $novy_stav); # Poslední hodnota je číselná, tj. nemá být obalena apostrofy. push(@hodnoty, $nomail ? 1 : 0); my $seznam_hodnot = join(", ", @hodnoty); my $dotaz = "INSERT INTO objstavy ($seznam_poli) VALUES ($seznam_hodnot);"; unless($databaze->do($dotaz)) { $chyba = "Nepodařilo se přidat záznam do tabulky objstavy: $DBI::errstr\n"; $chyba .= decode('utf8', $dotaz); return 0; } # Aktualizovat stav objednávky v tabulce objednavky. unless(dzsql::update($databaze, 'objednavky', {'cas' => $cislo_objednavky, 'stav' => $novy_stav}, ['stav'], ['cas'], [])) { $chyba = "Nepodařilo se aktualizovat stav v tabulce objednavky: $DBI::errstr\n"; $chyba .= decode('utf8', $dzsql::dotaz); return 0; } return 1; } #----------------------------------------------------------------------------- # Vytvoří řádek souboru CSV pro Uloženku o této objednávce. #----------------------------------------------------------------------------- sub sestavit_csv_pro_ulozenku { my $objednavka = shift; my $header = shift; # 1 ... nejdřív řádek s názvy polí; 0 ... pouze řádek s daty # Pořadí polí si můžeme stanovit sami, ale musíme ho samozřejmě mít pro všechny objednávky v jednom souboru stejné. my @nazvy = ('transport_service', 'address_state', 'register_branch', 'destination_branch', 'order_number', 'sender_name', 'customer_name', 'customer_surname', 'customer_phone', 'customer_email', 'address_street', 'address_town', 'address_zip', 'parcel_count', 'cash_on_delivery', 'currency', 'variable', 'weight', 'allow_card_payment', #'partner_consignment_id', #'password', #'company_name', #'insurance', #'require_full_age', 'note'); my $sluzba = ''; my $zeme = 'CZE'; if($objednavka->{odber} eq 'ulozenka') { if($objednavka->{ulozenka_branches} =~ m/^dpdsk/) { $sluzba = 'ulozenka_parcelshop'; $zeme = 'SVK'; } elsif($objednavka->{ulozenka_branches} =~ m/^dpd/) { $sluzba = 'ulozenka_parcelshop'; } else { $sluzba = 'ulozenka'; } } elsif($objednavka->{odber} eq 'intime') { if($objednavka->{ulozenka_branches} =~ m/^intime_pm_SK/) { $sluzba = 'intime_balikomat'; $zeme = 'SVK'; } else { $sluzba = 'intime_postomat'; } } elsif($objednavka->{odber} eq 'dpd') { # dpd_classic by bylo dodání prostřednictvím DPD na slovenskou adresu, ale to momentálně nenabízíme, stejně jako nenabízíme skpost_default (Slovenskou poštu). $sluzba = 'dpd_private'; } elsif($objednavka->{odber} eq 'posta_na_postu') { $sluzba = 'cpost_np'; } elsif($objednavka->{odber} eq 'posta_do_ruky') { $sluzba = 'cpost_dr'; } # Pokud chce Klárka Uložence předat něco, co mělo původně být obyčejnou poštovní zásilkou nebo osobním odběrem, # pak z toho chce téměř jistě udělat balík Do ruky. <- od 2019 NEPLATÍ! # od 2019 místo obačejného poštovného nabízíme nejlevnější a nejrychlejší a sami vybereme. Nejčastějí Uloženku na adresu. else { $sluzba = 'ulozenka_b2c'; } my %zaznam = ( # Kód služby. Povolené hodnoty: ulozenka (default), skpost_default, dpd_private, dpd_classic, ulozenka_parcelshop, cpost_dr, cpost_np, intime_postomat, intime_balikomat. 'transport_service' => $sluzba, # Kód cílové země. Povolené hodnoty: CZE, SVK. 'address_state' => $zeme, # Kód pobočky, na které bude zásilka podána. 'register_branch' => 'fr-pha-168', # Praha 9 - Čakovice, Oderská # Kód pobočky, na které bude zásilka vyzvednuta. 'destination_branch' => $objednavka->{ulozenka_branches}, # Naše číslo objednávky. 'order_number' => $objednavka->{cas}, # Tohle má být nějaké jejich číslo objednávky a nevím, jestli bych byl schopen ho generovat. # XXXXXYYZZZZZ, kde XXXXX je kód našeho obchodu v systému Uloženky, YY je nějaké číselné rozlišení zásilek a ZZZZZ je pořadové číslo zásilky od 00001. # 'partner_consignment_id' => '', # Počet balíků, které tvoří zásilku. Vyplníme vždy 1. Pokud výjimečně rozdělíme zásilku do několika balíků, tak to Klárka upraví ručně. 'parcel_count' => 1, # Výše dobírky. ###!!! U objednávek na Slovensko musíme cenu přepočítat na eura! (Museli bychom umět zjistit aktuální kurz Uloženky. Na stránkách mají dlouhodobě 25,10 Kč / EUR, ale určitě to občas mění.) 'cash_on_delivery' => $objednavka->{platba} eq 'hotově' ? $objednavka->{celkem} : 0, # Měna dobírky. ###!!! Poznat, jestli posíláme na Slovensko, a pokud ano, vyplnit tady eura! (Ale jen pokud už správně přepočítáváme hodnotu dobírky, jinak nechat.) 'currency' => 'CZK', # Můžeme zadat heslo, bez jehož znalosti nebude zásilka vydána. Zatím to neděláme. # 'password' => '', # Variabilní symbol, pod kterým nám přijdou peníze z dobírky. 'variable' => $objednavka->{varsymbol}, 'sender_name' => 'Obchod.HrejSi.cz', # Jméno a příjmení zákazníka. 'customer_name' => $objednavka->{jmeno}, 'customer_surname' => $objednavka->{prijmeni}, # Název firmy zákazníka neevidujeme. # 'company_name' => '', # Telefon a e-mail na zákazníka. 'customer_phone' => $objednavka->{telefon}, 'customer_email' => $objednavka->{email}, # Adresa zákazníka (potřebujeme ji pouze v případě doručení domů). 'address_street' => $objednavka->{ulice_a_dum}, 'address_town' => $objednavka->{obec}, 'address_zip' => $objednavka->{psc}, # Pojištění zásilky možná hraje roli jen u České pošty a Uloženka ho předvyplňuje na 50000 Kč. Ale při zaslání na Slovensko by to muselo být přepočítané na eura. # 'insurance' => 50000, # Váhu neznáme, i když ji v některých případech Uloženka vyžaduje. Klárka si ji bude muset upravit ručně. Asi to má být nezáporné číslo v kilogramech. # Mohli bychom odhadovat podle ceny: do 1000 Kč bude 1 kg, do 2000 Kč 2 kg atd. 'weight' => int($objednavka->{celkem} / 1000) + 1, # Povolit platbu kartou při osobním převzetí na pobočce? 'allow_card_payment' => 1, # Požadovat ověření plnoletosti? Nepožadujeme nikdy, takže to pole můžeme úplně vynechat. #'require_full_age' => 0, # Poznámka pro účely doručení, např. "Neklopit", "Křehké", "Doručit dopoledne". # Klárka tady ale vyplňuje seznam obsahu, protože se to pak objeví na štítku a usnadňuje jí to orientaci. 'note' => 'Obsahuje: '.join(', ', map {my $n = $_->{nazev}; $n =~ s/"([A-ZÁČĎÉÍŇÓŘŠŤÚÝŽa-záčďéíňóřšťúýž])/\x{201E}$1/g; $n =~ s/"/\x{201C}/g; $n} (@{$objednavka->{zbozi}})) ); my $csv; $csv = join(';', @nazvy)."\n" if($header); $csv .= join(';', map {my $v = $zaznam{$_}; $v =~ m/[^A-Za-z0-9_]/ ? '"'.$v.'"' : $v} (@nazvy))."\n"; return $csv; } 1;