#!/usr/bin/perl # Generuje přehled objednávek z databáze. Přístup by měli mít jen zaměstnanci obchodu. # Copyright © 2005-2013 Daniel Zeman # 13.12.2005: vytvořeno # 24.2.2009: seznam nyní obsahuje jen nevyřízené objednávky; podle parametrů CGI filtr na dobírky, Palubu, ČM # 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ží) # 14.10.2012: nově možnost vyzvednout zboží v Jenštejně # 12.5.2013: začíná adaptace na nový obchod s více odděleními # 18.10.2014: nyní je možné objednat doručení přes Uloženku use utf8; use Encode; # používá se při komunikaci s MySQL use DBI; # Přidat Danovy sdílené knihovny. Skript běžící pod uživatelem apache by je jinak nenašel. use lib '/home/dan/lib'; use dzcgi; use sitesql; use dzsql; use cas; # Přinutit Perl, aby UTF8 vypisoval jako UTF8 a nevymýšlel pro mě "vhodné" osmibitové kódování. binmode(STDOUT, ':utf8'); use dbobj; # 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(); # Používání absolutních URL místo relativních údajně zvyšuje šance, že prohlížeč nepoužije cache. # Až na to, že s absolutními URL nemůžeme v sousední složce ladit nové funkce, protože odkazy vedou do hlavní složky. my $urlbase = '.'; #'http://hrejsi.cz/cgi/hry/vnitro'; # Poslat MIME záhlaví dokumentu. print("Content-Type: text/html; charset=utf-8\n\n"); # Přečíst parametry. dzcgi::cist_parametry(\%konfig); # filtr = posta|paluba|cm $konfig{filtr} = 'neodeslane' unless($konfig{filtr}); # Poslat začátek stránky. print < Přehled objednávek

Přehled objednávek

EOF ; # Připojit se k databázím. # $databaze ... obsahuje objednávky # $hdb ... obsahuje katalog a ceník her # $odb ... obsahuje katalog a ceník ostatního zboží $databaze = sitesql::connect('obchod'); $hdb = sitesql::connect('hry'); $odb = $databaze; # Načíst katalog zboží. Zejména potřebujeme ke kódům zboží názvy zboží. $katalog = dbobj::nacist_katalog($hdb, $odb); # Vypsat přehled objednávek. vypsat_prehled_objednavek($konfig{filtr}, $katalog); # Vypsat seznam zboží, které si od nás zákazníci objednali, ale nemáme ho na skladě. vypsat_seznam_chybejiciho_zbozi($databaze, $hdb, $odb); # 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 ############################################################################## #----------------------------------------------------------------------------- # Vypíše odkazy na předdefinované filtry. #----------------------------------------------------------------------------- sub vypsat_filtry { my $filtr0 = shift; # Sestavit odkazy na filtry. my @roky = (2005..cas::ted()->{rok}); my @filtry = ('neodeslane', 'odeslane', 'azbude', 'vraceno', @roky, 'vse'); my %filtry = ( 'neodeslane' => { 'self' => 'Neodeslané', 'href' => "Neodeslané", 'where' => "objednavky.stav <> 'odesláno' AND objednavky.stav <> 'uzavřeno' AND objednavky.stav <> 'vráceno' AND objednavky.stav <> 'až bude'", 'info' => 'neodeslaných objednávek' }, 'odeslane' => { 'self' => 'Odeslané', 'href' => "Odeslané", 'where' => "objednavky.stav = 'odesláno'", 'info' => 'odeslaných neuzavřených objednávek' }, 'posta' => { 'self' => 'Pošta', 'href' => "Pošta", 'where' => "objednavky.stav <> 'uzavřeno' AND (odber = 'posta' OR odber = 'posta_do_ruky' OR odber = 'dpd') AND objednavky.stav <> 'až bude'", 'info' => 'neuzavřených poštovních objednávek s výjimkou dlouhodobě nedostupných' }, 'jenstejn' => { 'self' => 'Jenštejn', 'href' => "Jenštejn", 'where' => "objednavky.stav <> 'uzavřeno' AND odber = 'jenstejn' AND objednavky.stav <> 'až bude'", 'info' => 'neuzavřených objednávek k osobnímu vyzvednutí v Jenštejně s výjimkou dlouhodobě nedostupných' }, 'paluba' => { 'self' => 'Paluba', 'href' => "Paluba", 'where' => "objednavky.stav <> 'uzavřeno' AND odber = 'paluba' AND objednavky.stav <> 'až bude'", 'info' => 'neuzavřených palubních objednávek s výjimkou dlouhodobě nedostupných' }, 'azbude' => { 'self' => 'Až bude', 'href' => "Až bude", 'where' => "objednavky.stav = 'až bude'", 'info' => 'objednávek dlouhodobě nedostupného zboží' }, 'vraceno' => { 'self' => 'Vráceno', 'href' => "Vráceno", 'where' => "objednavky.stav = 'vráceno'", 'info' => 'objednávek, které si ti hajzlové nepřevzali' }, 'vsepaluba' => { 'self' => 'Paluba vše', 'href' => "Paluba vše", 'where' => "odber = 'paluba'", 'info' => 'palubních objednávek' }, 'vse' => { 'self' => 'vše', 'href' => "vše", 'where' => 'TRUE', 'info' => 'objednávek' } ); foreach my $rok (@roky) { $filtry{$rok} = { 'self' => "$rok", 'href' => "$rok", 'where' => "objednavky.cas LIKE '$rok%'", 'info' => "objednávek z roku $rok" }; } my $odkazy_html = join(' | ', map {$_ eq $filtr0 ? $filtry{$_}{self} : $filtry{$_}{href}} (@filtry)); $odkazy_html .= ' | phpMyAdmin'; print("

$odkazy_html

\n"); my $aktivni_filtr = exists($filtry{$filtr0}) ? $filtry{$filtr0} : $filtry{neuzavrene}; return $aktivni_filtr; } #----------------------------------------------------------------------------- # Připraví dotaz pro MySQL, kterým získá údaje o vybraných objednávkách. #----------------------------------------------------------------------------- sub pripravit_dotaz { my $databaze = shift; my $filtr = shift; # Získat z databáze přehled objednávek. # Dotaz vrátí pro každou objednávku několik řádků. # @nazvy0 jsou pole, která mají ve všech řádcích stejné hodnoty, tudíž je ukládáme jen po přečtení prvního řádku objednávky. # @nazvy1 jsou pole, jejichž hodnoty jsou na každém řádku objednávky jiné (vztahují se k jednotlivým objednaným položkám). my @nazvy0 = qw(objednavky.cas jmeno prijmeni ulice_a_dum obec psc email telefon objednavky.poznamka poznamka2 odber platba ulozenka_branches varsymbol mezisoucet mnozstevni_sleva postovne celkem sleva_org_deti ico objednavky.stav rychlost sms); my @nazvy1 = qw(databaze kod_zbozi jednotkova_cena pocet cena_celkem); my $nazvy0 = join(', ', @nazvy0); my $nazvy1 = join(', ', @nazvy1); my $dotaz = "SELECT $nazvy0, $nazvy1 FROM objednavky LEFT JOIN objzbozi ON objednavky.cas = objzbozi.cas WHERE $filtr"; my $dbdtz = $databaze->prepare($dotaz); $dbdtz->execute(); # Pro další použití odstranit případné tečkované prefixy (názvy tabulek). @nazvy0 = map {s/\w+\.//; $_} (@nazvy0); # Volající potřebuje znát i názvy polí, aby v průběhu čtení výsledku dotazu mohl převádět pole hodnot na hashe. return ($dbdtz, \@nazvy0, \@nazvy1); } #----------------------------------------------------------------------------- # Načte z databáze údaje o objednávkách. #----------------------------------------------------------------------------- sub cist_objednavky { my $dbdtz = shift; my $nazvy0 = shift; # pole společná pro všechny řádky objednávky my $nazvy1 = shift; # pole, jejichž hodnoty se na každém řádku mění my %objednavky; # hash, kam budeme načtené objednávky ukládat while(my @hodnoty = map {decode('utf8', $_)} ($dbdtz->fetchrow_array())) { # Pokud je to první řádek dané objednávky, vytvořit záznam a zapsat do něj informace společné pro všechny řádky. my $cas = $hodnoty[0]; unless(exists($objednavky{$cas})) { # Převést záznam do podoby hashe. my %zaznam; for(my $i = 0; $i<=$#{$nazvy0}; $i++) { $zaznam{$nazvy0->[$i]} = $hodnoty[$i]; } $objednavky{$cas} = \%zaznam; } # Přidat do záznamu informace specifické pro daný řádek. my %zaznam; for(my $i = 0; $i<=$#{$nazvy1}; $i++) { $zaznam{$nazvy1->[$i]} = $hodnoty[$#{$nazvy0}+1+$i]; } push(@{$objednavky{$cas}{polozky}}, \%zaznam); } return \%objednavky; } #----------------------------------------------------------------------------- # Vypíše přehled objednávek. #----------------------------------------------------------------------------- sub vypsat_prehled_objednavek { my $filtr0 = shift; my $katalog = shift; my $aktivni_filtr = vypsat_filtry($filtr0); my $infofiltr = $aktivni_filtr->{info}; my ($dbdtz, $nazvy0, $nazvy1) = pripravit_dotaz($databaze, $aktivni_filtr->{where}); ###!!! k databázi zde přistupujeme jako ke globální proměnné! my $objednavky = cist_objednavky($dbdtz, $nazvy0, $nazvy1); # Vypsat objednávky seřazené sestupně podle okamžiku objednání. my @objednavky = sort {$b<=>$a} (keys(%{$objednavky})); print("

V databázi je ", scalar(@objednavky), " $infofiltr.

\n"); print("

\n"); if($konfig{filtr}) { print(" \n"); } print(" \n"); print(" \n"); print(" \n"); my $i_radek = 0; foreach my $cas (@objednavky) { my $o = $objednavky->{$cas}; my $tdatr = ++$i_radek % 2 ? " bgcolor=#D5D5D5" : " bgcolor=#E5E5E5"; if($o->{stav} eq 'objednáno') { $tdatr .= " style='font-weight:bold'"; } elsif($o->{stav} eq 'máme') { $tdatr .= " style='color:green'"; } elsif($o->{stav} eq 'zaplaceno') { $tdatr .= " style='color:green;font-weight:bold'"; } elsif($o->{stav} eq 'nemáme') { $tdatr .= " style='color:red'"; } elsif($o->{stav} =~ m/^(zaplaťte|vytištěno před zaplacením)$/) { $tdatr .= " style='color:blue'"; } $tdatr .= " valign=top"; my $tdatrr = $tdatr.' align=right'; print(" \n"); # Zaškrtávátko, kterým lze označit objednávky k hromadné operaci. print(" \n"); # Aktuální stav objednávky. print(" $o->{stav}\n"); # Datum a čas vzniku objednávky. $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\n"); print(" $formcas\n"); my $cele_jmeno = "$o->{jmeno} $o->{prijmeni}"; $cele_jmeno =~ s/^\s+//; $cele_jmeno =~ s/\s+/ /g; $cele_jmeno =~ s/\s+$//; print(" $cele_jmeno\n"); my $misto; if($o->{odber} eq 'paluba') { $misto = '(osobně na Palubě)'; } elsif($o->{odber} eq 'cm') { $misto = '(osobně na Černém Mostě)'; } elsif($o->{odber} eq 'jenstejn') { $misto = '(osobně v Jenštejně)'; } elsif($o->{odber} eq 'ulozenka') { $misto = "(Uloženka) $o->{ulozenka_branches}"; } elsif($o->{odber} eq 'intime') { $misto = '(Poštomat InTime)'; } elsif($o->{odber} eq 'posta_na_postu') { $misto = '(balík Na poštu)'; } elsif($o->{odber} eq 'dpd') { $misto = "$o->{obec} (DPD)"; } else # posta | posta_do_ruky { $misto = $o->{obec}; } $misto =~ s/^\s+//; $misto =~ s/\s+/ /g; $misto =~ s/\s+$//; print(" $misto\n"); # Rychlokódy důležitých údajů. my @rychlokody; if($o->{sms}) { push(@rychlokody, 'S'); } if($o->{rychlost} eq 'zrychleně') { push(@rychlokody, 'R'); } elsif($o->{rychlost} eq 'expresně') { push(@rychlokody, 'E'); } my $rychlokody = join('', @rychlokody); print(" $rychlokody\n"); my $platba = $o->{odber} eq 'posta' && $o->{platba} eq 'hotově' ? 'dobírkou' : $o->{platba}; print(" $platba\n"); my $vs = $o->{varsymbol}; print(" $vs\n"); my $cena = $o->{celkem}; print(" $cena Kč\n"); my @polozky; foreach my $polozka (@{$o->{polozky}}) { my $poltext; if($polozka->{pocet}>1) { $poltext = "$polozka->{pocet} × "; } $poltext .= $katalog->{$polozka->{databaze}}{zbozi}{$polozka->{kod_zbozi}}{nazev}; push(@polozky, $poltext); } my $polozky = join(', ', @polozky); print(" $polozky\n"); print(" \n"); } print("

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

\n"); } #----------------------------------------------------------------------------- # Uzavře všechny objednávky vzniklé v určitém období. Používá se pro # jednorázové akce, kdy je zanedbaných objednávek tolik, že by Kláře dalo moc # práce uzavírat je ručně. #----------------------------------------------------------------------------- sub uzavrit_skupinu_objednavek { my $objednavky = dzsql::dotaz($databaze, 'cas', 'stav', "objednavky WHERE (cas < '20090000000000') AND (stav <> 'uzavřeno')"); foreach my $obj (@{$objednavky}) { # Přidat do tabulky objstavy nový stav objednávky. my $dotaz = encode('utf8', "INSERT INTO objstavy (cobj, cas_zmeny, novy_stav) VALUES ('$obj->{cas}', '20090217111111', 'uzavřeno');"); 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 = 'uzavřeno' WHERE cas = '$obj->{cas}';"); unless($databaze->do($dotaz)) { print("

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

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

$dotaz

\n")); return 0; } } } #------------------------------------------------------------------------------ # Vypíše seznam objednaného zboží, které chybí na skladě. #------------------------------------------------------------------------------ sub vypsat_seznam_chybejiciho_zbozi { my $databaze = shift; # objednávky my $hdb = shift; # katalog her my $odb = shift; # katalog ostatního zboží # Zjistit názvy zboží z databáze her. my %nazev; my $nazvy_hdb = dzsql::dotaz($hdb, 'kod', 'nazev', 'zbozi'); foreach my $zaznam (@{$nazvy_hdb}) { $nazev{hry}[$zaznam->{kod}] = $zaznam->{nazev}; } my $nazvy_odb = dzsql::dotaz($odb, 'kod', 'nazev', 'zbozi'); foreach my $zaznam (@{$nazvy_odb}) { $nazev{obchod}[$zaznam->{kod}] = $zaznam->{nazev}; } # Zjistit z databáze, které objednané zboží chybí. my $chzbozi = dzsql::dotaz($databaze, 'objednavky.cas AS cas', 'odber', 'stav', 'kod_zbozi', 'databaze', 'pocet', 'chybi', '(objednavky INNER JOIN objzbozi ON objednavky.cas = objzbozi.cas) LEFT JOIN zbozi ON objzbozi.kod_zbozi = zbozi.kod WHERE chybi > 0 AND stav = "nemáme" ORDER BY odber, stav, nazev'); print("\n"); print(" \n"); print(" \n"); print(" \n"); foreach my $chz (@{$chzbozi}) { print(" \n"); my $url = "$urlbase/objednavka.pl?cislo=$chz->{cas}"; print(" \n"); print(" \n"); print(" \n"); print(" \n"); print(" \n"); print(" \n"); print(" \n"); print(" \n"); } print("

čas	odběr	stav	kód zboží	název zboží	objednaný počet	z toho chybí
$chz->{cas}	$chz->{odber}	$chz->{stav}	$chz->{kod_zbozi}	$nazev{$chz->{databaze}}[$chz->{kod_zbozi}]	$chz->{pocet}	$chz->{chybi}

\n"); }