Są na stronie http://www.meteo.pl/
udostępnione 120h prognozy falowania
Bałtyku w postaci rysunków. Na tych rysunkach wysokość fal jest
odwzorowana kolorem od czerwonego
do jasno niebieskiego (najmniejsze). Kierunek fal jest odwzorowany
strzałkami. Są też dostępne dane historyczne.
Wszystko jest łatwe do pobrania, bo nazwa pliku historycznego
to na przykład wavehgt_0W_2015122200_015-00.png
czyli
wavehgt_0W_YYYYMMDD00_0HH-00.png
(gdzie HH
to
03/09/15/21
). Pliki prognoz mają
też nazwy wg schematu: wavehgt_0W_YYYYMMDD00_HHH-00.png
,
tyle że HHH się zmienia
w zakresie 12--120 co trzy (godziny).
Pobieram wgetem 8 plików 12--120. Teraz trzeba ustalić jakie są kolory na obrazku i wysłać komunikat (analiza strzałek to beznadzieja sprawa, nawet się nie zabieram.)
Zaczynam od wycięcia interesującego mnie fragmentu Bałtyku:
## 8 plików 12--120 convert wavehgt_0W_YYYYMMDD00_HHH-00.png-00.png -crop 65x86+280+575 \ wavehgt_0W_YYYYMMDD00_HHH-00.png-00D.png ## Wypisz kolory z rysunku: convert wavehgt_0W_YYYYMMDD00_HHH-00.png-00D.png \ -define histogram:unique-colors=true -format %c histogram:info:- | \ getMaxFala.pl ## Łączę w jeden: montage PLIKI... -tile 2x4 -border 4 -geometry 480 S_YYYMMDD.png
Plik getMaxFala.pl
zwraca kolor odpowiadający
za najwyższą falę. Szczęśliwie tych kolorów za dużo nie jest, więc sprawdzanie
jest enumeratywne
Mając najwyższe fale w horyzoncie 12--120 ustalamy max z tych 8 liczb i wypisujemy komunikat (Perl):
print "Max: $maxFF expected (in 120h time window)\n"; print "Details: "; for $f (sort keys %faleMax) { print "$f = $faleMax{$f} /" } print "\nAmber likelihood: "; if ($maxFF < 3) { print "NONE\n" } elsif ($maxFF < 4) { print "VERY SMALL\n" } elsif ($maxFF < 5) { print "SMALL\n" } elsif ($maxFF < 5) { print "MEDIUM\n" } elsif ($maxFF < 6) { print "LARGE\n" } else { print "Amber: HUGE"} print "http://pinkaccordions.homelinux.org/fale/forecast/S_${yyyymmdd}.png\n"; print "Bye...\n";
Prawdę powiedziawszy polecenia convert/mogrify/wget
też są `wbudowane'
w skrypt Perla. Całe zadanie realizuje jeden skrypt, który w efekcie wypisuje
na ekran powyższy komunikat:
## Fragment skryptu $GETMAXFALA='/home/pi/bin/getMaxFala.pl'; ## ... ## for $h (@Hours) { $hrNo = sprintf "%03.3i", $h; $url= "$URL/${yyyymmdd}00/wavehgt_0W_${yyyymmdd}00_${hrNo}-00.png"; ###print STDERR "$url\n"; system ("wget $url -O W_${yyyymmdd}00_${hrNo}-00.png"); system ("convert W_${yyyymmdd}00_${hrNo}-00.png -crop 280x330+125+350 -fill red" . " -annotate +140+360 '$monthNo/${dayNo}+${hrNo}' -pointsize 24 -fill blue" . " W_${yyyymmdd}00_${hrNo}-00_C.png"); #### Miniatura zatoki system ("convert W_${yyyymmdd}00_${hrNo}-00.png -crop 65x86+280+575 W_${yyyymmdd}00_${hrNo}-00_D.png"); $maxFala = `convert "W_${yyyymmdd}00_${hrNo}-00_D.png" -define histogram:unique-colors=true -format %c histogram:info:- | $GETMAXFALA`; chomp($maxFala); $files .= "W_${yyyymmdd}00_${hrNo}-00_C.png "; $files_S .= "W_${yyyymmdd}00_${hrNo}-00_D.png "; $faleMax{"+${hrNo}"}=$maxFala; } system ("montage $files -tile 2x4 -border 4 -geometry 480 W_${yyyymmdd}.png" ); system ("montage $files_S -tile 2x4 -border 4 -geometry 480 S_${yyyymmdd}.png" ); $maxFF = max(values(%faleMax)); chomp($maxFF); ## .. ##
Ten komunikat (w potoku) czyta inny skrypt i wysyła listy do zainteresowanych.
MZ to Ministerstwo Zdrowia. Specyfiką PL jest brak danych publicznych nt. Pandemii.. Na stronie GIS nie ma nic, a stacje wojewódzkie publikują jak chcą i co chcą. Ministerstwo zdrowia z kolei na swojej stronie podaje tylko dane na bieżący dzień, zaś na amerykańskim Twitterze publikuje komunikaty na temat. To co jest na stronie znika oczywiście następnego dnia zastępowane przez inne cyferki. Do tego są tam tylko dzienne dane zbiorcze o liczbie zarażonych i zmarłych, (w podziale na województwa). Nie ma na przykład wieku, płci itp... To co jest na Twitterze z kolei ma formę tekstowego komunikatu postaci: Mamy 502 nowe i potwierdzone przypadki zakażenia #koronawirus z województw: małopolskiego (79), śląskiego (77), mazowieckiego (75)... [...] Z przykrością informujemy o śmierci 6 osób zakażonych koronawirusem (wiek-płeć, miejsce zgonu): 73-K Kędzierzyn-Koźle, 75-M Łańcut, 92-K Lipie, 72-M, 87-M, 85-K Gdańsk.
Czyli podają zarażonych ogółem i w podziale na województwa oraz dane indywidualne zmarłych w postaci płci i wieku oraz miejsca zgonu (miasta żeby było inaczej niż w przypadku podawania zakażeń.)
No więc chcę wydłubać dane postaci 92-K z tweetów publikowanych
przez Ministerstwo Zdrowia. W tym celu za pomocą
tweepy
pobieram cały streamline (+3200 tweetów zaczynających się jeszcze w 2019 roku),
ale dalej to już działam w Perlu, bo w Pythonie jakby mniej komfortowo się czuję.
Po pierwsze zamieniam format json na csv:
use JSON; use Data::Dumper; use Time::Piece; use open ":encoding(utf8)"; use open IN => ":encoding(utf8)", OUT => ":utf8"; binmode(STDOUT, ":utf8"); ## ID = tweeta ID; date = data; ## repid -- odpowiedź na tweeta o numerze ID ## text -- tekst tweeta print "id;date;repid;text\n"; while (<>) { chomp(); $tweet = $_; my $json = decode_json( $tweet ); #print Dumper($json); $tid = $json->{"id"}; $dat = $json->{"created_at"}; ## Data jest w formacie rozwlekłym zamieniamy na YYYY-MM-DDTHH:MM:SS ## Fri Oct 04 14:48:25 +0000 2019 $dat = Time::Piece->strptime($dat, "%a %b %d %H:%M:%S %z %Y")->strftime("%Y-%m-%dT%H:%M:%S"); $rep = $json->{"in_reply_to_status_id"}; $ttx = $json->{"full_text"}; $ttx =~ s/\n/ /g; ## Zamieniamy ; na , w tekście żeby użyć ; jako separatora $ttx =~ s/;/,/g; #### print "$tid;$dat;$rep;$ttx\n";
Komunikaty dłuższe niż limit Twittera są dzielone na kawałki, z których każdy jest odpowiedzią na poprzedni, np:
1298900644267544576;2020-08-27T08:30:20;1298900642522685440;53-M, 78-K i 84-K Kraków. Większość osób ... 1298900642522685440;2020-08-27T08:30:20;1298900640714948608;67-K Lublin (mieszkanka woj. podkarpackiego), 85-K Łańcut,... 1298900640714948608;2020-08-27T08:30:19;1298900639586680833;kujawsko-pomorskiego (24), świętokrzyskiego (18), opolskiego... 1298900639586680833;2020-08-27T08:30:19;;Mamy 887 nowych i potwierdzonych przypadków zakażenia #koronawirus z województw: ...
Czyli tweet 1298900639586680833 zaczyna, 1298900640714948608 jest odpowiedzią na 1298900639586680833,
a 1298900642522685440 odpowiedzią na 1298900640714948608 itd. Tak to sobie wymyślili...
W sumie chyba niepotrzebnie, ale w pierwszym kroku agreguję podzielone komunikaty
w ten sposób, że wszystkie odpowiedzi są dołączane
do pierwszego tweeta (tego z pustym polem in_reply_to_status_id
):
## nextRef jest rekurencyjna zwraca numer-tweeta, ## który jest początkiem wątku sub nextRef { my $i = shift; if ( $RR{"$i"} > 0 ) { return ( nextRef( "$RR{$i}" ) ); } else { return "$i" } } ### ### ### while (<>) { chomp(); ($id, $d, $r, $t) = split /;/, $_; $TT{$id} = $t; $RR{$id} = $r; $DD{$id} = $d; } ### ### ### for $id ( sort keys %TT ) { $lastId = nextRef("$id"); $LL{"$id"} = $lastId; $LLIds{"$lastId"} = "$lastId"; } ### ### ### for $id (sort keys %TT) { ## print "### $DD{$id};$id;$LL{$id};$TT{$id}\n"; } $TTX{$LL{"$id"}} .= " " . $TT{"$id"}; $DDX{$LL{"$id"}} .= ";" . $DD{"$id"}; } ### ### ### for $i (sort keys %TTX) { $dates = $DDX{"$i"}; $dates =~ s/^;//; ## pierwszy ; jest nadmiarowy @tmpDat = split /;/, $dates; $dat_time_ = $tmpDat[0]; ($dat_, $time_) = split /T/, $dat_time_; $ffN = $#tmpDat + 1; $collapsedTweet = $TTX{$i}; print "$i;$dat_;$time_;$ffN;$collapsedTweet\n"; }
Zapuszczenie powyższego powoduje konsolidację wątków, tj. np. powyższe 4 tweety z 2020-08-27 połączyły się w jeden:
1298900639586680833;2020-08-27;08:30:19;4; Mamy 887 nowych i potwierdzonych przypadków zakażenia #koronawirus z województw: małopolskiego (233), śląskiego (118), mazowieckiego (107), [...] Liczba zakażonych koronawirusem: 64 689 /2 010 (wszystkie pozytywne przypadki/w tym osoby zmarłe).
Teraz wydłubujemy tylko tweety z frazą nowych i potwierdzonych albo nowe i potwierdzone:
## nowych i potwierdzonych albo nowe i potwierdzone ## (MZ_09.csv to CSV ze `skonsolidowanymi' wątkami) cat MZ_09.csv | grep 'nowych i pot\|nowe i pot' > MZ_09_C19.csv wc -l MZ_09_C19.csv 189 MZ_09_C19.csv
Wydłubanie fraz wiek-płeć ze skonsolidowanych wątków jest teraz proste:
perl -e ' while (<>) { ($i, $d, $t, $c, $t) = split /;/, $_; while ($t =~ m/([0-9]+-[MK])/g ) { ($w, $p) = split /\-/, $1; print "$d;$w;$p\n"; } }' MZ_09_C19.csv > C19D.csv wc -l C19PL_down.csv 1738
Plik wykazał 1738 osób. Pierwsza komunikat jest z 16 kwietnia. Ostatni z 31. sierpnia. Pierwsze zarejestrowane zgony w PL odnotowano 12 marca (albo 13 nieważne). W okresie 12 marca --15 kwietnia zmarło 286 osób. Dodając 286 do 1738 wychodzi 2024. Wg MZ w okresie 12.03--31.08 zmarło 2039. Czyli manko wielkości 15 zgonów (około 0,5%). No trudno, nie chce mi się dociekać kto i kiedy pogubił tych 15...
Równie prostym skryptem zamieniam dane indywidualne na tygodniowe
#!/usr/bin/perl -w use Date::Calc qw(Week_Number); while (<>) { chomp(); ##if ($_ =~ /age/) { next } ## my ($d, $w, $p ) = split /;/, $_; my ($y_, $m_, $d_) = split /\-/, $d; my $week = Week_Number($y_, $m_, $d_); $DW{$week} += $w; $DN{$week}++; $DD{$d} = $week; $YY{$week} = 0; $YY_last_day{$week} = $d; ## wiek wg płci $PW{$p} += $w; $PN{$p}++; } for $d (keys %DD) { $YY{"$DD{$d}"}++; ## ile dni w tygodniu } print STDERR "Wg płci/wieku (ogółem)\n"; for $p (keys %PW) { $s = $PW{$p}/$PN{$p}; printf STDERR "%s %.2f %i\n", $p, $s, $PN{$p}; $total += $PN{$p}; } print STDERR "Razem: $total\n"; print "week;deaths;age;days;date\n"; for $d (sort keys %DW) { if ($YY{$d} > 2 ) {## co najmniej 3 dni $s = $DW{$d}/$DN{$d}; printf "%s;%i;%.2f;%i;%s\n", $d, $DN{$d}, $s, $YY{$d}, $YY_last_day{$d}; } }
Co daje ostatecznie (week
-- numer tygodnia w roku;
meanage
-- średni wiek zmarłych;
deaths
-- liczba zmarłych w tygodniu;
days
-- dni w tygodniu;
date
-- ostatni dzień tygodnia):
week;deaths;meanage;days;date 16;55;77.07;4;2020-04-19 17;172;75.09;7;2020-04-26 18;144;77.29;7;2020-05-03 19;123;76.46;7;2020-05-10 20;126;76.40;7;2020-05-17 21;71;76.37;7;2020-05-24 22;68;78.12;7;2020-05-31 23;93;75.73;7;2020-06-07 24;91;75.93;7;2020-06-14 25;109;77.24;7;2020-06-21 26;83;75.06;7;2020-06-28 27;77;74.09;7;2020-07-05 28;55;76.91;7;2020-07-12 29;54;77.33;7;2020-07-19 30;48;76.52;7;2020-07-26 31;60;74.88;7;2020-08-02 32;76;77.17;7;2020-08-09 33;71;73.11;7;2020-08-16 34;77;75.61;7;2020-08-23 35;79;74.33;7;2020-08-30
To już można na wykresie przedstawić:-)
library("dplyr") library("ggplot2") library("scales") ## spanV <- 0.25 d <- read.csv("C19D_weekly.csv", sep = ';', header=T, na.string="NA") first <- first(d$date) last <- last(d$date) period <- sprintf ("%s--%s", first, last) d$deaths.dailymean <- d$deaths/d$days cases <- sum(d$deaths); max.cases <- max(d$deaths) note <- sprintf ("N: %i (source: twitter.com/MZ_GOV_PL)", cases) pf <- ggplot(d, aes(x= as.Date(date), y=meanage)) + geom_bar(position="dodge", stat="identity", fill="steelblue") + scale_x_date( labels = date_format("%m/%d"), breaks = "2 weeks") + scale_y_continuous(breaks=c(0,5,10,15,20,25,30,35,40,45,50,55,60,65,70,75,80)) + xlab(label="week") + ylab(label="mean age") + ggtitle(sprintf ("Mean age of COVID19 fatalities/Poland/%s", period), subtitle=note ) note <- sprintf ("N: %i (source: twitter.com/MZ_GOV_PL)", cases) pg <- ggplot(d, aes(x= as.Date(date), y=deaths.dailymean)) + geom_bar(position="dodge", stat="identity", fill="steelblue") + scale_x_date( labels = date_format("%m/%d"), breaks = "2 weeks") + scale_y_continuous(breaks=c(0,5,10,15,20,25,30,35,40,45,50)) + xlab(label="week") + ylab(label="daily mean") + ggtitle(sprintf("Daily mean number of COVID19 fatalities/Poland/%s", period), subtitle=note ) ggsave(plot=pf, file="c19dMA_w.png") ggsave(plot=pg, file="c19dN_w.png")
Wynik tutaj:
Średnia Wg płci/wieku/ogółem. Ogółem -- 75,9 lat (1738 zgonów) w tym: mężczyźni (914 zgonów) -- 73.9 lat oraz kobiety (824) -- 78.4 lat. Stan pandemii na 31.08 przypominam. Apogeum 2 fali... Średnia wieku w PL (2019 rok) 74,1 lat (M) oraz 81,8 lat (K).
Google has launched a new website that uses anonymous location data collected from users of Google products and services to show the level of social distancing taking place in various locations. The COVID-19 Community Mobility Reports web site will show population data trends of six categories: Retail and recreation, grocery and pharmacy, parks, transit stations, workplaces, and residential. The data will track changes over the course of several weeks, and as recent as 48-to-72 hours prior, and will initially cover 131 countries as well as individual counties within certain states. (cf. www.google.com/covid19/mobility/.)
The raports contains charts and comments in the form:
NN% compared to baseline (in six above mentioned categories) where NN is a number.
It is assumed the number is a percent change at the last date
depicted (which accidentaly is a part of a filename). So for example a filename
2020-03-29_PL_Mobility_Report_en.pdf
contains a sentence `Retail & recreation -78% compared to baseline` which (probably)
means that (somehow) registered traffic at R&R facilities was 22% of the baseline.
Anyway those six numbers was extracted for OECD countries (and some other countries)
and converted to CSV file.
The conversion was as follows: first PDF files was downloaded with simple Perl script:
#!/usr/bin/perl # https://www.google.com/covid19/mobility/ use LWP::UserAgent; use POSIX 'strftime'; my $sleepTime = 11; %OECD = ('Australia' => 'AU', 'New Zealand' => 'NZ', 'Austria' => 'AT', 'Norway' => 'NO', 'Belgium' => 'BE', 'Poland' => 'PL', 'Canada' => 'CA', 'Portugal' => 'PT', 'Chile' => 'CL', 'Slovak Republic' => 'SK', ## etc ... ); @oecd = values %OECD; my $ua = LWP::UserAgent->new(agent => 'Mozilla/5.0', cookie_jar =>{}); my $date = "2020-03-29"; foreach $c (sort @oecd) { $PP="https://www.gstatic.com/covid19/mobility/${date}_${c}_Mobility_Report_en.pdf"; my $req = HTTP::Request->new(GET => $PP); my $res = $ua->request($req, "${date}_${c}_Mobility_Report_en.pdf"); if ($res->is_success) { print $res->as_string; } else { print "Failed: ", $res->status_line, "\n"; } }
Next PDF files was converted to .txt
with pdftotext
. The relevant
fragments of .txt
files looks like:
Retail & recreation +80% -78% compared to baseline
So it looks easy to extract the relevant numbers: scan line-by-line looking for a line with appropriate content (Retail & recreation for example). If found start searching for 'compared to baseline'. If found retrieve previous line:
#!/usr/bin/perl $file = $ARGV[0]; while (<>) { chomp(); if (/Retail \& recreation/ ) { $rr = scan2base(); } if (/Grocery \& pharmacy/ ) { $gp = scan2base(); } if (/Parks/ ) { $parks = scan2base(); } if (/Transit stations/ ) { $ts = scan2base(); } if (/Workplaces/ ) { $wps = scan2base(); } if (/Residential/ ) { $res = scan2base(); print "$file;$rr;$gp;$parks;$ts;$wps;$res\n"; last; } } sub scan2base { while (<>) { chomp(); if (/compared to baseline/) { return ($prevline); } $prevline = $_; } }
Extracted data can be found here.
Na okoliczność wielu zdjęć z jednego miejsca można dodać losowy szum (jitter). Czy to ma sens to już inna sprawa. Ja dodałem jitter (kołowy) do zdjęć zrobionych w fabryce jedwabiu w Margilan
#!/usr/bin/perl ### Add jitter to Geocoordinates use Math::Complex; use Math::Trig; use Getopt::Long; use Image::ExifTool; use Geo::Distance; ## my $sd =.002; ### max about 200m print STDERR "USAGE $0 [-d] DIAMETER -c COORDINATES -f FILE (DIAMETER=0.002 is circa 200m!)\n"; GetOptions("d=i" => \$sd, "c=s" => \$coords, "f=s" => \$file ); my $factor = 0.00001; my $init_shift = 0.00001; my $pi = 4*atan2(1,1); ##$sd = sqrt($factor * $Skad{$skad}); my $r = $sd * sqrt(rand()); my $theta = rand() * 2 * $pi; ($lat, $lon) = split (/[:;,]/, $coords); $rand_lat = $lat + $r * cos($theta); $rand_lon = $lon + $r * sin($theta); my $eT = new Image::ExifTool; $eT->SetNewValue(GPSLatitudeRef => ($rand_lat > 0)?'N':'S', Group=>'GPS'); $eT->SetNewValue(GPSLongitudeRef => ($rand_lon > 0)?'E':"W", Group=>'GPS'); $eT->SetNewValue(GPSLatitude => abs($rand_lat), Group=>'GPS'); $eT->SetNewValue(GPSLongitude => abs($rand_lon), Group=>'GPS'); my $old_comment = $eT->GetValue('UserComment', 'ValueConv'); if ($old_comment) { $exif_comment = "$old_comment | GPS coordinates jigged"; } else { $exif_comment = "GPS coordinates jigged"; } $eT->SetNewValue(UserComment => "$exif_comment"); if (-f $file) { $file_org = "${file}_orig"; if ( system("cp", "$file", "$file_org") == 0 ) { $eT->WriteInfo("$file"); print STDERR "$file updated\n"; } else { print STDERR "*** $file update failed\n"; } } else { print STDERR "*** ERROR with $file\n"; } my $geo = new Geo::Distance; $dist = $geo->distance( "meter", $lon, $lat => $rand_lon, $rand_lat ); print STDERR "Laat/Lon: $lat, $lon => $rand_lat, $rand_lon (Dist: $dist)\n";
Przykładowa mapa jest tutaj
To był rekordowy rok w wielu kategoriach:-)
Zacznijmy od pogody, którą mierzę od 2010 roku przypominam. U mnie średnia wyszła 9,56 C, do tej pory rekord to było 9,44 C w 2015 r. Szczegółowo to tak wygląda:
rok : 2010 2011 2012 2013 2014 2015 2016 2017 2018 -------------------------------------------------------------- średnia : 8.65 8.94 8.17 8.63 9.33 9.44 9.18 8.75 9.56
Rekordowo niska była też suma opadów: 447.9mm (148 dni opadowych); dla porównania w 2017 roku spadło 763,8mm deszczu (194 dni). Rekord do tej pory to 2014 rok: 450,6 (148 dni) czyli w zasadzie tyle samo (z dokładnością do błędu).
Na rowerze przejechałem 19,100 km (302 razy, co nie oznacza dni, bo czasami były dwa razy dziennie). Poprzedni rekord z 2017 r wynosił 17,855 km. Z tej okazji podsumowałem swoje życiowe wyczyny, a mam statystykę szczegółową od 1993 r. Kurcze 26 lat pykło, w których to latach przejechałem prawie 210 tys km. Do tego w latach 1990--1992 przejechałem ponad 20 tys km, ale nie zachowała się niestety dokładna rozpiska. Z okazji tych wszystkich wyczynów podsumowanie zrobiłem wg dni tygodnia i wg. tygodni w roku (wg. miesięcy to liczę na bieżąco). Konkretnie to podsumowanie jest zestawem 7 wykresów słupkowych rysowanych w R. Dane do skryptu i sam skrypt jest z kolei generowany przez prosty program w Perlu:
#!/usr/bin/perl -w use Date::Calc qw(Week_Number Day_of_Week); ##my $RRcmd = 'R CMD BATCH'; ## see below my $color= 'pink'; my $current_yr = 2019; my %Miesiac = (1 => 'styczeń', 2 => 'luty', 3 => 'marzec', 4 => 'kwiecień', 5 => 'maj', 6 => 'czerwiec', 7 => 'lipiec', 8 => 'sierpień', 9 => 'wrzesień', 10 => 'październik', 11 => 'listopad', 12 => 'grudzień',); my %DoWName = ( 1 => 'pon', 2 => 'wto', 3=> 'sro', 4 => 'czw', 5 => 'pia', 6 => 'sob', 7 => 'nie' ); open(O, ">dow.R") || die "Cannot open!\n"; open(P, 'LANG=C grep "dist\|date" c*.xml|' ) || die "Cannot open!\n"; while (<P>) { chomp(); ##print ">>$_;"; if (/date[^'"]+["']([0-9\/]+)["']/) {$date = "$1";} if (/dist[^'"]+["']([0-9\/]+)["']/) {$D{$date} += $1;} } close(P) || die "Cannot close!\n"; for $d (sort keys %D ) { ($dyy, $dmm, $ddd) = split '/', $d; if ($dyy == $current_yr ) { next } ### skip as incomplete my $dow = Day_of_Week($dyy,$dmm,$ddd); $DoWs{$dow} += $D{$d}; $DoWNums{$dow}++; my $woy = Week_Number($dyy,$dmm,$ddd); $WoYs{$woy} += $D{$d}; $WoYNums{$woy}++; $RdT++; $Years{$dyy}=1; } @YNo = sort(keys (%Years)); $YNo = $#YNo +1; print O "##Generated content == do not edit\n"; print O "##By Day of Week\n"; # for $d (sort keys %DoWs) { $mean = sprintf "%.1f", $DoWs{$d} / $DoWNums{$d}; $t += $DoWs{$d}; $days_totals .= "$DoWs{$d}, "; $days_means .= "$mean, "; $days_ns .= "$DoWNums{$d}, "; $days_labels .= "'" . $DoWName{$d} . "', "; ##printf "%-12.12s %7i %.1f (%i)\n", $DoWName{$d}, $DoWs{$d}, $mean, $DoWNums{$d}; ; } $days_totals =~ s/, $//; $days_means =~ s/, $//; ##$days_ymeans =~ s/, $//; $days_ns =~ s/, $//; $days_labels =~ s/, $//; print O "days_totals <- c($days_totals); days_means <- c($days_means); days_ns <- c($days_ns); days_labels <- c($days_labels);\n"; print O "barplot(days_totals, main='Distance (total $YNo[0]--$YNo[$#YNo]): $t kms', horiz=F, names.arg=days_labels, col=c('$color')); barplot(days_means, main='Day means ($YNo[0]--$YNo[$#YNo])', horiz=F, names.arg=days_labels, col=c('$color')); barplot(days_ns, main='RideDays (total): $RdT', horiz=F, names.arg=days_labels, col=c('$color'));\n"; print STDERR "##Razem: $t\n"; ##print "====\n"; print O "\n\n##By Week of Year\n"; for $w (sort {$a <=> $b } keys %WoYs) { $mean = sprintf "%.1f", $WoYs{$w} / $WoYNums{$w}; $vals_totals .= "$WoYs{$w}, "; $vals_ymeans .= sprintf "%.1f, ", $WoYs{$w}/$YNo; $vals_means .= "$mean, "; $vals_ns .= "$WoYNums{$w}, "; $vals_labels .= "$w, "; } $vals_totals =~ s/, $//; $vals_means =~ s/, $//; $vals_ymeans =~ s/, $//; $vals_ns =~ s/, $//; $vals_labels =~ s/, $//; print O "vals_totals <- c($vals_totals); vals_ymeans <- c($vals_ymeans); vals_means <- c($vals_means); vals_ns <- c($vals_ns); vals_labels <- c($vals_labels);\n"; print O "barplot(vals_totals, main='Distance (total $YNo[0]--$YNo[$#YNo]): $t kms', horiz=F, names.arg=vals_labels, col=c('$color')); barplot(vals_ymeans, main='Weak means ($YNo[0]--$YNo[$#YNo])', horiz=F, names.arg=vals_labels, col=c('$color')); barplot(vals_means, main='Day means ($YNo[0]--$YNo[$#YNo])', horiz=F, names.arg=vals_labels, col=c('$color')); barplot(vals_ns, main='RideDays (total): $RdT', horiz=F, names.arg=vals_labels, col=c('$color'));\n"; print O "### ENDE!\n"; close(O); print STDERR "##R dow.R\n"; system ("R", "CMD", "BATCH", "dow.R"); print STDERR "##xpdf Rplots.pdf\n"; print STDERR "##convert -density 300 Rplots.pdf opus_by_dow.jpg\n"; system ("convert", "-density", "300", "Rplots.pdf", "opus_by_dow.jpg");
Na koniec przyznam że mam mieszane uczucia co do zeszłorocznego wyczynu, w sensie że za dużo wyszło. Oprócz roweru też jest życie...
Tak więc w przyszłym roku raczej rekordu nie będzie.
Co wybory to inaczej oczywiście...
Wyniki wyborów 2010 są na stronie http://wybory2010.pkw.gov.pl/
.
Punktem wyjścia jest zaś strona z wynikami dla województwa
postaci
http://wybory2010.pkw.gov.pl/geo/pl/020000/020000-o-020000-RDA-2.html?wyniki=1
,
w której wiodące 02
z 020000
to kod teryt województwa a 2
przed .html
to numer okręgu wyborczego. Zatem pobranie wszystkich stron
`okręgowych' sprowadza się do:
#!/usr/bin/perl # use LWP::Simple; # my $uribase = 'http://wybory2010.pkw.gov.pl/geo/pl'; @Woj = ("02", "04", "06", "08", "10", "12", "14", "16", "18", "20", "22", "24", "26", "28", "30", "32"); @Okr = (1,2,3,4,5,6,7,8,9,10); ## nadmiarowo (max jest 8 chyba) for $w (@Woj) { for $o (@Okr) { $url = "$uribase/${w}0000/${w}0000-o-${w}0000-RDA-${o}.html?wyniki=1"; $file = "ws2010_woj_${w}_${o}"; getstore($url, $file); print STDERR "$url stored\n"; } }
Teraz się okazuje że każdy taki plik zawiera odnośniki
postaci /owk/pl/020000/2c9682212bcdb46c012bcea96efe0131.html
.
Każdy taki plik opisuje kandydata startującego w wyborach.
Ich pobranie jest równie banalne:
#!/usr/bin/perl # use LWP::Simple; use locale; use utf8; binmode(STDOUT, ":utf8"); use open IN => ":encoding(utf8)", OUT => ":utf8"; $baseURI="http://wybory2010.pkw.gov.pl"; $file = $ARGV[0]; while (<>) { chomp(); if (/(owk\/[^<>"]*)/) { $url= "$baseURI/$1"; if (/(owk\/[^<>"]*)[^<>]*>([^<>]*)/) { $who = "$2"; $who =~ s/ //g; $who =~ tr/ĄĆĘŁŃÓŚŻŹ/ACELNOSZZ/; $who =~ tr/ąćęłńóśżź/acelnoszz/; } else {$who = "XxYyZz"; } $outFile = "owk_${file}__${who}"; getstore($url, $outFile); print STDERR "$url stored ($outFile)\n"; } } ## pobranie wszystkich owk-URLi to: ## for i in ws2010_woj* ; do perl pobierz-owk.pl $i ; done
W plikach `owk' są linki do protokołów z wynikami z poszczególnych komisji.
Są to linki postaci:
/obw/pl/3206/bacbedd03197794e2e1e8e438bff87e1.html
. Należy
je wszystkie pobrać (URLe nie pliki) i posortować usuwając duplikaty.
Powinno być takich URLi około 25--27 tysięcy (tyle ile komisji):
#!/usr/bin/perl # $baseURI="http://wybory2010.pkw.gov.pl"; $file = $ARGV[0]; while (<>) { chomp(); if (/(obw\/[^<>"]*)/) { $url= "$baseURI/$1"; if (/(obw\/[^<>"]*)[^<>]*>([^<>]*)/) { $obwNr = "$2"; } $outFile = "${file};${obwNr}"; print "$url;$outFile\n"; } } ## for i in owk_2010* ; do perl pobierz-obw.pl $i ; done > proto0.csv ## awk -F';' '{print $1";"$3}' proto0.csv | sort -u > protokoly.csv ## wc -l protokoly.csv ## 25464 protokoly.csv
Każdy URL jest postaci /obw/pl/0201/051595429cc31a526f8b2455602ab929.html
.
Te 0201
to pewnie teryt powiatu,
ale reszta wydaje się losowa więc
nie da się ustalić jakiegoś schematu URLi protokołów, bo go nie ma po prostu.
Teraz postaje pobrać te 25464 plików-protokołów z komisji
obwodowych. Na wszelki wypadek będę zapisywał te protokoły wg schematu:
proto_ws_2010_terytPowiatu_nrkomisji
:
#!/usr/bin/perl ## use LWP::Simple; open (O, "protokoly.csv") || die "No protokoly.csv!"; while (<O>) { chomp(); ($url, $nrk) = split /;/, $_; $_ =~ m#http://wybory2010.pkw.gov.pl/obw/pl/([0-9][0-9][0-9][0-9])#; $teryt = $1; $outFile = "proto_ws_2010_${teryt}_$nrk"; getstore($url, $outFile); print STDERR "*** $url stored ($outFile)\n"; } close(O); ## time perl get-proto.pl
Mi się ściągało 62 minuty 30 sekund.
Z jakiś powodów obsługi przez Perla UTFa nie może być bezszmerowa. Zawsze coś nie działa i zawsze jest problem. I zawsze jest kombinowanie co by tu wstawić za zaklęcia żeby działało. Np. to zwykle działa:
#!/usb/bin/perl use locale; use utf8; binmode(STDOUT, ":utf8"); ##use open ":encoding(utf8)"; use open IN => ":encoding(utf8)", OUT => ":utf8";
albo to poniżej też czasami działa (wtedy kiedy powyższe nie działa):
use utf8; binmode(STDOUT, ":utf8"); use open ":encoding(utf8)";
Czasami nawet nie potrzeba ostatniego
use open ":encoding(utf8)";
. Czemu nie wiem. Nadmiarowe
polecenia psują kodowanie BTW (jakby ktoś myślał, że jak wstawi wszystkie
polecenia, które dotyczą kodowania UTF ,,na zapas'' to będzie zawsze dobrze.)
W zeszłym roku wziąłem udział w imprezie kolarsko-rekreacyjnej pn. Żuławy w Koło, a teraz zapisałem się na Kociewie Kołem, która ma się odbyć 9 września. Ta sama firma organizuje jak się łatwo domyśleć.
Żeby nie jechać w ciemno pobrałem stosowne dane ze strony organizatora, zamieniłem je na plik CSV i policzyłem różne statystyki. W 2016 średnia prędkość na najdłuższym dystancie (170 km) wyniosła na przykład 27,05 km/h. Rok później (dystans 155 km) było to 26,69 km/h. Czyli sporo, bo na płaskiej i krótszej trasie Żuławy w Koło było dla przykładu w 2016 roku 25,47 km/h, a w 2017 26,23 km/h. Więcej szczegółów na wykresach pudełkowych obok.
Ściągnąłem też w środę listę uczestników, których okazało się jest 719, w tym z Gdańska 332, z Gdyni 107, a tak w ogóle to ze 120 różnych miejscowości. Za pomocą Google Fusion Tables można pokazać listę na mapie. Żeby kropki z tej samej miejscowości się nie nakładały na siebie zastosowałem losowe `drganie' (jitter) wg. algorytmu:
### Jitter w kole o średnicy $r $factorJ = 0.00001; ## ustalone heurystycznie $sd = sqrt($factorJ * $N); # $N liczba kropek dla miejscowosci, tj dla GDA 332 $r = $sd * sqrt(rand()); $theta = rand() * 2 * $pi; $rand_lat = $lat + $r * cos($theta); $rand_lon = $lon + $r * sin($theta); ### Jitter w prostokącie o boku $r $rand_lat = $lat + rand($sd); $rand_lon = $lon + rand($sd);
Rezultat jak na obrazku poniżej, albo tutaj.
Lewy obrazek to mapa bez `jittera' a prawy z zastosowanym `jitterem'.
Kolega L. mi zadanie zlecił, w którym wykorzystywaną bazą musi być MS SQL.
Podchodziłem do tego jak do jeża, ale wreszcie się przełamałem, usiadłem
i działa (aż dziwne). W skład zadania wchodzi też baza danych pn. GraphiPlus
,
która zawiera m.in. tabele
o nazwach dbo.FACTURES
oraz dbo.SOCIETES
:
#!/usr/bin/perl use strict; use utf8; use DBI; require DBD::ODBC; my $serverN = 'E5410-KOMPUTER\\SQLEXPRESS'; my $baseN = 'GraphiPlus'; my $dsN = "GraphiPlus"; ## Obie formy działają (pierwsza przez DSN = Data Source Name/Źródło danych) ## Definiowanie DSN: Panel_Sterowania→Wszystkie_Elementy→ ## Narzędzia_Administracyjne→Źródła_danych_(ODBC) # my $dbh = DBI->connect("dbi:$dsN", '<UID>', '<PASSWD>', # { RaiseError => 1 } ) or die DBI->errstr; # Albo my $dbh = DBI->connect("dbi:ODBC:driver={SQL Server};Server=$serverN;database=$baseN;uid=<UID>;pwd=<PASSWD;", {RaiseError => 1, } ) or die DBI->errstr; print "*** Połączono z $baseN ***\n"; ## małe litery do.TABELA są istotne! my $sth = $dbh->prepare("SELECT * FROM dbo.FACTURES ") || die "ERROR" . $dbh->errstr ; $sth ->execute(); print "**** Tabela FACTURES:\n"; while ( my @invoiceRecord = $sth->fetchrow_array() ) { print (join(";", @invoiceRecord) . "\n"); } ## musi być (w mySQL niekoniecznie) $sth->finish(); print "**** Tabela SOCIETESS:\n"; my $sth = $dbh->prepare("SELECT * FROM dbo.SOCIETES ") || die "ERROR" . $dbh->errstr ; $sth ->execute(); while ( my @invoiceRecord = $sth->fetchrow_array() ) { print (join(";", @invoiceRecord) . "\n"); } $sth->finish(); $dbh->disconnect(); ###
Gdybym nie znał nazw tabel to można je ustalić albo za pomocą SQL Server Management Studio,
albo wykonując polecenie SELECT
na systemowej tabeli pn. sys.tables
:
my $sts = $dbh->prepare("SELECT name FROM sys.tables ") || die "ERROR" . $dbh->errstr ;
Contour+ ma GPSa i rejestruje współrzędne geograficzne, tyle że do niedawna nie bardzo wiedziałem jak (słusznie podejrzewałem że w postaci napisów aka subtitles). Wreszcie rozkminiłem jak to działa, a zmobilizowały mnie filmy zarejestrowane podczas imprezy Żuławy wKoło 2017.
Najpierw trzeba ustalić co jest w środku pliku .mov
:
ffmpeg -i FILE0037.MOV ## ## ## Stream #0:2(eng): Subtitle: mov_text (text / 0x74786574), 1 kb/s (default)
Teraz można wyciągnąć napis znajdujący się w strumieniu (stream) 2:
ffmpeg -i FILE0037.MOV -vn -an -codec:s:0.2 srt file0037_2.srt
W pliku file0037_2.srt
jest coś takiego:
692 00:11:31,000 --> 00:11:32,000 $GPRMC,061159.00,V,,,,,,,240917,,,N*7E $GPGGA,061159.00,,,,,0,04,2.18,,,,,,*53 693 00:11:32,000 --> 00:11:33,000 $GPRMC,061200.00,A,5412.74161,N,01906.66188,E,18.465,202.51,240917,,,A*50 $GPGGA,061200.00,5412.74161,N,01906.66188,E,1,04,2.18,6.5,M,32.4,M,,*58
Czyli jest to zwykły plik napisów w formacie SRT, tj. sekwencja rekordów składających się z wierszy tekstu. Pierwszy wiersz zawiera numeru napisu (692 na przykład). Drugi wiersz określa czas wyświetlania napisu (początek --> koniec). Kolejne wiersze to tekst napisu. W przykładzie powyżej napis 692 jeszcze nie złapał fiksa, a napis 693 już tak. Współrzędne są zarejestrowane w postaci par zdań (sentences) GPRMC/GPGGA w standardzie NMEA. Do konwersji czegoś takiego na format GPX na przykład można zastosować gpsbabela
gpsbabel -i nmea -f file.srt -o GPX -F file.gpx
Ale wtedy gubi się informację z pierwszych dwóch wierszy rekordu, a jest ona niezbędna do synchronizacji obrazu ze współrzędnymi w programach nie potrafiących wykorzystać napisów wbudowanych. Chciał-nie-chciał musiałem rozpoznać NMEA i dokonać konwersji po swojemu:
$GPRMC,time,###,dd.mm,N/S,dd.mm,E/W,speed,###,date,###,###,### $GPGGA,time,dd.mm,N/S,dd.mm,E/W,q,s,###,ele,M,###,M,###,###
Gdzie: speed
-- prędkość w węzłach czyli milach/godzinę;
date
-- data w formacie ddmmyy;
time
-- czas w formacie hhmmss.ss
;
dd.mm
-- współrzędne geograficzne w formacie stopnieminuty.minuty
tj 5412.74161
oznacza 54 stopnie 12.74161 minut
a 01906.66188
oznacza 19 stopni 6.66188 minut
(uwaga: szerokość/długość ma różną liczbę cyfr przed kropką dziesiętną);
N/S/E/W
-- kierunki geograficzne (north, south itp);
q
-- jakość sygnału (niezerowa wartość jest OK);
s
-- liczba satelitów;
ele
-- wysokość npm. (w metrach na szczęście w przypadku Contoura+).
Zawartość pól oznaczona jako ###
nas nie interesuje.
Symbol M
oznacza jednostkę miary (metry), z czego
by wynikało, że różne odbiorniki GPS mogą zapisywać informacje o wysokości
z wykorzystaniem
innych jednostek miary.
Teraz banalny skrypt Perlowy zamienia SRT na format GPX dodając informacje
o numerze napisu
i czasie wyświetlania w postaci stosownego elementu cmt
<trkpt lat="54.212360" lon="19.111031"> <ele>6.500000</ele> <time>2017-09-24T06:12:00Z</time> <speed>9.499208</speed> <cmt>693 00:11:32,000 --> 00:11:33,000</cmt> </trkpt>
BTW nie ma elementu speed
w specyfikacji schematu GPX,
ale na przykład gpsbabel
taki element wstawia i jakoś to działa. Sprawa wymaga zbadania.
Uwaga: Garmin Virb Edit nie czyta dokumentów GPX w wersji 1.0 -- musi
być wersja 1.1. W praktyce oznacza to, że element gpx
powinien posiadać atrybuty version
oraz
xmlns
o następujących wartościach
<gpx version="1.1" xmlns="http://www.topografix.com/GPX/1/1">
Skrypt pn. cc2gpx.pl
do konwersji SRT→GPX jest
tutaj.
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
,
Plec
i Ocena
.
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
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).
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 ######
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
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
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.
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.
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
.
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:
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ą:
współrzędne celu podróży (w tym celu zamieniam adres Państwo, miasto na współrzędne geograficzne korzystając z geokodera Google);
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
);
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.
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.
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ć.
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/
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.
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_galerii
→nazwa-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:
<div id='gid_g509'> <span>< 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;"> <img border="0" src="http://lh5.ggpht.com/-NZ_dEAq8qZI/Uhf_OPG9jiI/AAAAAAAADp8/BtBx9DwVgs4/s128/509__1106_016.jpg" height='85' /></a> </span> ... 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