#!/usr/bin/env perl # Aktualizuje seznam výdejních míst Uloženky. # Copyright © 2014, 2019 Dan Zeman # Licence: GNU GPL # Usage / crontab: # 40 22 * * 1-5 cd /var/web/lib/cgi/hrygit-master-release/vnitro ; perl -I/var/web/lib/dan ./aktualizovat_ulozenku.pl > ./aktualizace_ulozenky.log 2>&1 use utf8; use open ':utf8'; binmode(STDIN, ':utf8'); binmode(STDOUT, ':utf8'); binmode(STDERR, ':utf8'); use LWP::Simple; use lib '/var/web/lib/dan'; use sitesql; use dzsql; # Je možné stáhnout CSV soubor s pobočkami ručně, uložit ho na disk, pak zavolat tento skript a předat mu soubor jako argument. # Pokud skript žádný argument nenajde, pokusí se sám stáhnout soubor z Uloženky. my $csv; if(scalar(@ARGV)>0) { print STDERR ("Seznam poboček se načítá ze souboru: ", join(' ', @ARGV), "\n"); while(<>) { $csv .= $_; } } else { # Je povinný protokol HTTPS, ale jde to stáhnout, aniž by byl člověk přihlášený k uživatelskému účtu. my $branches_csv_url = 'https://partner.ulozenka.cz/implementation/export-branches'; print STDERR ("Stahuji $branches_csv_url...\n"); $csv = get($branches_csv_url); } # Jestliže se stažení souboru nezdařilo, skončit. Nechceme si z databáze vyhodit stávající tabulku, aniž bychom ji měli čím nahradit. # Typicky něco dostaneme. Ale může to být stránka HTML s chybovým hlášením. Někdy od roku 2018 začala Uloženka vyžadovat, aby uživatel # byl před stažením souboru CSV přihlášený, a pokud není, vrátí místo toho HTML se žádostí, aby se přihlásil. if($csv =~ m//) { ###!!! Taky bychom mohli testovat velikost souboru. HTML dokument, který jsem dostal, když jsem nebyl přihlášený, měl 22103 znaků. ###!!! Předpokládám, že seznam poboček bude mnohem větší, takže cokoli pod 50000 můžu považovat za chybu. ###!!! Např. 23.2.2019 jsme si stáhli aktuální skutečný CSV soubor, měl 1,67 MB a 6340 řádků. die('To, co jsme stáhli z webu Uloženky, není CSV soubor'); } # Soubor obsahuje signaturu UTF-8. $csv =~ s/^[\x{FFFE}\x{FEFF}]//; my @radky = split(/\r?\n/, $csv); print STDERR ("Nalezeno ", scalar(@radky), " řádků.\n"); my @zaznamy; my $n_sloupcu; foreach my $radek (@radky) { # Přidat na konec řádku středník, abychom mohli předpokládat, že každé pole končí středníkem. $radek .= ';'; my @pole; while(length($radek)>0) { # První možnost: první pole aktuálního řádku je prázdné. if($radek =~ s/^;//) { push(@pole, ''); } # Druhá možnost: pole je neprázdné, hodnota neobsahuje středník a není uzavřena do uvozovek. elsif($radek =~ s/^([^"][^;]*);//) { push(@pole, $1); } # Třetí možnost: hodnota je uzavřena do uvozovek a neobsahuje uvozovky; může být i prázdná. elsif($radek =~ s/^"([^"]*)";//) { push(@pole, $1); } # Pokud je v regulárních výrazech výše chyba, nebo pokud je chyba v datech (neuzavřené uvozovky, popř. nějaký mechanismus pro uvozovky uvnitř uvozovek), nevíme, co dělat. else { die("Nelze rozebrat řádek '$radek'"); } } push(@zaznamy, \@pole); if(!defined($n_sloupcu)) { $n_sloupcu = scalar(@pole); } elsif(scalar(@pole)!=$n_sloupcu) { print STDERR ("VAROVÁNÍ: První řádek měl $n_sloupcu sloupců, ale aktuální řádek má ", scalar(@pole), " sloupců.\n"); } } print STDERR ("Úspěšně přečteno ", scalar(@zaznamy), " záznamů po $n_sloupcu sloupcích.\n"); # Převést načtený soubor na pole hashů. První řádek obsahuje názvy polí. my @nazvy_poli = @{shift(@zaznamy)}; my @hashe; foreach my $zaznam (@zaznamy) { my %hash; for(my $i = 0; $i <= $n_sloupcu; $i++) { $hash{$nazvy_poli[$i]} = $zaznam->[$i]; } push(@hashe, \%hash); } print STDERR ("Převedeno na ", scalar(@hashe), " hashů.\n"); print STDERR (join(', ', @nazvy_poli), "\n"); # Připojit se k databázi na kub.cz. print STDERR ("Připojuji se k databázi obchod...\n"); my $db = sitesql::connect_obchod('web_hrejsi_obchod'); # Vyprázdnit tabulku, do které budeme vkládat. Ponechat jen prázdnou strukturu. $db->do('TRUNCATE TABLE `ulozenka_branches`;'); # Potřebujeme vědět, která pole mají číselné hodnoty, protože se do dotazů SQL vkládají bez uvozovek. # Podle naší definice příslušné tabulky na kub.cz jsou číselná tato pole: my @ciselna_pole = qw(branch_id active preparing partner transport_service_id card_payment standard_consignment backward_consignment); # Nastrkat nové řádky do databáze obchod do tabulky ulozenka_branches. foreach my $zaznam (@hashe) { dzsql::insert($db, 'ulozenka_branches', { values => $zaznam, ifields => \@nazvy_poli, nfields => \@ciselna_pole }); print STDERR ($dzsql::dotaz, "\n"); }