#!/usr/bin/perl # Generuje přehled odeslaných zásilek. Hodí se při ročním vyúčtování kvůli daňovému přiznání. # Copyright © 2011 Daniel Zeman # 29.3.2011: vytvořeno use utf8; use Encode; 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"); # 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. 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); # Poslat začátek stránky. print < Roční vyúčtování poštovného

Roční vyúčtování poštovného

EOF ; # Připojit se k databázi. $databaze = sitesql::connect('hry'); # Vypsat přehled objednávek. vypsat_prehled_objednavek($konfig{filtr}); # 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 přehled objednávek. #----------------------------------------------------------------------------- sub vypsat_prehled_objednavek { # Získat z databáze přehled objednávek. # my $zdroj = "objednavky LEFT JOIN objzbozi ON objednavky.cas = objzbozi.cas LEFT JOIN zbozi ON objzbozi.kod_zbozi = zbozi.kod"; my $zdroj = 'objednavky INNER JOIN objstavy ON objednavky.cas = objstavy.cobj'; my $filtr = "(novy_stav = 'odesláno') AND ((cas_zmeny LIKE '2010%') OR (datum_odeslani LIKE '%2010'))"; my @nazvy = qw(cas jmeno prijmeni obec odber platba varsymbol mezisoucet mnozstevni_sleva postovne celkem sleva_org_deti stav rychlost novy_stav cas_zmeny datum_odeslani podaci_cislo zaplacene_postovne); $dzsql::debug = 1; my $pokus = dzsql::dotaz($databaze, @nazvy, "$zdroj WHERE $filtr"); my @objednavky = sort{$a->{cas_zmeny}<=>$b->{cas_zmeny}}(@{$pokus}); print("

Dotaz vrátil ", scalar(@{$pokus}), " řádků.

\n"); # Vypsat objednávky seřazené vzestupně podle okamžiku odeslání. print(" \n"); print(" \n"); my $i_radek = 0; foreach my $objednavka (@objednavky) { my $cas = $objednavka->{cas}; my $tdatr = ++$i_radek % 2 ? " bgcolor=#D5D5D5" : " bgcolor=#E5E5E5"; $tdatr .= " valign=top"; my $tdatrr = $tdatr.' align=right'; print(" \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"); # Datum a čas odeslání. $objednavka->{cas_zmeny} =~ m/(\d\d\d\d)(\d\d)(\d\d)(\d\d)(\d\d)(\d\d)/; $formdatum = sprintf("%d.%d.%d", $3, $2, $1); $formcas = sprintf("%d:%02d:%02d", $4, $5, $6); print(" $formdatum\n"); print(" $formcas\n"); print(" $objednavka->{datum_odeslani}\n"); print(" $objednavka->{podaci_cislo}\n"); print(" $objednavka->{zaplacene_postovne} Kč\n"); my $cele_jmeno = "$objednavka->{jmeno} $objednavka->{prijmeni}"; $cele_jmeno =~ s/^\s+//; $cele_jmeno =~ s/\s+/ /g; $cele_jmeno =~ s/\s+$//; print(" $cele_jmeno\n"); my $misto = $objednavka->{odber} eq "paluba" ? "(osobně na Palubě)" : $objednavka->{odber} eq "cm" ? "(osobně na Černém Mostě)" : $objednavka->{obec}; $misto =~ s/^\s+//; $misto =~ s/\s+/ /g; $misto =~ s/\s+$//; print(" $misto\n"); my $platba = $objednavka->{odber} eq 'posta' && $objednavka->{platba} eq 'hotově' ? 'dobírkou' : $objednavka->{platba}; print(" $platba\n"); my $vs = $objednavka->{varsymbol}; print(" $vs\n"); my $cena = $objednavka->{celkem}; print(" $cena Kč\n"); my $postovne = $objednavka->{postovne}; print(" $postovne Kč\n"); my @polozky; foreach my $polozka (@{$objednavka->{polozky}}) { my $poltext; if($polozka->{pocet}>1) { $poltext = "$polozka->{pocet} × "; } $poltext .= $polozka->{nazev}; push(@polozky, $poltext); } my $polozky = join(", ", @polozky); print(" $polozky\n"); print(" \n"); } print("

Objednáno		Odesláno			Podací číslo	My	Jméno	Obec	Jak	VS	Celkem	Oni

\n"); }