>> wybierz styl >> es :: ns :: bs

Weblog Tomasza Przechlewskiego [Zdjęcie T. Przechlewskiego] [[Ikona]]


scrum
random image [Photo gallery]
Zestawienie tagów
1-wire | 18b20 | 1wire | 2140 | 3rz | alsamixer | amazon | anniversary | antypis | apache | api | arm | astronomy | asus | atom.xml | awk | aws | balcerowicz | balta | bash | berlin | bibtex | bieszczady | biznes | blogger | blogging | blosxom | borne-sulinowo | breugel | bt747 | canon | cedewu | chello | chown | chujowetaśmy | cmentarz | contour | cron | css | csv | curl | d54250wykh | debian | dejavu | dhcp | dht22 | dia | docbook | dom | ds18b20 | dyndns | dynia | ebay | economy | ekonomia | elka | elm | emacs | emacs23 | english | ess | eu | excel | exif | exiftool | f11 | fc | fc11 | fc15 | fc5 | fc8 | fedora | fedora21 | fenix | ffmpeg | finepix | firefox | flickr | fontforge | fontspec | fonty | fop | foto | france | francja | fripp | fuczki | fuji | fuse | gammu | garmin | gawk | gazwyb | gdynia | geo | georgia | gft | git | github | gmail | gnokii | gnus | google | googlecl | googleearth | googlemaps | gphoto | gphoto2 | gps | gpsbabel | gpsphoto | gpx | gpx-viewer | greasemonkey | gruzja | grzyby | haldaemon | handbrake | historia | history | hitler | holocaust | holokaust | hpmini | humour | iblue747 | ical | iiyama | ikea | imap | inkscape | inne | internet | j10i2 | javascript | jhead | k800i | kamera | kleinertest | kml | kmobiletools | knuth | kod | kolibki | komorowski | konwersja | krutynia | kuchnia | kurski | latex | latex2rtf | latex3 | lcd | legend | lenny | lesund | lewactwo | liberation | linux | lisp | lisrel | litwa | logika | ltr | lwp | m2wś | mapsource | marvell | math | mathjax | mazury | mbank | mediolan | mencoder | mh17 | michalak | microsoft | monitor | mp4box | mplayer | ms | msc | msw | mtkbabel | museum | muzyka | mymaps | mysql | nanopi | natbib | navin | neo | neopi | netbook | niemcy | niemieckie zbrodnie | nikon | nowazelandia | nuc | nxml | oauth | oauth2 | obituary | okular | olympus | ooffice | ooxml | opera | otf | otftotfm | other | overclocking | panoramio | pdf | pdfpages | pdftex | pdftk | perl | photo | photography | picasa | picasaweb | pim | pine | pit | plotly | pls | plugin | po | politics | polityka | polsat | postęp | powerpoint | prelink | problem | propaganda | pstoedit | putin | python | r | radio | random | raspberry pi | refugees | relaxng | ridley | router | rower | rowery | rpi | rsync | rtf | ruby | rugby | russia | rwc | rwc2007 | rwc2011 | rzym | samba | sem | sheevaplug | sienkiewicz | signature | sks | skype | skytraq | smoleńsk | sqlite | srtm | ssl | statistics | stats | statystyka | stix | svg | svn | swornegacie | szwajcaria | terrorism | tex | texgyre | texlive | thunderbird | tomato | tourism | tramp | trang | truetype | ttf | turystyka | tusk | tv | tv5monde | twitter | typetools | ubuntu | uchodźcy | udev | umap | unix | upc | updmap | ups | utf8 | varia | video | vienna | virb edit | vostro | wammu | wdc | wdfs | webcam | webdav | wh2080 | wiedeń | wikicommons | wilno | windows | windows8 | wine | wioślarstwo | word | wordpress | wrt54gl | ws1080 | wtyczka | ww2 | www | wybory | wybory2015 | włochy | xemex | xetex | xft | xhtml | xine | xml | xmllint | xsd | xslt | xvidtune | youtube | yum | zakopane | zakupy | zdf | łeba | świdnica
Pobrania via google: [[Ikona]]
Archiwum
Inne blogi
N. Walsh | Morten H. Frederiksen | B. Clementson | prawo.vagla.pl | F. Hecker | M. Olson | J. Tennison | J. Clark | M. Nottingham | M. Shuttleworth | T. Isakowicz-Zalewski | J. Anglim | José A. Ortega Ruiz Modern Perl
Inne tematyczne
Ashwin Amanna | wiesia.nets.pl | Wojt | rwm.org.pl | DataBlog | Revolutions | Learning R | A. Gelman | C. Nel | J. Vogelgesang | ubl.xml.org/ | J.D. Long |
O stronie
wykorzystywany jest blosxom plus następujące wtyczki: tagging, flatarchives, rss10, lastbuilddatexhtmlmime. Niektóre musiałem dopasować nieco do swoich potrzeb. Więcej o blosxom jest tutaj
Subskrypcja
RSS 1.0
Publikowanie z bazy danych

Absolutnie minimalistyczny przykład wykorzystania LaTeXa do publikowania zawartości bazy danych:

1. Dane są w bazie sqlite (można ją utworzyć/dodawać rekordy w prosty sposób wykorzystując coś co się nazywa sqlitebrowser)

W przykładzie (poniżej) plik kleinertest.db3 zawiera tabelę Kursanci, z której pobierane są pola ImieNazwisko, PlecOcena.

2. Do drukowania uruchamiamy skrypt w języku Perl. Skrypt jest tak prosty że do dopasowania go do konkretnej tabeli nie potrzeba znajomości Perla a wystarczy zdrowy rozsądek (co zmienić zaznaczono @@)

Perl dla Windows do pobrania z https://www.activestate.com/

3. Skrypt uruchamia pdflatexa i drukuje zawartość bazy do pliku pdf

4. Można skomplikować skrypt, np podając argument na wejściu. Dajmy na to nazwisko delikwenta do wydrukowania. Żeby nie drukować wszystkiego. Do tego potrzeba minimalnej znajomości Perla

#!/usr/bin/perl -w
# Potrzebne są moduły Perla DBI DBD-SQLite DBD-SQLite2
#
use strict;
use utf8;
use DBI;

binmode(STDOUT, ":utf8");

my $dbfileName= "kleinertest.db3"; ## @@ nazwa pliku z bazą
my $tmpfileName = "kleinertest.tex"; ## @@ nazwa pliku .tex
my $dbh = DBI->connect("dbi:SQLite:dbname=$dbfileName", "", "");

## @@ Pobranie danych z tabeli Kursanci (pola: ImieNazwisko, Plec Ocena)
my $sth = $dbh->prepare("SELECT
   ImieNazwisko,
   Plec,
   Ocena
   FROM Kursanci ");
$sth ->execute();

## PreAmBuła ### ### ### ### ###
open (TEX, ">$tmpfileName");

print TEX "\\documentclass{article}\\usepackage{mydbiprint}\\begin{document}\n";

## MidBuła: drukowanie rekordów z bazy ## ### ### ###
## ImieNazwisko = $r[0], Plec = $r[1], Ocena = $r[2] itd...
while ( my @r = $sth->fetchrow_array() ) {
     print TEX "\\Dyplom{ $r[0] }{$r[1]}{ $r[2] }\n"; ## @@ dopasować do konkretnej tabeli
   }

## PostAmBuła ## ### ### ### ###
print TEX "\\end{document}\n";

$dbh->disconnect || warn "Nie moge zamknac bazy $dbfileName\n";

## TeXowanie pliku: ## ## ### ### ### ### ###
close(TEX);
system("pdflatex", "$tmpfileName");

## koniec 

Przykładowy pakiet mydbiprint.sty:

%% Minimalistyczny szablon do drukowania z bazy
\RequirePackage[utf8]{inputenc}
\RequirePackage{polski}
\RequirePackage{ifthen}
\pagestyle{empty}
\newcommand{\Dyplom}[3]{%%
  \begin{center}\fontsize{30}{40}\selectfont DYPLOM\end{center}
    \ifthenelse{\equal{#2}{K}}
               {\DyplomDlaPani{#1}{#3}}
               {\DyplomDlaPana{#1}{#3}}
 }
\newcommand\DyplomDlaPani[2]{%
   \begin{center}Pani #1\end{center}
  Zdała egzamin z oceną #2\newpage}
\newcommand\DyplomDlaPana[2]{\begin{center}Pan #1\end{center}
    Zdał egzamin z oceną #2\newpage}
\endinput 
url | Fri, 02/06/2017 04:38 | tagi: , , ,
Pobieranie twitów za pomocą Perla i API Twittera

Poniższy skrypt Perlowy służy do pobierania najnowszych twitów (Tweets) użytkowników identyfikowanych poprzez ich screen_name. Twity są dopisywane do bazy, która jednocześnie pełni rolę pliku konfiguracyjnego. Przykładowo, aby twity użytkownika maly_wacek były dodane do bazy należy wpisać do niej wpis (w dowolnym miejscu, dla porządku najlepiej na początku):

INIT;maly_wacek;;INIT

Ściśle rzecz biorąc po pierwszym dodaniu do bazy, powyższy wpis jest już niepotrzebny, ale też nie przeszkadza. Baza jest zapisywana w taki sposób, że najnowszy tweet każdego użytkownika jest na końcu, zatem po przeczytaniu pliku, w wyniku przypisania $Users{$tmp[1]} = $tmp[0] (por. poniżej), hash %Users zawiera wszystkich użytkowników oraz id_str ich ostatnio pobranego twita. Zapewne niespecjalnie optymalny sposób archiwizacji, ale prosty i działa:

#!/usr/bin/perl
use Net::Twitter;

# Z UTF8 w Perlu jest zawsze problem:
use open ":encoding(utf8)";
use open IN => ":encoding(utf8)", OUT => ":utf8";

my $timelineBase = "timelines.log";

if ( -f "$timelineBase" ) {

   open (BASE,  $timelineBase) ||
      die "Cannot open: $timelineBase";

   while (<BASE>) { chomp();
      @tmp = split /;/, $_;
      $Users{$tmp[1]} = $tmp[0]; # last id_str
   }
}

close (BASE) ;

## ###  ####

open (BASE,  ">>$timelineBase") ;

my $nt = Net::Twitter->new(legacy => 0);

my $nt = Net::Twitter->new(
   traits   => [qw/API::RESTv1_1/],
   consumer_key        => "######",
   consumer_secret     => "######",
   access_token        => "######",
   access_token_secret => "######", );

foreach $user ( keys %Users ) {
   my @message ; my $screen_name = $user ;
   my $result ;

   if ( $Users{$user} eq 'INIT' ) {
     ## max ile się da, wg dokumentacji 3200
     $result = $nt->user_timeline({
       screen_name => $screen_name, count=> '3200' })
   }
   else {
     $result = $nt->user_timeline({
       screen_name => $screen_name, 
         since_id => $Users{$user}, });
   }

   foreach my $tweet ( @{$result} ) {
      $text_ = $tweet->{text} ;
      $text_ =~ s/;/\,/g; $text_ =~  s/\n/ /g;
      $date_ = $tweet->{created_at} ;
      push ( @message, $tweet->{id_str} .  ";" \
         . "$screen_name;$date_;$text_" );
   }

   ## Drukuj posortowane:
   my $tweetsC;
   foreach my $tweet ( sort (@message) ) {
      $tweetsC++ ; print BASE $tweet . "\n"; }
   if ( $tweetsC > 0 ) {
       print STDERR "fetched $tweetsC for $screen_name\n"; }
}

close (BASE)

Uwaga: poprzez API można pobrać twity użytkowników, którzy zablokowali nam możliwość oglądania ich konta (inna sprawa po co oglądać takiego palanta).

Utworzenie aplikacji na apps.twitter.com

Należy się zalogować na stronie apps.twitter.com/. Kliknąć Create New App.

Wybrać Name (np. tprzechlewski.app), Description, Website i Callback URL.

Wybrać Keys and Access Tokens i pobrać wartości: Consumer Key oraz Consumer Secret.

Przewinąć zawartość strony i wybrać Create my access token. Zostaną wygenerowane Access Token oraz Access Token Secret, które także należy pobrać.

Na potrzeby wyżej opisanego skryptu to wystarczy. Pobrane wartości wstawiamy w miejsca oznaczone jako ######

Instalowanie Net::Twitter

Na jednym z moich komputerów ciągle działa dość archaiczna wersja Debiana Lenny:

$ cat /proc/version
Linux version 2.6.32-5-kirkwood (Debian 2.6.32-30)

$ cat /etc/issue
Debian GNU/Linux 5.0 \n \l

$ perl --version
This is perl, v5.10.0 built for arm-linux-gnueabi-thread-multi
Copyright 1987-2007, Larry Wall

Z poważnym obawami, że się uda spróbowałem:

cpan> install Net::Twitter
Strange distribution name

Pomaga (por. tutaj):

cpan> install IO::AIO 

Potem:

cpan> install YAML
cpan> install Net::Twitter

Ściąga się milion pakietów. Przy testowaniu Net-HTTP-6.09 system zawisł na etapie t/http-nb.t (pomogło Ctr-C), ale finał był pomyślny, tj. Net::Twitter został zaistalowany.

Mój inny system jest już nowszy a instalacja Net::Twitter bezproblemowa:

$ cat /etc/issue
Fedora release 21 (Twenty One)
  
$ perl --version
This is perl 5, version 18, subversion 4 (v5.18.4) built for x86_64-linux-thread-multi
(with 25 registered patches, see perl -V for more detail)
Copyright 1987-2013, Larry Wall

$ yum install perl-Net-Twitter

Automatyzacja

Teraz wystarczy umieścić w crontab na przykład taki wpis:

# 48 min po północy codziennie
48 0 * * * /home/tomek/bin/twitter.sh 

Co zawiera twitter.sh jest oczywiste

url | Tue, 01/12/2015 08:16 | tagi: , ,
Weight of RWC players

Scrapping various Web pages I managed to gather data on players participating in last 4 Rugby World Cups. Is there a trend in body mass of rugby players participating in RWC tournaments?

Using Plotly API via Perl script (described here Box-plot chart with plot.ly and Perl API) I can quickly plot series of boxplots:

# cpan install WebService::Plotly in case  WebService::Plotly is not installed
plotly_boxplot.pl -col=5 -by=0 -title='RWC players by weight' -sep=';' rwc1999-2015.csv

Resulting boxplots and data can be viewed here.

url | Tue, 29/09/2015 16:53 | tagi: , , , , ,
Konwersja Excela na CSV

Jak to z Microsoftem bywa nie jest łatwo. Są dwa formaty Excela -- stary (.xls) oraz nowy (.xlsx). Pakiety Perlowe Spreadsheet::Excel oraz Spreadsheet::ParseXLSX radzą sobie nieźle, aczkolwiek oczywiście gwarancji nie ma i być nie może skoro sam Excel czasami siebie samego nie potrafi zinterpretować.

No ale jest jeszcze trzeci format: jak plik .xlsx jest zabezpieczone hasłem (password protected). I na taką okoliczność nie ma zbyt wielu narzędzi. Można wszakże problem rozwiązać w dwóch krokach korzystając Libreoffice, który potrafi interpretować pliki Excela i można go uruchomić w trybie batch:

#!/bin/bash
XLS="$1"
TMP="${XLS%.*}.xlsx"
libreoffice --headless --convert-to xlsx "$XLS" --outdir ./xlsx-temp/
perl xslx2csv.pl ./xlsx-temp/"$TMP" "$OUTFILE"

Powyższy skrypt obsłuży wszystkie rodzaje plików Excela, zamieniając je najpierw na plik w formacie XLSX (plik password protected zostanie zmieniony na prawdziwy format XLSX, interpretowalny przez np. Spreadsheet::ParseXLSX).

Można od razu konwertować do CSV (--convert-to csv), ale konwersji będzie podlegać tylko pierwszy arkusz. Jak interesuje nas na przykład drugi, to kicha... nie da się (a przynajmniej ja nie wiem jak to osiągnąć). Inny problem to zamiana XLSX→XLSX -- nie ma w LibreOffice możliwości określenia nazwy pliku wynikowego, a próba:

libreoffice --headless --convert-to xlsx plik.xlsx

Kończy się błędem. Na szczęście jest obejście w postaci opcji --outdir. Plik wyjściowy -- o tej samej nazwie co wejściowy -- jest zapisywany w innym katalogu i problem rozwiązany.

Po zamianie Excela na ,,kanoniczny'' XLSX do konwersji na CSV można wykorzystać następujący skrypt Perla:

#!/usr/bin/perl
# Wykorzystanie perl xslx2csv.pl plik.xslx [numer-arkusza]

use Spreadsheet::ParseXLSX;
use open ":encoding(utf8)";
use open IN => ":encoding(utf8)", OUT => ":utf8";

$xslxfile = $ARGV[0]; 
$ArkuszNo = $ARGV[1] || 1; ## domyślnie arkuszu 1

my $source_excel = new Spreadsheet::ParseXLSX;
my $source_book = $source_excel->parse("$xslxfile")
  or die "Could not open source Excel file $xslxfile: $!";

# Zapisuje zawartość wybranego arkusza do hasza %csv
my %csv = ();

foreach my $sheet_number (0 .. $source_book->{SheetCount}-1) {
  my $sheet = $source_book->{Worksheet}[$sheet_number];

  print STDERR "*** SHEET:", $sheet->{Name}, "/", $sheet_number, "\n";
  if ( $ArkuszNo ==  $sheet_number + 1 ) {

    next unless defined $sheet->{MaxRow};
    next unless $sheet->{MinRow} <= $sheet->{MaxRow};
    next unless defined $sheet->{MaxCol};
    next unless $sheet->{MinCol} <= $sheet->{MaxCol};

    foreach my $row_index ($sheet->{MinRow} .. $sheet->{MaxRow}) {
       foreach my $col_index ($sheet->{MinCol} .. $sheet->{MaxCol}) {
          my $source_cell = $sheet->{Cells}[$row_index][$col_index];
	  if ($source_cell) {
	    $csv{$row_index}{$col_index} = $source_cell->Value;
	  }
       }
    }
  }
}

Arkusz jest w haszu %csv. Jak go przekształcić/wydrukować itp. pozostawiam inwencji ewentualnego czytelnika.

url | Wed, 08/07/2015 20:19 | tagi: , , ,
Wysyłanie posta na blogger.com z wykorzystaniem Google API

GoogleCL przestało działać, bo Google przestało obsługiwać wersję OAuth 1.0. Ponadto, wygląda na to, że dostosowanie tego użytecznego narzędzia do wersji OAuth 2.0 bynajmniej nie jest trywialne na co wskazują liczne (ale do tej pory bezskuteczne) prośby i wołania o aktualizację GoogleCL, które można znaleźć w Internecie.

Ponieważ poszukiwania w miarę podobnego zamiennika zakończyły się niepowodzeniem, nie pozostało nic innego zmajstrować coś samodzielnie. Autoryzację OAuth 2.0 mam już opanową -- obsługuje ją Pythonowy skrypt oauth2picasa.py. (Skrypt jest (zapożyczonym) fragmentem z projektu picasawebsync). Wystarczyło dorobić następujący prosty skrypt Perlowy (por. także: Publishing a blog post):

#!/usr/bin/perl
# *** Wyslanie posta na blogger.com ***
use strict;
use LWP::UserAgent;
use XML::LibXML;
use Getopt::Long;

my $profileID="default";
my $blogID = '1928418645181504144'; # Identyfikator bloga
my $blog_entry ;

## Na wypadek gdy ktoś ma kilka blogów moża podać na któr
## ma być wysłany post używając opcji -blog
GetOptions( "blog=s" => \$blogID, "post=s" => \$blog_entry) ;

if ( $blog_entry eq '' ) {
print STDERR "*** USAGE: $0 -b blog -p message (-b is optional) ***\n" }

## sprawdź czy post jest well formed:
my $parser = XML::LibXML->new();
eval {my $res_  = $parser->parse_string($blog_entry) };
if ($@) { die "*** Error parsing post message! \n"; }

my $ACCESS_TOKEN=`oauth2blogger.py`; # pobierz ACCESS_TOKEN
print STDERR "*** AccessToken: $ACCESS_TOKEN ***\n";

my $req = HTTP::Request->new(
  POST => "https://www.blogger.com/feeds/$blogID/posts/default");

$req->header( 'Content-Type' => 'application/atom+xml' );
$req->header( 'Authorization' => "Bearer $ACCESS_TOKEN" );
$req->header( 'GData-Version' => '2' );

$req->content($blog_entry);

my $ua = LWP::UserAgent->new;
my $res = $ua->request($req);

# Jeżeli coś jest nie tak poniższe drukuje verbatim:
# http://www.perlmonks.org/bare/?node_id=464442
# $ua->prepare_request($req); print($req->as_string); exit ;

if ($res->is_success) {
   my $decoded_response = $res->decoded_content;
   print STDERR "*** OK *** $decoded_response\n"; }
else { die $res->status_line; }

Wykorzystanie:

perl blogger_upload.pl -p 'treść-posta'

Treść posta musi być oczywiście w formacie xHTML i zawierać się wewnątrz elementu content, który z kolei jest wewnątrz elementu entry. Element entry zawiera także title określający tytuł posta, oraz elementy category zawierające tagi. Przykładem może być coś takiego:

<entry xmlns='http://www.w3.org/2005/Atom'>
 <title type='text'>Marriage!</title>
 <content type='xhtml'>
    <div xmlns="http://www.w3.org/1999/xhtml">
      <p>Mr. Darcy has proposed marriage to me!</p>
      <p>He is the last man on earth I would ever desire to marry.</p>
      <p>Whatever shall I do?</p>
    </div>
  </content>
  <category scheme="http://www.blogger.com/atom/ns#" term="marriage" />
  <category scheme="http://www.blogger.com/atom/ns#" term="Mr. Darcy" />
</entry>

Opisany skrypt jest tutaj: blogger_upload.pl.

url | Wed, 08/07/2015 17:48 | tagi: , , , , ,
Afera madrycka: taka tam analiza wyjazdów posłów 7 kadencji

UWAGA: Ten tekst nie jest o polityce ale o [elementarnej] statystyce.

Media informowały, że posłowie PiS Adam Hofman, Mariusz A. Kamiński i Adam Rogacki wzięli na podróż do Madrytu na posiedzenie komisji Zgromadzenia Parlamentarnego Rady Europy po kilkanaście tysięcy złotych zaliczki, zgłaszając wyjazd samochodem; w rzeczywistości polecieli tanimi liniami lotniczymi. Ponieważ kontrola wydatków posłów jest iluzoryczna różnica pomiędzy kosztem podróży samochodem a samolotem [za dużo mniejsze pieniądze] miała stanowić dodatkowy przychód wyżej wymienionych. Według prokuratury, która wszczęła śledztwo, zachodzi podejrzenie popełnienia oszustwa.

Łapiąc wiatr w żagle [sprawa się upubliczniła tuż przed ostatnimi wyborami samorządowymi] koalicja rządząca w osobie Marszałka Sejmu RP Sikorskiego zarządziła audyt, którego efektem było udostępnienie m.in. dokumentu pn. Wyjazdy zagraniczne posłów VII kadencja (kopia jest tutaj).

Jak przystało na kraj, w którym od lat działa Ministerstwo cyfryzacji zestawienie jest w formacie PDF, zatem pierwszym ruchem była zamiana na coś przetwarzalnego. Wpisanie w google PDF+Excel+conversion skutkuje ogromną listą potencjalnych konwerterów. Bagatelizując skalę problemu spróbowałem dokonać konwersji narzędziami dostępnymi on-line, ale z marnym rezultatem (za duży dokument przykładowo; serwis za free jest tylko dla PDFów mniejszych niż 50 stron). W przypadku Convert PDF to EXCEL online & free coś tam skonwertował, nawet wyglądało toto na pierwszy rzut oka OK ale na drugi już nie: dokument niekompletny oraz nieprawidłowo zamienione niektóre liczby (przykładowo zamiast 837,50 zł w arkuszu jest 83750 -- 100 razy więcej!).

Ostatecznie skończyło się na ściągnięciu 30 dniowej wersji Adobe Acrobata Pro XI, który faktycznie sprawdził się w roli konwertera PDF→XLSX. Do konwersji wykorzystałem służbowego laptopa Elki wyposażonego w legalny Office 2010, na którym zainstalowałem ww. AA Pro XI. OOffice niby czyta XLSX, ale z koszmarnymi błędami, więc żeby dalej móc obrabiać arkusz w Linuksie wczytałem wynikowy XLSX do Excela 2010 po czym zapisałem go w (starszym) formacie XLS. Ten plik wyświetlił się w OO Calcu bez problemu.

Arkusz jest tak sformatowany, że 4 pierwsze komórki oraz są często wielowierszowe i scalone, zawierają bowiem liczbę porządkową, datę, miejsce i cel wyjazdu delegacji posłów. Po zamianie na plik CSV zawartość komórek scalonych pojawi się w pierwszym wierszu, a pozostałe będą puste. Prostym skryptem Perlowym mogę wypełnić puste komórki wg. algorytmu: jeżeli cztery pierwsze pola są puste, to skopiuj wartości ostatnich niepustych:

if ($tmp[0] eq '' && $tmp[1] eq '' && $tmp[2] eq '' && $tmp[3] eq '' ) { ... }

Pierwszy problem: wielowierszowe komórki z kolumn 1--4 nie zawsze są scalone. Czasem tekst jest podzielony na wiersze co psuje konwersję. Ręcznie scalam niescalone komórki (trochę to trwa). Przed scaleniem usuwam z kolumn 1--4 końce wiersza.

Drugi problem: część liczb nie jest liczbami z uwagi na użycie separatora tysięcy, który się zamienił w PDFie na odstęp (spację). Zatem zaznaczam kolumny zawierające różne pozycje kosztów po czym:

Edytuj→Znajdź i zamień
usuwam odstępy, tj. zamieniam spację na pusty napis
Format→Komórki
wybieram numer z dwoma miejscami po przecinku.

Po uporządkowaniu arkusza, zapisuję go w formacie CSV. Następnie prostym skryptem Perlowym zamieniam na taki plik CSV, w którym puste komórki są wypełniane zawartością z poprzednich wierszy. Kolumna Państwo - miasto jest kopiowana. Kopia jest zmieniana na jednoznaczne: Państwo, miasto (pierwszy-kraj, przecinek, pierwsze miasto z listy celów podróży -- żeby geokoderowi było łatwiej.)

Innym skryptem Perlowym dodaję do pliku CSV 3 kolumny, które zawierają:

  1. współrzędne celu podróży (w tym celu zamieniam adres Państwo, miasto na współrzędne geograficzne korzystając z geokodera Google);

  2. odległość w kilometrach pomiędzy punktem o współrzędnych 21.028075/52.225208 (W-wa, Wiejska 1) a celem podróży (obliczoną przy wykorzystaniu pakietu GIS::Distance);

  3. linię zdefiniowana w formacie KML o końcach 21.028075/52.225208--współrzędne-celu-podróży (do ewentualnego wykorzystania z Google Fusion Tables).

#!/usr/bin/perl
#
use Storable;
use Google::GeoCoder::Smart;
use GIS::Distance;

$geo = Google::GeoCoder::Smart->new();

my $gis = GIS::Distance->new();

my $GeoCodeCacheName = 'geocode.cache';
my $NewCoordinatesFetched=0; # global flag
my $SLEEP_TIME = 2 ;
my $coords_okr = "21.028075,52.225208"; # Warszawa = środek świata

my %GeoCodeCache = %{ retrieve("$GeoCodeCacheName") } if ( -f "$GeoCodeCacheName" ) ;
my ($wwa_lng, $wwa_lat) = split (",", $coords_okr);
my $linesNo = 0 ;
my $GCtotaluse = 1; # laczna liczba wywolan geocodera

while (<>) {
  $linesNo++;
  chomp();  $_ =~ s/[ \t]+;[ \t]+/;/g; ## usuń ew. niepotrzebne spacje

  @line = split ";", $_;  print STDERR "**$linesNo = $line[3] ... ";

  # geokodowanie (uwaga na limit) 
  # Poprawki dla miejsc, których nie zna Google:
  $line[3] =~ s/Erewań/Erywań/; ## 
  $line[3] =~ s/Sowayma/Madaba/; ## najbliższe miasto
  $line[3] =~ s/Bołszowce/Iwano-Frankiwsk/; ## najbliższe miasto

  my $coords = addr2coords( $line[3] );

  ($tmp_lat, $tmp_lng, $gcuse) = split " ", $coords;
  if ($gcuse > 0) {$GCtotaluse++ ; }

  $distance = $gis->distance($tmp_lat,$tmp_lng => $wwa_lat,$wwa_lng );
  $distance_t = sprintf ("%.1f", $distance);

  my $kml_line = "<LineString><coordinates>$tmp_lng,$tmp_lat $coords_okr</coordinates></LineString>";
  print "$_;\"$coords\";$distance_t;\"$kml_line\"\n";
  print STDERR "\n";

  if ($GCtotaluse % 100 == 0 ) {# store every 100 geocoder calls
    store(\%GeoCodeCache, "$GeoCodeCacheName");
    print STDERR "\n... Cache stored. ***\n";    
  }
}

##
store(\%GeoCodeCache, "$GeoCodeCacheName");

## ## ## ####
sub addr2coords {
 my $a = shift ;
 my $r = shift || 'n';
 my ($lat, $lng) ;
 my $GCuse = 0;

 ##consult cache first
 if (exists $GeoCodeCache{"$a"} ) {
   print STDERR "Coordinates catched ... $a ";
   ($lat,$lng) = split (" ", $GeoCodeCache{"$a"} );
 }
 else {
   print STDERR "Geocoding ... $a ";
   my ($resultnum, $error, @results, $returncontent) = $geo->geocode("address" => "$a");
   $GCuse = 1;
   sleep $SLEEP_TIME; ## make short pause

   $resultnum--; 
   $resultNo=$resultnum ;

   if (resultNo > 0) { print STDERR "** Location $a occured more than once! **" }
   if ($error eq 'OK') {
     $NewCoordinatesFetched=1;
     for $num(0 .. $resultnum) {
       $lat = $results[$num]{geometry}{location}{lat};
       $lng = $results[$num]{geometry}{location}{lng};
       ##print "*** LAT/LNG:$lat $lng ERROR: $error RES: $resultNo ***\n";
     }

     $GeoCodeCache{"$a"} = "$lat $lng"; ## store in cache

   } else { print STDERR "** Location $a not found! due to $error **"  }
 }


 if ($r eq 'r' ) { return "$lng,$lat,$GCuse"; } # w formacie KML
 else { return "$lat $lng $GCuse"; }
}

Gotowy plik CSV zawierający zestawienie podróży jest dostępny tutaj.

Na podstawie zestawienia i z użyciem pakietu ggplot2 generują się takie oto śliczne wykresy.

Wszystkie podróże z zestawienie (N=1874; odpowiednio: koszt łączny, koszt transportu, długość w tys km):

Tylko podróże dla których koszt transportu był niezerowy (N=1423; odpowiednio: koszt łączny, koszt transportu, długość w tys km):

Poniższy skrypt R sumuje i drukuje wszystkie podróże każdego posła:

require(plyr)

d <- read.csv("W7RR_podroze_by_podroz1.csv", sep = ';', dec = ",",  header=T, na.string="NA");

# Dodaj kolumnę której wartości to konkatenacja: "Poseł|Klub"
d[,"PosKlub"] <- do.call(paste, c(d[c("Posel", "Klub")], sep = "|"));

# Usuń wszystko za wyjątkiem tego co potrzeba:
d <- d[ c("PosKlub", "Klacznie", "Ktransp", "Dist") ];

# Sumowanie po PosKlub 
PSums <- as.data.frame ( ddply(d, .(PosKlub), numcolwise(sum)) );

# Z powrotem rozdziel kolumnę "Poseł|Klub" na dwie
PSums <- as.data.frame ( within(PSums, PosKlub <-data.frame( do.call('rbind', 
   strsplit(as.character(PosKlub), '|', fixed=TRUE))))  )

# Drukuj 
PSums;

Z pliku .Rout kopiuję zestawienie łącznych wydatków posłów oraz łącznej pokonanej przez nich odległości:

       PosKlub.X1 PosKlub.X2 KlacznieT  KtranspT    DistT
1 Adam Abramowicz        PiS   4.02599   2.64595   1.3153
2     Adam Hofman        PiS 119.55271  59.53315  26.1716
3   Adam Kępiński        SLD  10.15754   7.93882   3.8069
4   Adam Kępiński         TR  12.63098   8.02327   2.2107
...

Uwaga: kilkanaście nazwisk się powtarza ponieważ posłowie zmienili przynależność klubową w czasie trwania kadencji [Aby uwzględnić takich posłów sumowanie odbywało się po wartościach zmiennej zawierającej połączone napisy Poseł|Klub.]

Na podstawie takiego z kolei zestawienia i znowu z użyciem ggplot2 generują inne śliczne wykresy.

Uwaga: sumowane tylko podróże, dla których koszt transportu był niezerowy (N=1423; odpowiednio: koszt łączny, koszt transportu, długość w tys km):

Link do tabeli zawierającej zestawienie podróży w formacie Google Fusion Tables jest tutaj.

Dane + skrypty dostępne są także w: github.com/hrpunio/Data.

url | Tue, 09/12/2014 19:09 | tagi: , , , , , , ,
Flickr zmienił API

Wycieczka do Swornychgaci spowodowała m.in. konieczność dopasowania moich starych skryptów Perla służących do obsługi Flickra.

Flickr zmienił bowiem niedawno API przechodząc na SSL. Zapewne nowa wersja modułu Flickr-API tą zmianę uwzględnia, ale można też rozwiązać sprawę dodając stosowny parametr do starych skryptów. Konkretnie poniższy wiersz:

my $api = new Flickr::API({'key' => $api_key, 'secret' => $shared_secret, });

należy uzupełnić o parametr rest_uri, tj:

my $api = new Flickr::API({'key' => $api_key, 'secret' => $shared_secret,
 'rest_uri' => 'https://api.flickr.com/services/rest/' });

Podobnie niewielkich modyfikacji wymaga skrypt służący do wysyłania zdjęć (moduł Flickr-Upload):

my $ua = Flickr::Upload->new( {'key' => $api_key, 'secret' => $shared_secret,
          'uri' => 'https://up.flickr.com/services/upload/' } );

W tzw. międzyczasie zmieniła się też nieco metoda flickr.photos.geo.setLocation:

 #if ( $response->{success} ) { ## przestało działać 
  unless ( $response->{error_code} > 0 ) {

W dokumentacji jest napisane: This method has no specific response -- It returns an empty success response if it completes without error.. No to faktycznie jak jest empty to if (EMPTY) { zwraca fałsz i warunek jest źle interpertowany. Poza tą jedną poprawką wszystko inne działa.

url | Tue, 22/07/2014 18:38 | tagi: , ,
Lista argumentów za długa

Ponieważ w przeciwieństwie do MSW w Linuksie długość wiersza poleceń jest absurdalnie duża zapomniałem, że jednak jest skończona:

system ("perl", "clickshop-delete.pl", "-items", join (',', @AllItems)) 

Program clickshop-delete.pl nie jest wykonywany. Żeby ustalić czemu dodaję:

system ("perl", "clickshop-delete.pl", "-items", join (',', @AllItems)) \
== 0 or warn "system failed: $? [$!]\n";

Teraz wiadomo czemu nie działa:

system failed: -1 [Lista argumentów za długa]

Poniższe ustala jak długi może być wiersz poleceń (Debian Lenny na Sheevaplug/ARM):

tomek@neptune:~$ getconf ARG_MAX
131072

Prosty sposób na zmodyfikowanie skryptu z wykorzystaniem splice:

my $max2process=6000; # każdy element @AllItems ma 12 znaków, więc 6000 jest OK
while ( my @items2process = splice @AllItems, 0, $max2process ) {
      system ("perl", "clickshop-delete.pl", "-items", join (',', @items2process)) == \
        0 or warn "system failed: $? [$!]\n";
   }

Powinno działać.

url | Thu, 12/06/2014 20:36 | tagi: ,
Box-plot chart with plot.ly and Perl API

The following Perl script reads data from a CSV file and draws a series of Box-Plots. Usage:

perl plotly_boxplot.pl -col=number -by=number -title=TITLE

where: -col=number -- column number containig variable to plot, -by=number -- column number containig grouping variable.

#!/usr/bin/perl
use WebService::Plotly;
use Getopt::Long;

# login to plotly script
require "$ENV{'HOME'}/bin/login2plotly.pl";

my $plotly = WebService::Plotly->new( un => $plotly_user, key => $plotly_key );

my $sep_sequence = ';';
my $col_number = -1;
my $by_col_number = -1;
my $chart_title='??Chart title??';
my $header='Y';
#my $boxpoints='outliers'; ## or all' | 'outliers' | False
my $USAGE="*** USAGE: -col=i -by=i -title=s -header=s -sep=s FILE *** \n";


# plot values from column 'col' grouped by column 'by'. If header is Y skip first row in data.
# Add title 'title'. Columns in csv data are separated by 'sep' (default ';')
GetOptions("col=i" => \$col_number, "by=i" => \$by_col_number, "title=s" => \$chart_title,
        'header=s' => \$header, 'sep=s' => \$sep_sequence, );
        ##'boxpoints=s' => \$boxpoints ) ;  ## this option not work!

if (($col_number == -1 ) || ($by_col_number == -1) ) { print $USAGE } 

while (<>) { chomp ($_); $nr++;
    if (($nr < 2) << ( $header eq 'Y' ) ) { next }
    $_ =~ s/"//g;
    my @fields = split(/$sep_sequence/, $_);
    push @{$data{$fields[$by_col_number]}}, $fields[$col_number];
    # http://stackoverflow.com/questions/3779213/how-do-i-push-a-value-onto-a-perl-hash-of-arrays
}

my @variants = sort keys %data;

print STDERR "*** No of rows scanned: $nr ***\n";
print STDERR "*** Groups found: @variants ($boxpoints) \n";
for $k (keys %data ) { print "$k"; push (@boxes, { y =>$data{$k}, type => 'box', #'boxpoints' => 'none',
  name => "$k" } ) }

my $layout = { 'title' => $chart_title };

my $response = $plotly->plot(\@boxes, layout => $layout );

my $url = $response->{url};
my $filename = $response->{filename};

print STDERR "*** done: filename: '$filename' url: '$url' ***\n"

Example: Age of Nobel Prize winners by discipline (grouping wariable) plot.ly/~tomasz.przechlewski/28/

url | Mon, 07/04/2014 14:01 | tagi: , , ,
Pobranie zawartości zbioru/grupy zdjęć z flickr.com

Zbiór to set a grupa to pool. Zbiór zawiera zdjęcia jednego użytkownika a grupa (pool) to zbiór zdjęć różnych użytkowników. To tak tytułem wyjaśnienia.

Flickr API zawiera funkcje flickr.groups.pools.getPhotos oraz flickr.photosets.getPhotos, które zwracają informacje o zdjęciach należących do określonego zbioru (albo grupy). Wynik wygląda jakoś tak:

<photoset id="4" primary="2483" page="1" perpage="500" pages="1" total="2">
  <photo id="2484" secret="123456" server="1" title="my photo" isprimary="0" />
  <photo id="2483" secret="123456" server="1" title="flickr rocks" isprimary="1" />
</photoset>

Poniższy skrypt wykorzystujący flickr.groups.pools.getPhotos/flickr.photosets.getPhotos ściąga informacje o zdjęciach dodanych do grupy/zbioru. Wynik zapisuje w Perlowej notacji:

@photos=( {'id'=>"2484", 'secret'=>"123456", 'server'=>"1", 'title'=>"my photo", 'isprimary'=>"0"},
  {'id' =>"2483", 'secret'=>"123456", 'server'=>"1", 'title'=>"flickr rocks", 'isprimary'=>"1", );

Jest to zatem gotowy do dołączenia do innego skryptu np. za pomocą require kod Perla (lista haszy). Ściągana jest informacja o grupie lub zbiorze określonej/określonym przez podanie stosownego id:

flickr_albums.getPhotos.pl -s set-id  
# albo
flickr_albums.getPhotos.pl -p group-id  

Uwaga: moduł login2flickr.rc deklaruje m.in stosowną wartość api_key co jest niezbędne do korzystania z API flickra.

#!/usr/bin/perl
#
use Flickr::API;
use Compress::Zlib;
use Getopt::Long;
use XML::DOM;

require 'login2flickr.rc'; # prywatny moduł do 

$set_id = $pool_id = $method = $Photos='';

GetOptions( "set=s" => \$set_id, "pool=s" => \$pool_id, ) ;

if ( $set_id ne "" ) {
  $root_ele = 'photoset';
  $method = 'flickr.photosets.getPhotos';
  $ofname = "set-${set_id}.ph";
}
elsif ( $pool_id ne "" ) {
  $root_ele='photos';
  $method = 'flickr.groups.pools.getPhotos';
  $ofname = "pool-${pool_id}.ph";
} else {
  die "*** Podaj id zbioru/pula (set-id/pool-id)\n";
}

## ### ### ### ### ###
my $extras = 'date_taken,views,url_o,url_m,geo,tags';

my $api = new Flickr::API({'key' => $api_key, secret => $sharedsecret});
my $parser = XML::DOM::Parser->new();

my $nbrPages = $photoIdx = 0;

do
{ 
  my $params = { per_page => 500, page => $nbrPages+1, extras => $extras };

  $params->{group_id} = $pool_id if $pool_id; 
  $params->{photoset_id} = $set_id if $set_id; 

  ##print STDERR "*** Method/params: $method, $params ***\n";
  my $response = $api->execute_method($method, $params ); 

  die "Problem: $response->{error_message}\n" if !$response->{success}; 

  ## sprawdz czy _content nie jest gzipniety, jezeli to rozpakuj:
  my $content_encoding = $response->{_headers}->{'content-encoding'} ;
  my $plain_content ;

  if ($content_encoding =~ /gzip/ ) {
    $plain_content = Compress::Zlib::memGunzip( $response->{_content});
  } else { $plain_content = $response->{_content};  }

  my $log = $parser->parse($plain_content);

  ## Dane są podzielone na strony o maksymalnej wielkości 500 zdjęć:
  for $ps ( $log->getElementsByTagName( $root_ele ) ) {
      if ($ps->getAttributeNode ("page")  ) { $page = $ps->getAttributeNode ("page")->getValue(); }
      if ($ps->getAttributeNode ("pages") ) { $pages = $ps->getAttributeNode ("pages")->getValue(); }
    }

  print "*** Page $page of $pages ***\n";

  ## dla każdego elementu:
  for $p_ ( $log->getElementsByTagName('photo') ) {
    $element_content='';

    ## zapisz wszystkie atrybuty
    if ($p_ ->getAttributes() !=null){
      $numberAttributes = $p_->getAttributes()->getLength();
    }

    for ($loopIndex =0; $loopIndex < $numberAttributes; $loopIndex++) {
      $attribute = ($p_ -> getAttributes())->item($loopIndex);
      $attrname = $attribute->getNodeName();
      $attrvalue = $attribute->getNodeValue();
      $element_content .= "'$attrname' => '$attrvalue', ";
    }

    $Photos .= "{ $element_content },\n";
    $photoIdx++;
  }

  ++$nbrPages;

} while ($page < $pages );

## ## ###
print STDERR "Writing to $ofname\n";
open (OFILE, ">$ofname"); 
print OFILE "## Created with $method\n\@photos = (\n $Photos \n);\n1;\n";
close OFILE; 

print STDERR "*** $photoIdx photos written to $ofname ***\n";

Skrypt jest do pobrania tutaj.

url | Mon, 23/09/2013 13:07 | tagi: ,
Konwersja z WordPressa do Bloggera

Kol. DM pisze sobie bloga używając WordPressa. Trochę go to kosztuje więc pojawiła się koncepcja żeby przeszedł na bezpłatnego Bloggera. Początkiem tej koncepcji jest oczywiście konwersja WP do formatu Bloggera.

Wpisy kol. DM zawierają tekst i dużo zdjęć oraz innych rysunków. Nie mam bladego pojęcia nt. WordPressa, ale dość szybko ustaliłem, że można wyeksportować treść posługując się stosowną funkcją dostępną z Kokpit→Narzędzia→Eksport (powstaje plik w formacie WordPress eXtended RSS -- WXR).

Plik WXR zapisujemy na dysku. Można go zamienić do formatu Bloggera korzystując z konwertera dostępnego tutaj. Jest wprawdzie napisane, że konwerter obsługuje pliki nie większe niż 1Mb, ale mój miał 4Mb i też poszło.

Plik kolegi DM zawiera tekst oraz prawidłowe linki do niektórych rysunków. Inne rysunki są wstawiane sprytnym czymś co nazywane jest shortcode (cf Shortcode API.) Nie wchodząc w szczegóły, zamiast rysunków w treści postu jest umieszczone np. coś takiego:

[nggallery id=506]

506 z kolei jest identyfikatorem zbioru rysunków, które fizycznie są przechowywane w katalogu:

wp-content/gallery

Każda galeria jest w oddzielnym katalogu, ale nazwami katalogów nie są identyfikatory typu 506 ale coś innego. Logując się do phpMyAdmin byłem w stanie ściągnąć całą bazę (w formacie SQL), w której siedzi WordPress. W jednej z tabel bazy znalazłem przypisanie id_galeriinazwa-katalogu-z-plikami

INSERT INTO `wp_ngg_gallery` (`gid`, `name`, `slug`, 
`path`, `title`, `galdesc`, `pageid`, `previewpic`, `author`) VALUES
(17, 'gottardo_2', '', 'wp-content/gallery/gottardo_2', '', '', 0, 0, 1),
(16, 'gottardo_1', '', 'wp-content/gallery/gottardo_1', '', '', 0, 0, 1),
(15, 'nufenen', '', 'wp-content/gallery/nufenen', NULL, NULL, 0, 0, 1),
... itd ...

Czyli zawartość czegoś, co w treści wygląda jak:

[nggallery id=15]

Znajduje się w katalogu wp-content/gallery/nufenen.

Teraz ściągnąłem cały katalog wp-content na dysk lokalny wykorzystując ncftp

ncftp -u USER -p PASS HOST
get -R -T wp-content

Następnie zamieniłem nazwy plików w następujący sposób:

nr_galerii__nazwa_pliku

Pliki wysłałem na google za pomocą skryptu. Istotne jest to, że skrypt po załadowaniu, zwraca URL zdjęcia pod którym jest ono dostępne na koncie googla:

100__fra_07063.jpg http://lh5.ggpht.com/-26SgLqsS1vM/UhdwT-Q62CI/AAAAAAAAABQ/k_ipaT4SNsE/100__fra_07063.jpg
100__fra_07064.jpg http://lh4.ggpht.com/-1kWivWwiZW4/UhdwU4vZWPI/AAAAAAAAABY/XxuIGrIPj8Q/100__fra_07064.jpg
itd...

Czyli zdjęcie 100__fra_07063.jpg (oryginalnie należące go galerii o identyfikatorze równym '100') jest dostępne pod adresem:

http://lh5.ggpht.com/-26SgLqsS1vM/UhdwT-Q62CI/AAAAAAAAABQ/k_ipaT4SNsE/100__fra_07063.jpg

Uwaga: Album ze zdjęciami na koncie googla może zawierać maksymalnie 1000 zdjęć. Jeżeli zdjęć jest więcej trzeba utworzyć więcej albumów.

Skryptem Perla (wyrażenia regularne/regułowe) zamieniam każde [nggallery id=506] na stosowny ekwiwalent. Przykładowo:

&lt;div id='gid_g509'&gt;
&lt;span&gt;&lt; a href="http://lh5.ggpht.com/-NZ_dEAq8qZI/Uhf_OPG9jiI/AAAAAAAADp8/BtBx9DwVgs4/509__1106_016.jpg" 
 imageanchor="1" style="margin-bottom: 1em; margin-right: .1em;"&gt;
&lt;img border="0" src="http://lh5.ggpht.com/-NZ_dEAq8qZI/Uhf_OPG9jiI/AAAAAAAADp8/BtBx9DwVgs4/s128/509__1106_016.jpg" 
  height='85' /&gt;&lt;/a&gt;
&lt;/span&gt;
 ... itd ...

Pozostałe zdjęcia mają `prawdziwe URLe' (a nie jakieś shortcody), ale oczywiście URLe te są złe bo wskazują na starego hosta. Zdjęcia te (z `prawdziwymi URLami') są przechowywane w katalogu ./wp-content/uploads. Ze zdjeciami postępuję, tak jak w przypadku zdjęć z galerii: 1) wysyłam na konto google skryptem; 2) zmieniam oryginalne URLe na URLe z konta google (skryptem Perla).

Przed importem do Bloggera warto sprawdzić czy plik, który ma być zaimportowany jest well-formed:

xmllint plik-do-zaimportowania.xml

url | Sat, 24/08/2013 21:57 | tagi: , ,
Augmenting video files with GPS data

This post describes in detail how to add GPS data to video file using `visual correlation' (see also: Video geocoding with gpsbabel).

Zebra crossing at Osowa
Crossing at Osowa

There is an easy way to augment video files with GPS data using GPSbabel. Since version 1.4 of GPSBabel is able to create a subtitle file from a GPS tracklog. The subtitle contains latitude/longitude/altitude as well as the time. With a simple Perl scripts I have added current speed (not particularly accurate however).

To convert GPX file to subtitles one have to execute:

gpsbabel -i gpx -f FILE.gpx -o subrip,video_time=hhmmss,gps_time=hhmmss,gps_date=YYYYMMDD -F FILE.srt

Where: video_time -- video position (relative to beginning of video) for which exact corresponding GPS timestamp is known. gps_time -- the time part of the GPS timestamp which corresponds to a known position in the video. gps_date -- the date part of the GPS timestamp which corresponds to a known position in the video.

On a video (see below) you can see that in 34 second I passed the zebra crossing. The zebra's crossing coordinates can be easily identified at Google Maps (cf. picture Crossing at Osowa). Now one have to search the GPX track for the point which is nearest to 54.429591/18.477973. I developed a simple Perl script for that purpose:

$ perl My_GPX_nearest_timestamp.pl   -c 54.429591:18.477973 20130420.gpx
*** USAGE: My_GPX_nearest_timestamp.pl -c latitude:longitude GPX-file
*** Looking for 20 points near: 54.429591:18.477973 (lat/lon) ***
> 15.3758195746663 2013-04-20T10:27:09Z  54.429509640:18.477780819
> 22.0617273294607 2013-04-20T09:05:15Z  54.429701502:18.478256240
> 32.6458959467509 2013-04-20T10:27:15Z  54.429787332:18.478348190
> 43.3771684316959 2013-04-20T09:05:24Z  54.429531014:18.477310427
> 47.7727043140018 2013-04-20T09:05:11Z  54.429905936:18.478475260
> 63.903936892351 2013-04-20T10:27:00Z  54.429627573:18.476987137
> 70.171200323179 2013-04-20T09:05:28Z  54.429655485:18.476893930

One can stipulate from the above output that I passed a point 15,4 meters away from 54.429591/18.477973 at 10:27:09 GMT as well as I passed onother point which is 22 meters away from 54.429591/18.477973 at 09:05:15. As I cycled back and forth along the same route the second point is valid, the first is accidentally closer but as the time is almost one and half hours later it is clear that I was there on returning home. So gpsbabel should be executed as follows (20130420.gpx contains GPX track):

gpsbabel -i gpx -f 20130420.gpx -o subrip,video_time=000034,gps_time=090515,gps_date=20130420 -F 20130420_1.srt

Speed is added with another very simple Perl script:

perl add_speed_2_srt.pl 20130420_1.srt > 20130420_1_S.srt

Just to remind: internally all GPS units record time/date using Coordinated Universal Time aka Greenwich Mean Time vel Zulu time (for army enthusiasts). What the unit displays is another matter (usually it displays local time).

url | Sun, 21/04/2013 14:42 | tagi: , , ,
Perl encoding problem

SW asked me to augment a Perl script that originally processes ISO-8859-2 encoded text (TeX) files only by adding UTF-8 and CP1250 (one byte MS Windows encoding for Central Europe) encodings as well.

I made up it as follows (not sure if correct):

use Getopt::Long;
my $coding = 'utf8'; my $showhelp= '' ;
GetOptions( "coding=s"  => \$coding, "help|\?" => \$showhelp,) ;
if ( $showhelp ) { print "*** $0 [-coding=[cp1250|iso88592|utf-8]] file1 file2...\n" ;
		   exit 1; }

if ( $coding =~ /cp1250/ ) { $coding='cp1250'; use open ':encoding(cp1250)'; }
elsif ( $coding =~ /iso8859\-?2/ ) { $coding='iso-8859-2'; use open ':encoding(iso-8859-2)'; }
elsif ( $coding =~ /utf\-?8/ ) { $coding='UTF-8'; use open ':encoding(UTF-8)'; } 
else { die "*** Unknown coding: $coding\n";  exit 1; }

print STDERR "*** Coding: $coding\n";
## rest of the script omitted ....

I reencoded the script from original ISO-8859-2 to UTF-8 as well with iconv, so all strings are UTF-8 encoded now.

url | Thu, 20/12/2012 20:30 | tagi: , ,
Raspberry Pi/DHT-22 sensor: registering temperature and humidity
Czujnik DHT-22
Fig. #1: DHT-22 sensor

Fig. #2: Testing DHT-22
Instalacja 2x czujnik DHT-22
Fig. #3: Wiring

To build the installation one has to buy:

DHT-22 temperature/humidity sensor (8 USD per sensor). Not cheap...

0,25W 10K OHM carbon resistor (very cheap).

female connectors (pol. kable połączeniowe żeńskie), telephone cables or similar four core cable (pol. kabel czterożyłowy), terminal block (pol. kostka połączeniowa) and heat shrink tubing (pol. rurka termokurczliwa) to insulate and strengthen connections. The recommended way is to use a breadboard (pol. płytka stykowa/prototypowa) as described in learn.adafruit.com. My interest in electronics is limited, I've never used breadboards etc... I had some spare cables and terminal blocks so I designed it that way (cf. pictures).

NOTE: The cheaper version of the DHT-22 is a DHT-11 (aka SHT-11). Tempted by the lower price I bought two DHT-11 sensors but I do not recommend it. First of all, the temperature is measured in the range of 0 °C to 50 °C (with poor accuracy of +/- 2 °C) so is not suitable for outdoor (at least in Europe). Second, the humidity seems to be understated. Third, it does not work when DQ line is connected to other GPIO pins than pin #24 (maybe it's a software problem). For comparison, DHT-22 measures the temperature in the range of-40C to +80 C with an accuracy of +/- 0.5 °C.

I follow the tutorial available at learn.adafruit.com but some details were modified.

Hardware

There are four pins in DHT-22 (see Figure # 1). I connected data line (DQ) of each sensor to pins P22, P24 and P25 respectively (each sensor must have a separate data line). Vdd pin of each sensor to P1 (3.3 V supply). GND (ground) pin of each sensor to P6. In addition, each DQ was connected via the resistor with the power line Vdd.

Pin Null is not used.

The sensors were connected to GPIO pins via terminal blocks, cables and some soldering.

Software

One has to download, compile and install the necessary library:

pi@raspberrystar $ wget http://www.open.com.au/mikem/bcm2835/bcm2835-1.8.tar.gz
pi@raspberrystar $ tar -zxvf bcm2835-1.8.tar.gz
pi@raspberrystar $ cd bcm2835-1.8
pi@raspberrystar $ ./configure && make && sudo make install

then the application retrieving the data from the sensors has to be installed:

pi@raspberrystar $ git clone https://github.com/adafruit/Adafruit-Raspberry-Pi-Python-Code.git
pi@raspberrystar $ cd Adafruit-Raspberry-Pi-Python-Code
pi@raspberrystar $ cd Adafruit_DHT_Driver

One has to modify Makefile file, namely add -l rt at the end of the line that starts with CFLAGS:

CFLAGS =  -std=c99 -I. -lbcm2835 -l rt

now:

## in Adafruit_DHT_Driver directory
pi@raspberrystar $ make

If everyting works, then:

# Run ./Adafruit_DHT sensor-type DQ-pin-number
pi@raspberrystar $ sudo ./Adafruit_DHT 22 25
Using pin #25
Data (40): 0x3 0xe7 0x0 0x17 0x1
Temp =  2.3 *C, Hum = 99.9 %

The directory Adafruit_DHT_Driver contains also Adafruit_DHT_googledocs.ex.py Python script which can upload sensor readings directly to google.docs spreadsheet. To run Adafruit_DHT_googledocs.ex.py one has to install gspread module first:

pi@raspberrystar $ wget http://pypi.python.org/packages/source/g/gspread/gspread-0.0.13.tar.gz
pi@raspberrystar $ tar -zxvf gspread-0.0.13.tar.gz
pi@raspberrystar $ cd gspread
pi@raspberrystar $ sudo python setup.py install

Adafruit_DHT_googledocs.ex.py script: 1) in an infinite loop runs every 30 seconds the program Adafruit_DHT, 2) retrieves temperature/humidity, 3) sends temperature/humidity readings to google.docs. A fragment of the script looks like:

while(True):
 output = subprocess.check_output(["./Adafruit_DHT", "2302", "4"]);
 print output
 # search for humidity printout
  matches = re.search("Hum =\s+([0-9.]+)", output)
  if (not matches):
        time.sleep(3)
        continue
  humidity = float(matches.group(1))
  ## omitted code ...

 time.sleep(30)

Because I want to process somehow the data (not only to retrieve and upload to google.docs) I modify Adafruit_DHT_googledocs.ex.py script. My version Adafruit_DHT_googledocs.ex.py is limited to sending to google.docs values passed as arguments to the call:

temp = float(sys.argv[1])
humidity = float(sys.argv[2])
## omitted code ...

The following bash script takes care of the rest:

#!/bin/bash
#
LOG_DIR=/home/pi/Logs/DHT
BIN_DIR=/home/pi/bin
SENSTYPE=22
SLEEP_TIME=5

function ReadSensor() {
   local sensorType="$1"
   local sensorId="$2"
   local WYNIK=""
   local SUCCESS=""

   ## 5 tries with 5s sleep between them
   for i in 1 2 3 4 5; do
      WYNIK=`sudo $BIN_DIR/Adafruit_DHT $sensorType $sensorId | tr '\n' ' '`
      SUCCESS=`echo $WYNIK | awk ' { if (NF > 10) {print "YES"} else { print "NO"}}'`

      if [ "$SUCCESS" = "YES" ] ; then
         echo "$sensorId=$i $WYNIK" >> $LOG_DIR/DHT22.log
         DHT_CURR_TEMP=`echo $WYNIK | awk '{print $13}'`
         DHT_CURR_HUM=`echo $WYNIK | awk '{print $17}'`
         break
      fi
      sleep $SLEEP_TIME;
      done

      ## All attempts to read sensors were unsuccessful
      if [ $SUCCESS = "NO" ] ; then
         echo "$sensorId=? $WYNIK" >> $LOG_DIR/DHT22.log
         DHT_CURR_TEMP="999.9"
         DHT_CURR_HUM="999.9"
      fi
}
echo "@`date "+%Y%m%d%H%M%S"`" >> $LOG_DIR/DHT22.log

## A sensor in the room:
ReadSensor $SENSTYPE "24"
READINGS="$DHT_CURR_TEMP $DHT_CURR_HUM"
sleep 12

## Outdoor sensor:
ReadSensor $SENSTYPE "25"
READINGS="$READINGS $DHT_CURR_TEMP $DHT_CURR_HUM"
sleep 12

## A sensor in the porch:
ReadSensor $SENSTYPE "22"
READINGS="$READINGS $DHT_CURR_TEMP $DHT_CURR_HUM"

## HTML + chart 
/usr/bin/perl /home/pi/bin/dht2ht.pl > /var/www/stats/DHT22.html

# Upload to google
/home/pi/bin/DHT_googledocs.ex.py $READINGS

As in the case of 1-Wire bus there are problems with the reading of the sensor. That's why the function ReadSensor is trying to read the sensor several times. Maximum number of failed attempts, we have observed during several days of operation is 3.

The script runs every 30 minutes from cron:

1,31 * * * * /home/pi/bin/dht2ht.sh

LOG file looks something like this:

@20121113230101
24=1 Using pin #24 Data (40): 0x2 0x22 0x0 0xc9 0xed Temp =  20.1 *C, Hum = 54.6 %
25=1 Using pin #25 Data (40): 0x3 0xe7 0x0 0x1c 0x6 Temp =  2.8 *C, Hum = 99.9 %
22=4 Using pin #22 Data (40): 0x2 0x73 0x0 0xb0 0x25 Temp =  17.6 *C, Hum = 62.7 %

Row starting with the @ contains the date and time (@ is added for subsequnt easy parsing). Lines that begin with nn = m contain the data retrived from the sensor (nn is the sensor number, m denotes the number of successful attempt or ? in case when all attempts were unsuccessful)

Note: I noticed that higher system load (including intensive I/O operations) cause problems to retrieve data from the sensors. I tried to run motion detection application (motion) configured to use as little system resources as possible with no success. Rapberry overclocked to 900 Mhz performs significantly better but still only about 20% tries returns some data. Exact nature of the problem is a mystery to me as for example top indicates that still more there 80% of CPU is free.

Other question to consider is: whether the readings are correct during high humidity? My outdoor sensors tend to indicate 99% humidity pretty frequently which seems suspicious. I have compared data obtained from 3 different sensors (namely WH 2080 clone, Oregon Scientific's RMS300 and DHT-22) and some differ significantly.

Conversion to HTML and generating charts with dht2ht.pl

Perl script dht2ht.pl creates a HTML table and charts showing temperature/humidity readings as well as dew point, calculated with the following approximation formula: $$ D_p = (237.7 \cdot \gamma(T, H) ) / (17.271 - \gamma(T, H) ) $$

where: $$ \gamma(T, H) = 17.271 \cdot T / (237.7 + T) + \log (H / 100.0) $$

Script outcome is available here. All scripts and other stuff discussed in this blog post are available here.

Google.docs sheet containing readings from all my 3 sensors is available here. (Note: for some important reasons Adafruit_DHT_googledocs.ex.py script started adding data from the 162th line of the spreadsheet.)

url | Sat, 08/12/2012 13:39 | tagi: , , , , , ,
Raspberry Pi/czujnik DHT-22: rejestrowanie temperatury i wilgotności
Czujnik DHT-22
Rys. #1: DHT-22

Rys. #2: Testowanie DHT-22
Instalacja 2x czujnik DHT-22
Rys. #3: Okablowanie

Do wykonania instalacji potrzebne są:

Czujnik DHT-22 temperatury/wilgotności (ok. 30 zł za sztukę). Droga sprawa...

REZYSTOR 0,25W 10K OHM węglowy (1,00 zł za 100 sztuk na Allegro).

Do tego: przewody połączeniowe żeńskie, przewód telefoniczny czterożyłowy lub inny podobny, kostka elektryczna oraz rurka termokurczliwa do izolacji i wzmocnienia połączeń. (Por. Raspberry Pi: magistrala 1-Wire i rejestracja temperatury.)

UWAGA: tańszą wersja DHT-22 jest DHT-11 (aka SHT-11). Połasiłem się nawet na takowy, bo taniej ale nie polecam. Przede wszystkim mierzy temperaturę w przedziale od 0C do 50C (z kiepską dokładnością +/- 2C) więc nie nadaje się do pomiaru temperatury zewnętrznej. Do tego odczyt wilgotności jest zaniżony i nie działa podłączony do niektórych pinów GPIO (być może jest to problem oprogramowania, którego używam). Dla porównania DHT-22 mierzy temperaturę w przedziale od -40C do +80C z dokładnością +/- 0,5C.

Na stronie learn.adafruit.com znajduje się tutorial, z którego korzystałem...

Hardware

Sensor DHT-22 ma cztery piny (por. rys #1). Podłączyłem linie danych (DQ) do pinów P22, P24 i P25 (każdy sensor musi mieć oddzielną linię danych). Vdd każdego sensora do pina P1 (zasilanie 3,3V). GND (masa) każdego czujnika do pina P6. Ponadto każde DQ należało połączyć za pomocą rezystora z linią zasilania Vdd.

Pin Null nie jest wykorzystywany.

Lutowanie i łączenie wszystkiego do kupy wykonałem w sposób identyczny (kostka elektryczna, rurka termokurczliwa itp.) z opisanym bardziej szczegółowo we wpisie Raspberry Pi: magistrala 1-Wire i rejestracja temperatury.

Software

Pobieram, kompiluję i instaluję niezbędną bibliotekę:

pi@raspberrystar $ wget http://www.open.com.au/mikem/bcm2835/bcm2835-1.8.tar.gz
pi@raspberrystar $ tar -zxvf bcm2835-1.8.tar.gz
pi@raspberrystar $ cd bcm2835-1.8
pi@raspberrystar $ ./configure && make && sudo make install

Pobieram program do obsługi czujników:

pi@raspberrystar $ git clone https://github.com/adafruit/Adafruit-Raspberry-Pi-Python-Code.git
pi@raspberrystar $ cd Adafruit-Raspberry-Pi-Python-Code
pi@raspberrystar $ cd Adafruit_DHT_Driver

W pliku Makefile należy dopisać -l rt na końcu wiersza zaczynającego się od CFLAGS:

CFLAGS =  -std=c99 -I. -lbcm2835 -l rt

teraz:

## w katalogu Adafruit_DHT_Driver
pi@raspberrystar $ make

Jeżeli wszystko działa, to:

# Uruchomienie ./Adafruit_DHT typ-czujnika nr-pina-DQ
pi@raspberrystar $ sudo ./Adafruit_DHT 22 25
Using pin #25
Data (40): 0x3 0xe7 0x0 0x17 0x1
Temp =  2.3 *C, Hum = 99.9 %

W katalogu Adafruit_DHT_Driver znajduje się też skrypt Pythona pn. Adafruit_DHT_googledocs.ex.py służący do wysyłania odczytanych danych do arkusza google.docs. Skrypt Adafruit_DHT_googledocs.ex.py do działania potrzebuje modułu gspread:

pi@raspberrystar $ wget http://pypi.python.org/packages/source/g/gspread/gspread-0.0.13.tar.gz
pi@raspberrystar $ tar -zxvf gspread-0.0.13.tar.gz
pi@raspberrystar $ cd gspread
pi@raspberrystar $ sudo python setup.py install

Skrypt Pythona Adafruit_DHT_googledocs.ex.py: 1) w nieskończonej pętli uruchamia co 30 sekund program Adafruit_DHT, 2) wyłuskuje z wydruku wartości temperatury/wilgotności, 3) wysyła co trzeba na google.docs. Fragment skryptu wygląda następująco:

while(True):
 output = subprocess.check_output(["./Adafruit_DHT", "2302", "4"]);
 print output
 # search for humidity printout
  matches = re.search("Hum =\s+([0-9.]+)", output)
  if (not matches):
        time.sleep(3)
        continue
  humidity = float(matches.group(1))
  ## pominięty kod ...

 time.sleep(30)

Ponieważ ja chcę oprócz wysłania na google.docs coś tam jeszcze zrobić z danymi, to miałem do wyboru albo rozbudować Adafruit_DHT_googledocs.ex.py o dodatkową funkcjonalność albo go uprościć. Wybrałem to drugie: moja wersja Adafruit_DHT_googledocs.ex.py ogranicza się wyłącznie do wysłania na google.docs wartości przekazanych jako argumenty wywołania:

temp = float(sys.argv[1])
humidity = float(sys.argv[2])
## pominięty kod ...

Resztą zajmie się poniższy skrypt basha:

#!/bin/bash
#
LOG_DIR=/home/pi/Logs/DHT
BIN_DIR=/home/pi/bin
SENSTYPE=22
SLEEP_TIME=5

function ReadSensor() {
   local sensorType="$1"
   local sensorId="$2"
   local WYNIK=""
   local SUCCESS=""

   ## zwiększyłem powtórzenia do 5 (sleep zmniejszony do 5s/było 10)
   for i in 1 2 3 4 5; do
      WYNIK=`sudo $BIN_DIR/Adafruit_DHT $sensorType $sensorId | tr '\n' ' '`
      SUCCESS=`echo $WYNIK | awk ' { if (NF > 10) {print "YES"} else { print "NO"}}'`

      if [ "$SUCCESS" = "YES" ] ; then
         echo "$sensorId=$i $WYNIK" >> $LOG_DIR/DHT22.log
         DHT_CURR_TEMP=`echo $WYNIK | awk '{print $13}'`
         DHT_CURR_HUM=`echo $WYNIK | awk '{print $17}'`
         break
      fi
      sleep $SLEEP_TIME;
      done

      ## Wszystkie próby okazały się nieudane
      if [ $SUCCESS = "NO" ] ; then
         echo "$sensorId=? $WYNIK" >> $LOG_DIR/DHT22.log
         DHT_CURR_TEMP="999.9"
         DHT_CURR_HUM="999.9"
      fi
}
echo "@`date "+%Y%m%d%H%M%S"`" >> $LOG_DIR/DHT22.log

## Czujnik w pokoju:
ReadSensor $SENSTYPE "24"
READINGS="$DHT_CURR_TEMP $DHT_CURR_HUM"
sleep 12

## Czujnik na zewnątrz:
ReadSensor $SENSTYPE "25"
READINGS="$READINGS $DHT_CURR_TEMP $DHT_CURR_HUM"
sleep 12

## Czujnik weranda:
ReadSensor $SENSTYPE "22"
READINGS="$READINGS $DHT_CURR_TEMP $DHT_CURR_HUM"

## zamiana na HTML + wykres
/usr/bin/perl /home/pi/bin/dht2ht.pl > /var/www/stats/DHT22.html

# Wyslanie na google
/home/pi/bin/DHT_googledocs.ex.py $READINGS

Podobnie jak w przypadku magistrali 1-Wire zdarzają się problemy z odczytaniem wartości czujnika. Na tą okoliczność funkcja ReadSensor próbuje odczytu kilkukrotnie. Maksymalna nieudana liczba prób, którą zaobserwowałem w ciągu kilkudniowej eksploatacji to 3.

Skrypt jest uruchamiany co 30 min przez crona:

1,31 * * * * /home/pi/bin/dht2ht.sh

Plik LOG wygląda jakoś tak:

@20121113230101
24=1 Using pin #24 Data (40): 0x2 0x22 0x0 0xc9 0xed Temp =  20.1 *C, Hum = 54.6 %
25=1 Using pin #25 Data (40): 0x3 0xe7 0x0 0x1c 0x6 Temp =  2.8 *C, Hum = 99.9 %
22=4 Using pin #22 Data (40): 0x2 0x73 0x0 0xb0 0x25 Temp =  17.6 *C, Hum = 62.7 %

Wiersz zaczynający się od @ zawiera datę i czas odczytu. Wiersze zaczynające się od nn=m zawierają odczytane dane (nn to numer czujnika, m numer próby w której odczytano wartości lub ? jeżeli wszystkie próby były nieudane)

Uwaga: zauważyłem, że przy intensywnych operacjach I/O są duże problemy z odczytaniem wskazań czujników.

Skrypt dht2ht.pl

Perlowy skrypt dht2ht.pl tworzy tabelę oraz wykresy prezentujące odczytane wartości plus obliczoną na ich podstawie temperaturę punktu rosy. Rezultat działania można oglądać tutaj. Omawiane w tym wpisie skrypty są zaś tutaj.

Arkusz google.docs zawierający odczyty z moich trzech czujników jest dostępny tutaj. (Uwaga: z jakiś ważnych powodów skrypt Adafruit_DHT_googledocs.ex.py zaczął dopisywanie danych od 162 wiersza arkusza.)

url | Wed, 14/11/2012 09:47 | tagi: , , , ,
Perl XML:DOM

Plik XML wygląda tak:

<?xml version="1.0" encoding="UTF-8" ?>
<!DOCTYPE lista.kompozycji SYSTEM "lkompc.dtd" >
<lista.kompozycji>

<kompozycja typ="i.orkiestro">
  <tytul>Atlantyda I na orkiestrę symfoniczną</tytul>
  <xsklad>4 akordeony w orkiestrze</xsklad>
  <autor>
    <nazwisko>Augustyn</nazwisko>
    <imie>Rafał</imie>
  </autor>
  <rok>1979</rok>
  <sklad>4 acc</sklad>
  <wydawca>manus</wydawca>
</kompozycja>

 ...

<kompozycja typ="solo">
 <tytul>Rapsodia</tytul>
 <xsklad>akordeon solo</xsklad>
 <autor>
  <nazwisko>Krzanowski</nazwisko>
  <imie>Andrzej</imie>
 </autor>
 <autor>
 <nazwisko>Krzanowska</nazwisko>
  <imie>Grażyna</imie>
 </autor>
 <rok>1983</rok>
 <wydawca>PWM</wydawca>
 <nagranie>KM</nagranie>
</kompozycja>
 ...

</lista.kompozycji>

a ma wyglądać tak:

<?xml version="1.0" encoding="UTF-8" ?>
<!DOCTYPE lista.kompozycji SYSTEM "lkompc.dtd" >
<lista.kompozycji>

<kompozytor id='Augustyn.R'><!-- *** Augustyn:Rafał# -->

<kompozycja typ="i.orkiestro">
  <tytul>Atlantyda I na orkiestrę symfoniczną</tytul>
  <xsklad>4 akordeony w orkiestrze</xsklad>  
  <rok>1979</rok>
  <sklad>4 acc</sklad>
  <wydawca>manus</wydawca>

</kompozycja>
<kompozycja typ="i.orkiestro">
 <tytul>Atlantyda II na wielką orkiestrę i chór</tytul>
    <xsklad>4 akordeony w orkiestrze</xsklad> 
 <rok>1983</rok>
 <sklad>4 acc</sklad>
 <wydawca>manus</wydawca>
 <nagranie>LP</nagranie>
</kompozycja>

</kompozytor>

...

<kompozytor id='Krzanowski.A#Krzanowska.G'><!-- *** Krzanowski:Andrzej#Krzanowska:Grażyna# -->
<kompozycja typ="solo">
 <tytul>Rapsodia</tytul>
 <xsklad>akordeon solo</xsklad>
 <rok>1983</rok>
 <wydawca>PWM</wydawca>
 <nagranie>KM</nagranie>
</kompozycja>

...

</lista.kompozycji>

To znaczy, że z elementu kompozycja mają zniknąć elementy autor. Wszystkie kompozycje tego samego kompozytora mają być elementami-dziećmi elementu kompozytor. Element kompozytor ma identyfikować kompozytora za pomocą atrybutu id, którego wartość jest wyznaczana (w przypadku gdy dzieło jest ma jednego autora) jako:

nazwisko.inicjał

W przypadku gdy kompozycja jest dziełem zbiorowym, identyfikator kompozytora zbiorowego ma mieć postać:

nazwisko.inicjał#nazwisko.inicjał 
nazwisko.inicjał#nazwisko.inicjał#nazwisko.inicjał ...

Powyższe realizuje taki oto skrypt:

#!/usr/bin/perl
use XML::DOM;
binmode(STDOUT, ":utf8");

my $file2parse = $ARGV[0];

my $parser = new XML::DOM::Parser;
my $doc = $parser->parsefile ($file2parse);

for my $kompozycja ( $doc->getElementsByTagName ("kompozycja") ) {
  my $author_id = '';

  ## przeglądamy kolejne elementy autor:
  for my $autor ($kompozycja->getElementsByTagName("autor"))  {

      $im = ($autor->getElementsByTagName("imie"))[0]->toString();
      $nz = ($autor->getElementsByTagName("nazwisko"))[0]->toString();

      $author_id .=  "$nz:$im#"; ## autorów może być dużo stąd .= a nie =
      $author_id =~ s/<[^<>]+>//g; ## usuń tagi, zostaw sam tekst

      ##print STDERR "$author_id\n";

      ## usuń element autor:
      $kompozycja->removeChild($autor);
  }

  ## Hash of Arrays, cf  http://docstore.mik.ua/orelly/perl2/prog/ch09_02.htm
  push @{ $Kompozycje{ $author_id }}, $kompozycja->toString ();

}

### Druk ############################################################

print "<?xml version=\"1.0\" encoding=\"UTF-8\" ?>\n";
print "<!DOCTYPE lista.kompozycji SYSTEM \"lkompc.dtd\" >\n";
print "<lista.kompozycji>\n";


for $autor (sort keys %Kompozycje ) {
  $autor_i = $autor;
  $autor_i =~ s/:([^#:])[^#:]+#/.\1#/g; # tylko inicjały
  chop($autor_i);

  print "\n\n\n\n<kompozytor id='$autor_i'><!-- *** $autor -->\n\n";
  for $kompozycja ( @{ $Kompozycje{ "$autor" }} ) {
    print $kompozycja, "\n";
  }
  print "\n</kompozytor>\n";
}


print "</lista.kompozycji>\n";

## koniec ###

Jeżeli się nie doda binmode, to UTF jest malformed (Ah ten Perl.) Podpowiedź znalazłem tutaj. Nawiasem mówiąc i w innym skrypcie:

s/<imie>([^<>])([^<>]+)<\/imie>/<inicjal>\1<\/inicjal>/gm;

Też zwraca malformed UTF-8 jeżeli np. imieniem jest Łukasz. A jak zaczyna się od A-Z to jest OK.

url | Fri, 17/02/2012 22:10 | tagi: ,
Korzystanie z GoogleMaps API z użyciem Google::GeoCoder::Smart

Geokodowanie to zamiana adresu lub nazwy miejsca na parę współrzędnych. Perlowy moduł Google::GeoCoder::Smart wykorzystany w poniższym skrypcie używa geolokalizatora Google'a:

#!/usr/bin/perl
use Google::GeoCoder::Smart;
$geo = Google::GeoCoder::Smart->new();

$location = $ARGV[0];

my $coords = addr2coords( $location );

## ## ## ## ## ##
sub addr2coords {
 my $a = shift ; ## address for example "Sopot,Polska"
 my $r = shift || 'n'; ## flag--order of coordinates lat/lng or lng/lat
 my ($lat, $lng) ;

 ## ## consult cache first ; $GeoCodeCache is a global hash ## ##
 if (exists $GeoCodeCache{"$a"} ) { ($lat,$lng) = split (" ", $GeoCodeCache{"$a"} );  }
 else {

   my ($resultnum, $error, @results, $returncontent) = $geo->geocode("address" => "$a");
   $resultnum--;

   if ($resultnum > 0) { print STDERR "** Location $a occured more than once! **" }

   if ( $error eq 'OK' ) {
      for $num(0 .. $resultnum) {
      $lat = $results[$num]{geometry}{location}{lat};
      $lng = $results[$num]{geometry}{location}{lng};
      ##print "*** LAT/LNG:$lat $lng ERROR: $error RES: $resultNo ***\n";
     }
   } else { print STDERR "** Location $a not found! due to $error **"  }
 }

 $GeoCodeCache{"$a"} = "$lat $lng"; ## store in cache
 ##sleep $SLEEP_TIME;

 if ($r eq 'r' ) { return "$lng,$lat"; } # KML order lng/lat
 else { return "$lat $lng"; ## GPX order lat/lng }
}

Jest limit 2500 żądań/dzień (24 godziny, przy czym nie jest dokładnie opisane kiedy następuje `reset' licznika, tj. rozpoczyna się następna doba). Jeżeli się przekroczy limit to:

perl ./coordinates.pl Wrocław
** Location Wrocław not found! due to OVER_QUERY_LIMIT **** 

Ponieważ w bibliotekach Perla jest wszystko są także moduły Geo::Coder::ManyGeo::Coder::Multiple, który potrafią korzystać z wielu Geokoderów na raz (Google, Yahoo, Bing), zwiększając w ten sposób dzienny limit. Nie używałem...

Dopisane 29 stycznia 2012: W sieci via Google można znaleźć informacje, że reset ma miejsce ,,at midnight 12:00 PST.'' Ale w tym przypadku coś nie bardzo się zgadza, bo exact midnight PST byłoby o 9:00 rano (8:00 GMT), a blokę na mój IP zdjęli około 16.00. (A kwota wyczerpała się o jakieś 18--19 dnia poprzedniego--dokładnie nie pamiętam.)

url | Sun, 29/01/2012 09:15 | tagi: , ,
How to import content from Blosxom to google Blogger

I have decided to give a try to Google Blogger service. I am an old dinosaur used to command line and tired with mouse and menus but as there is GoogleCL I am not scare. The problem is with my old posts---there is no way to post backdated blog entries with GoogleCL. A problem...

Fortunately there is export/import features on Blogger: one can backup blog content and/or upload it back to Google. In particular to import posts (and comments) into a blog, one have to click Import Blog from the blog's Settings. Next one have to select appropriate file and fill out the word verification beneath. The Blogger data format is Atom. So, to successfully import my old Blosxom entries I have to convert them to Atom.

I have made a few test entries and export them to check how the data looks like. Pretty wired but most of the content is irrelevant as it is concerned with formatting (css styles and such stuff is included). Also as I had comments disabled at my previous blog the problem is further simplified.

I have consulted Atom schema and tried with the following:

<?xml version="1.0" encoding="UTF-8"?>
<feed xmlns="http://www.w3.org/2005/Atom" 
      xmlns:openSearch="http://a9.com/-/spec/opensearchrss/1.0/" 
      xmlns:georss="http://www.georss.org/georss" 
      xmlns:gd="http://schemas.google.com/g/2005" 
      xmlns:thr="http://purl.org/syndication/thread/1.0">';

<id>tag:blogger.com,1999:blog-1928418645181504144.archive</id>
<updated>2011-10-22T12:34:14.746-07:00</updated>
<title type='text'>pinkaccordions.blogspot.com</title>
<generator version='7.00' uri='http://www.blogger.com'>Blogger</generator>

The meaning of the elements should be obvious. The last element (generator) is required by Blogger import facility, otherwise error message is returned.

According to the schema inside feed element there is zero or more entry elements:

<entry>
<id>ID</id>
<published>DATE</published>
<updated>DATE</updated>
<category scheme="http://schemas.google.com/g/2005#kind" term="http://schemas.google.com/blogger/2008/kind#post"/>
  
<!-- tags, each as value of attribute `term' of element category -->
<category scheme='http://www.blogger.com/atom/ns#' term='tag1'/>
<category scheme='http://www.blogger.com/atom/ns#' term='tag2'/>
<title type='text'>title</title>
<content type='html'>post content ... </content>
</entry>

There is a final </feed> to guarantee that XML file is well formatted.

I have assumed the only important feature of id element is that it's content should be unique. I have decided to use MD5sum of the post content as IDs to guarantee that.

Finally, my old Blosxom-compatible entries looks similar to the example below:

<?xml version='1.0' encoding='iso-8859-2' ?>
<html xmlns="http://www.w3.org/1999/xhtml"><head>
<title>Przed finałami RWC 2011</title>
<!-- Tags: rwc2011,rugby,francja,polsat-->
</head><body><!-- ##Published : 2011-10-20T07:20:26CEST ##-->


<p>W RWC 2011 zostały już tylko dwa mecze: jutro (piątek), o trzecie miejsce oraz

So it was extremly easy to extract title, tags and publication date and format Atom-compliant XML file with the following Perl script:

#!/usr/bin/perl
# Variant of Blosxom to Blogger conversion
# 2011/10 t.przechlewski
#
use Digest::MD5 qw(md5_hex);

print '<?xml version="1.0" encoding="UTF-8"?>
<!-- id, title/updated jest wymagane w elementach feed/entry reszta opcjonalna -->
<!-- wyglada na minimalne oznakowanie -->
<feed xmlns="http://www.w3.org/2005/Atom" 
      xmlns:openSearch="http://a9.com/-/spec/opensearchrss/1.0/" 
      xmlns:georss="http://www.georss.org/georss" 
      xmlns:gd="http://schemas.google.com/g/2005" 
      xmlns:thr="http://purl.org/syndication/thread/1.0">';

print "<id>tag:blogger.com,1999:blog-1928418645181504144.archive</id>";
print "<updated>2011-10-22T12:34:14.746-07:00</updated>";
print "<title type='text'>pinkaccordions.blogspot.com</title>";
print "<generator version='7.00' uri='http://www.blogger.com'>Blogger</generator>\n";

foreach $post_file (@ARGV) {

  my $post_title = $post_content = $md5sum = $published = '';
  my @post_kws = ();
  my $body = $in_pre  = 0;
  my $rel_URLs = 0;

  print STDERR "\n$post_file opened!\n";
  open POST, "$post_file" || die "*** cannot open $post_file ***\n";

  while (<POST>) {
    chomp();

    if (/<title>(.+)<\/title>/) {$post_title = $1 ; next ; }
    if (/<!--[ \t]*Tags:[ \t]*(.+)[ \t]*-->/) {$tags = $1 ; next ; }

    if (/<\/head><body>/) { 
      $body = 1 ; 
      ## </head><body><!-- ##Published : 2011-10-20T07:20:26CEST ##-->
      if (/##Published[ \t]+:[ \t]+([0-9T\-\:]+).+##/) { $published = $1; }
      print STDERR "Published: $published\n";
      next;
    }

    if (/<\/body><\/html>/) { $body = 0 ; next }

    if ( $body ) { 
      ## sprawdzam `przenosnosc URLi':
      if (/src[ \t]*=/) { 
	if (/pinkaccordions.homelinux.org/ || !(/http:\/\// ) ) { $rel_URLs = 1;  }
      }
      ## zawartość pre nie powinna być składana w jednym wierszu:
      if (/<pre>/)   { $in_pre = 1; $post_content .= "$_\n"; next ; }
      if (/<\/pre>/) { $in_pre = 0; $post_content .= "$_ "; next ; }
      if ( $in_pre ) { $post_content .= "$_\n"; }
      else {
	$post_content .= "$_ "; # ** musi być ze spacją **
      }
    }
  }

### ### ###

  if ($published eq '') { 
    warn "*** something wrong with: $post_file. Not published? Skipping....\n" ;
    close(POST);
    next ; 
  }
  if ( $tags eq '' || $post_title eq '' ) { 
    die "*** something wrong with: $post_file (tags: $tags/title: $post_title)\n"; }
  if ($rel_URLs) { die "*** suspicious relative URIs: $post_file\n"; }

  $post_content =~ s/\&/&amp;/g;
  $post_content =~ s/</&lt;/g;
  $post_content =~ s/>/&gt;/g;

  print STDERR "Title: $post_title Tags: $tags\n";

  @post_kws = split /,/, $tags;
  $md5sum = md5_hex($post_content);
  print STDERR "MD5sum: $md5sum\n";

  print "<entry>";
  print "<id>tag:blogger.com,1999:post-$md5sum</id>";
  print "<published>$published</published>";
  print "<updated>$published</updated>";
  print '<category scheme="http://schemas.google.com/g/2005#kind" term="http://schemas.google.com/blogger/2008/kind#post"/>';
  
  ## tags:
  foreach $k (@post_kws) { print "<category scheme='http://www.blogger.com/atom/ns#' term='$k'/>"; }

  print "<title type='text'>$post_title</title>";
  print "<content type='html'>$post_content</content></entry>";

  close(POST);

}

print "</feed>";

The minor problem was the default formatting of <pre>...</pre> which I use to show code snippets. I have to preserve line breaks (cf. $in_pre in the above Perl script) of pre element content as well as have to add the following to the default CSS styles (it is possible to modify CSS via Project →Template Designer →Advanced →Add CSS1)

pre { white-space:nowrap; font-size: 80%;  }

To convert simply run script as follows:

perl blogspot-import.pl post1 post2 post3.... > converted-posts.xml 

The above described script can be downloaded from here.

1In Polish: Projekt →Projektant szablonów →Advanced →Dodaj Arkusz CSS

url | Mon, 24/10/2011 18:50 | tagi: , , , , ,
Perl, MySQL i UTF-8

Strasznie dużo czasu zmarnowałem usiłując zmienić kodowanie w bazie MySQL na UTF i dopasować skrypty Perla do tej zmiany.

Przestawienie MySQLa na UTF-8 jest proste:

mysql -u www -p --default-character-set=utf8
CREATE database kpma CHARACTER SET utf8 COLLATE utf8_bin;

Baza kpma (użytkownika www) będzie kodowana w UTF-8. Można też określić domyślne kodowanie wszystkich baz w pliku konfiguracji MySQLa, tj. w pliku /etc/mysql/my.cnf (Debian):

[mysqld]
 ...
default-character-set = utf8 

Trochę diagnostyki:

use kpma;
show variables like 'char%';
show table status;

select tytul from Utwor;
## jest OK -- na konsoli widać poprawne różne znaki diakrytyczne

Prawdziwa męka to było zmuszenie Perla do poprawnego traktowania danych UTF.

Trzy kluczowe dla poprawnego przetwarzania UTF sprawy to: 1) klauzula binmod (patrz poniżej); 2) klauzula use utf8 (jeżeli skrypt zawiera napisy kodowane w UTF); 3) wpisy mysql_enable_utf8/SET NAMES utf8 dotyczące MySQLa.

Szkielet skryptu Perla wygląda następująco:

#!/usr/bin/perl -w
# -*- coding: utf-8 -*- --
#
use strict;
use utf8; ## skrypt zawiera napisy kodowane UTF
use CGI qw(:standard);
use DBI;
binmode(STDOUT, ":utf8"); ## bez tego problemy z UTF

my $dbname = 'kpma'; ## Nazwa bazy
my $dbuser = 'www'; ## Nazwa użytkownika MySQL
my $dbpasswd = '??????'; ## Hasło dla $dbuser

my $dsn = "dbi:mysql:$dbname:localhost:3306";

my $dbh = DBI->connect($dsn, "$dbuser", "$dbpasswd", { ChopBlanks => 1 });
$dbh->{'mysql_enable_utf8'} = 1;
$dbh->do('SET NAMES utf8');

my $SQL = "SELECT tytul FROM Utwor WHERE id_kompozytor1 = 59 ORDER BY rok ";
##my $SQL = "SELECT nazwisko FROM Kompozytor ";

my $sth = $dbh->prepare($SQL);

$sth ->execute();

while ( my @piece = $sth->fetchrow_array() ) {  print ">> @piece\n"; }

$dbh->disconnect || warn "Nie mogę zamknąć bazy $dbname\n";

Jeżeli skrypt korzysta (pobiera dane) z param() to koniecznie należy zastosować funkcję decode_utf8:

use Encode; ## param() trzeba dekodować

 if (param()) {# -- Wypełniono formularz --
   ## http://ahinea.com/en/tech/perl-unicode-struggle.html
   my $who = Encode::decode_utf8(param("kto"));

Działa nawet z dość starym Perlem:

$perl --version

This is perl, v5.10.0 built for arm-linux-gnueabi-thread-multi

Copyright 1987-2007, Larry Wall

url | Wed, 28/09/2011 22:47 | tagi: , , , ,
Pobieranie informacji o książce/płycie o podanym numerze UPC/EAN z amazon.com

Jest gotowa aplikacja służąca do katalogowania książek za pomocą czytnika kodów kreskowych opisana w artykule A Perl script catalogs books and CDs... (tu jest wersja HTML z likiem do kodu źródłowego opisanego skryptu).

Od pierwsze strzału aplikacja nie działa. Żeby w ogóle Perl chciał program wykonać należy z przodu pliku dodać wiersz:

## http://perlmeister.com/forum/viewtopic.php?t=3596&sid=59d9cb0bda64235bda70315d6e9031e8
use POE::Loop::Tk ;

Teraz działa ale nie zawsze. Ponadto program Schilli'ego w zamierzeniu obsługuje tylko kody UPC a moje książki/płyty są oznaczane kodem UPC i/lub EAN.

Kody EAN są 13 cyfrowe a UPC 12 cyfrowe. Żeby było śmieszniej amazon.com nie rozumie kodów EAN -- trzeba odpytywać jakąś europejską filię, np. amazon.co.uk.

## moja wersja procedury amzn_fetch:
sub amzn_fetch {
  my($upc_or_ean) = @_;
  my $resp;

  my $amz_locale = 'us'; # default is US
  if ( length ("" . $upc_or_ean ) > 12) {
    $amz_locale = 'uk';
    print STDERR "*** $upc_or_ean looks like EAN code\n";
  } else {
    $amz_locale = 'us';
    print STDERR "*** $upc_or_ean looks like UPC code\n";
  }

  my $amzn = Net::Amazon->new(
      token => $amz_token,
      secret_key => $amz_secret,
      locale => $amz_locale,
      ua    => $UA,
  );

  my $req ;
  if ( $amz_locale eq 'uk') {
    print STDERR "*** Fetching from $amz_locale with mode $current_amz_cat ***\n";
    $req = Net::Amazon::Request::EAN->new(
          ean  => $upc_or_ean,
          mode => $current_amz_cat,
         );
  } else {
      print STDERR "*** Fetching from $amz_locale with mode $current_amz_cat ***\n";
       $req = Net::Amazon::Request::UPC->new(
	  upc  => $upc_or_ean,
          mode => $current_amz_cat,
       );
  }

  $resp = $amzn->request($req);

 ## ... itd ...

Skrypt Schilli'ego zakłada ponadto, że zapytanie zawiera UPC/EAN oraz nazwę kategorii (books, music DVD), bo tak kiedyś działał Amazon. Teraz wydaje się, że działa inaczej. Podanie np. kodu książki + kategorii music, daje błąd. Nie zamierzałem grzebać w pakiecie Net::Amazon, więc zmieniłem skrypt w ten sposób, że kategoria jest deklarowana explicite przez operatora:

my @MODES = qw(books music dvd);

## ... itd ...

## cf. http://www.ibm.com/developerworks/aix/library/au-perltkmodule2/
my $MODE  = $top->Label();

my $current_amz_cat = $MODES[0]; ## domyślną jest pierwsza kategoria
foreach(@MODES) { 
  $MODE->Radiobutton( 
      -text => $_, 
      -value=> $_, 
      -variable => \$current_amz_cat,
      -command => sub {
	print STDERR "*** Current mode is: $current_amz_cat \n";
      } )->pack(-side => 'left', -expand => '1', -fill => "x" )
}

Na wypadek gdyby operator zapomniał kliknąć w co trzeba:

  if($mode eq "books") {

    eval { $resp->properties()->isbn(); } ; ## bez eval będzie krasz

    if ($@) {## błąd jeżeli `item' nie zawiera isbn, tj. nie jest książką... 
      print STDERR "*** ERROR: $@\n";
      $PRODUCT->configure( -text => "NOT BOOKS TYPE ITEM / REENTER"); return 1;  }
 ## ... itd ...

Opis książki różni się od opisu CD (np. książka ma element isbn a płyta tracks). Schilli ominął ten problem ignorując elementy specyficzne, definiując jeden typ rekordu i jedną tabelę. Ostatnia zmiana w porównaniu do skryptu Schilli'ego, to dodanie do bazy pola przechowującego opis książki/CD w formacie XML (zamiast definiowania różnych tabel dla książek, płyt CD i filmów). W zależności od typu danych ten opis XML zawiera to co trzeba (czyli specyficzne dla opisywanego obiektu atrybuty). Np:


 Edward R. Tufte
 Edward R. Tufte
 The Visual Display of Quantitative Information
 Graphics Press USA
 2nd edition
 2001-01-31
 0961392142
]]>

Tak działającym skryptem skatalogowałem jakieś 30--40% zawartości mojej biblioteki. Stare książki nie mają kodu kreskowego. Część polskich książek jest w zasobach Amazona ale części nie ma (np. książki wyd. Readme -- i słusznie bo to prawie w całości badziewie:-)

Tu jest corpus delicti. Moja biblioteka jest tutajtutaj -- jakby ktoś był ciekaw.

Skrypty można znaleźć tutaj.

Dopisane 1 września 2011: Zapomniałem napisać o istotnej sprawie. Żeby móc odpytywać Amazon trzeba się zapisać do Product Advertising API, tj. założyć konto. Aby móc korzystać z ww. API trzeba wypełnić odpowiedni formularz i zgodzić się na licencję, która jest mówiąc oględnie taka sobie.

To begin the enrollment process, you must submit a complete and accurate enrollment form. In your enrollment form, you must describe the application you intend to develop and use with the Product Advertising API or on which you intend to display Product Advertising Content. We will evaluate your enrollment form and notify you of its acceptance or rejection. We may reject your enrollment form if we determine that your application is unsuitable. Unsuitable applications include those that:

do not have as their principal purpose advertising and marketing the Amazon Site and driving sales of products and services on the Amazon Site

Wygląda groźnie ale wystarczy podać -- jako opis aplikacji -- URL, pod którym będziemy ,,promować'' Amazon. Proces koncesyjny jest (póki co?) uproszczony -- nikt niczego nie rozpatruje. Ale to się może zmienić...

In addition, we may terminate or suspend your license to access and use the Product Advertising API, Data Feed, or any part of or all Product Advertising Content at any time without terminating this License Agreement by giving you written notice.

Jednym słowem do poważnych zastosowań to się nie nadaje. Ale do katalogowania własnej biblioteczki może być...

Po założeniu konta, pod adresem Manage Your AccountAccess IdentifiersClick here w rubryce Access Credentials tworzymy/zarządzamy Access Key ID/Secret Access Key -- niezbędnymi do korzystania z opisywanego wyżej skryptu:

my $amz_token = '???'; ## Access Key ID
my $amz_secret = '???'; ## Secret Access Key

url | Wed, 31/08/2011 19:35 | tagi: , ,
Katalogowanie książek -- pierwsze rezultaty

Pobieranie informacji o książce/płycie o podanym numerze UPC (z amazon.com):

#!/usr/bin/perl
# 
use Net::Amazon;
use Net::Amazon::Request::UPC;

my $code = '633367991522' ; # UPC (z kodem EAN są problemy)

# Token/secret_key do pobrania po zarejestrowaniu się na str. 
# https://aws-portal.amazon.com/gp/aws/developer/account/index.html/177-3749078-2923747
my $ua = Net::Amazon->new(
   token       => '####################',
   secret_key  => '########################################', 
);

my $req = Net::Amazon::Request::UPC->new( upc  => $code, mode => 'music', );

# Response is of type Net::Amazon::Response::UPC
my $resp = $ua->request($req);

if($resp->is_success()) {
   print $resp->as_string(), " (UPC)\n"; } else {
   print "Error: ", $resp->message(), "\n"; }
# end

url | Tue, 16/08/2011 22:55 | tagi: , ,