Formeln in LibreOffice Calc mit einem perl-Skript erzeugen

Hier kommt mal wieder eine Kleinigkeit, die mich etwas Mühe gekostet hat: ein perl-Skript, das mir ein XLSX-Spreadsheet erzeugt, in dem funktionierende Formeln eingebettet sind. XLSX ist das XML-Dokumentenformat von Microsoft Office, funktioniert aber auch in LibreOffice. Technisch ist es weit umständlicher als das OpenDocument Format und nicht wirklich frei, aber das soll hier nicht das Thema sein.

Ich bin an und für sich kein großer Office-Benutzer und weiß eigentlich auch nur das Nötigste - aber beruflich hab ich halt doch immer mal wieder den Auftrag, irgendwelche Office-Dateien zu verwenden oder zu liefern. In solchen Fällen versuche ich immer, mir mit Perl-Skripten die Handarbeit vom Hals zu schaffen und stattdessen eine schöne Automation zu verwenden ;-)

Kürzlich wollte nun ein Kollege in ein Spreadsheet, das ich für ihn generiere, in mehreren Zellen eine Verknüpfung zu einem anderen Tabellenblatt ("sheet") eingebaut haben.

Ich hatte größere Schwierigkeiten, die richtige Schreibweise für Formelbefehle und die Zellenkoordinaten zu finden - LibreOffice ist hier zu hilfreich und verbirgt über automatische Korrekturen im Calc-Programm viele Eingabefehler vor dem Benutzer - die Schreibweise aus dem GUI ins Skript übernommen hat nicht funktioniert und beim Öffnen der neuen Datei erhielt ich immer eine Fehlermeldung in allen Zellen mit Formel. Interessant daran: wenn ich im Office-Programm die Formel bearbeitete und abspeicherte, fing sie an zu funktionieren, obwohl ich an der Schreibweise nichts geändert hatte (z.B. einfach ein Zeichen gelöscht und dasselbe Zeichen wieder eingetippt). Das war extrem frustrierend, zeigt es doch, dass hier im Sinne der Bequemlichkeit Dinge in der Software unter der Haube passieren, die man als Benutzer nicht erkennen kann.

Außerdem ist die Syntax zwischen Microsoft Office und LibreOffice leicht unterschiedlich. Auch bei /r/LibreOffice und /r/perl waren die Lösungsvorschläge für meine Fragen breit gestreut, was die mögliche Schreibweise der Formeln angeht. Letztendlich hat sich dann eine Schreibweise gefunden, die bei LibreOffice und MS Office funktioniert - hurra!

Für das Experimentieren hatte ich mir ein winziges Perl-Skript geschrieben, das eine XLSX-Datei mit zwei Sheets erzeugt und in einer Zelle des ersten Blatts einen Verweis auf das zweite Blatt einfügt. Beim Öffnen der Datei mit Office wird dann der Verweis ausgeführt und der referenzierte Wert (im Skript unten grün markiert) erscheint dynamisch in der Formelzelle. Der rot markierte Text wird durch die Zuweisung "$u[4]=..." durch die Formel ersetzt. Die Formel enthält noch Platzhalter %d und %s, um mit printf bestimmte Zeilennummern und Spaltennamen einzusetzen, während die XLSX-Datei erzeugt wird. Die write-Methode für eine Zeile des Spreadsheets erwartet eine Referenz auf ein Array mit den Zelleninhalten, deshalb muss ich als Parameter \@l angeben. Es gibt auch speziellere write-Methoden, mit denen man jede Zelle einzeln befüllen kann, aber write ist meistens gut darin, die Datentypen im Array zu erkennen und die Arbeit intern passend zu delegieren.

Das Spreadsheet sieht dann so aus:

Der erste Tab "unix users" enthält in Zelle E1 die Formel =IFERROR( VLOOKUP( A1; $Lookup.$A$1:$B$10000; 2; 0 );"" ). Statt der Platzhalters %d sieht man die Zeilennummer "1" bzw. die Spaltennummer "2" und statt der %s werden die Spaltennamen "A" und "B" eingesetzt, d.h. der Bereich, in dem nachgeschlagen wird, geht von A1 bis B1000 und es wird bei einem Treffer in A1 der Inhalt der 2. Spalte des Bereichs (hier dann B1) übernommen.
Den Formeltext in kursiv im vorigen Absatz habe ich übrigens aus dem Eingabefeld in LibreOffice kopiert. Man sieht, dass die Schreibweise nicht dem entspricht, was im Skript als Formelschreibweise verwendet wird - hier steht plötzlich $Lookup. und nicht Lookup!. Wenn ich mit unzip in die XLSX-Datei hineinschaue (trotz der Endung ist es eine schlichte Zip-Datei!), sehe ich die Schreibweise zwischen den XML-Tags für die Formel <f> ... </f> so wie im Skript: <f>IFERROR(VLOOKUP(A1,Lookup!$A$1:$B$10000,2,0),"")</f>

Und der zweite Tab "Lookup" enthält für jeden Unixuser die Beschreibung für das GECOS-Feld.

Für eine komplexe Geschichte wie eine XLSX-Datei ist das mit knapp 20 Zeilen perl zu bewerkstelligen. Ich liebe dieses Perl-Modul.

#!/usr/bin/perl -w
use strict 'refs';
use strict 'vars';
use utf8;
use Excel::Writer::XLSX; 

my $excelout = 'formel.xlsx';
my $workbook = Excel::Writer::XLSX->new($excelout);
my $lookupfrm=qq{=IFERROR(VLOOKUP(A%d,Lookup!\$%s\$1:\$%s\$1000,%d,0),"")};
my $worksheet;
my @u=("root","*",0,0,"no gecos","/root","/bin/sh");
my $row=0; 

print STDERR "# write Excel unix users\n";
$worksheet=$workbook->add_worksheet('unix users');
$worksheet->keep_leading_zeros();
$u[4]=sprintf($lookupfrm,1+$row,"A","B",2),
$worksheet->write($row, 0, \@u);
print STDERR "# unix user @u\n"; 

$worksheet=$workbook->add_worksheet('Lookup');
my @l=("root","root user");
$worksheet->write($row, 0, \@l);
print STDERR "# lookup @l\n"; 

$workbook->close();

Excel-Datei mit perl erzeugen

Hach, ich liebe perl! Hab ich das schon mal erwähnt? Bestimmt nicht.

Eine ganze Zeit lang habe ich ein etwas älteres perl-Modul für Excel-Spreadsheets verwendet. Beim Lesen der Anleitung fand ich kürzlich den Hinweis, dass es einen Nachfolger gibt, mit dem das neuere XML-Dokumentenformat erzeugt werden kann. Dieses Modul kann nahezu den kompletten Umfang von Excel-Spreadsheets ausreizen, inklusive Formatierung, Charts und Formeln.

Hier ist ein kurzes Beispiel für die Verwendung. Es liest die /etc/passwd eines Unix-Systems und erzeugt daraus eine kleine Exceltabelle. Als Schmankerl setzt es die Spaltenbreite und Autofilter für alle Spalten, so dass man z.B. alle Benutzer mit "nologin" filtern kann.

Vor der ersten Benutzung muss man das perl-Modul noch mit dem Befehl

# cpan install Excel::Writer::XLSX

(als root) installieren. In blau habe ich ein paar zusätzliche Kommentare an interessanten Stellen eingefügt.

#!/usr/bin/perl -w

use strict 'refs';
use strict 'vars';

use Excel::Writer::XLSX;

my %userlist;

# Spaltentitel
my @t_passwd =qw( USER PASSWD UID GID GECOS HOME SHELL );
# Spaltenbreiten, <0 heißt Spalte verbergen
my @f_passwd =qw(   20     -3  10  10    30   20    20 );

sub setfilter {
    my ($worksheet,$row,@colwidth)=@_;
    my $numcol=scalar(@colwidth);

# Autofilter für alle Spalten
    $worksheet->autofilter(0,0,$row,$numcol-1);
    for (my $i=0; $i<$numcol; ++$i) {
        my $w=$colwidth[$i];

        if ($w>0) {
            $worksheet->set_column( $i,$i, $w );
        }
        else {
# Breite setzen, kein Format, aber verstecken
            $worksheet->set_column( $i,$i, -$w, undef, 1);
        }
    }
}

sub collect_linux_passwd {
    my ($file)=@_;

    if (open(F,"<",$file)) {
        while (my $u=<F>) {
            chomp($u);
            my @user=split(/:/,$u);
            my $uname=$user[0];

# split löscht leere Felder am Ende
            $user[6]||="";
            $userlist{$uname}=[ @user ];
        }
        close(F);
    }
}

sub exceloutpasswd {
    my ($worksheet,$title,$list)=@_;
    my $row=0;

# eine ganze Zeile schreiben ($title ist ein Arrayref)
    $worksheet->write(0,0, $title);
    foreach my $i (sort(keys(%{$list}))) {
        ++$row;
# $list->{$i} ist ein Arrayref
        $worksheet->write($row, 0, $list->{$i});
    }
    setfilter($worksheet,$row,@f_passwd);
}

collect_linux_passwd("/etc/passwd");
my $workbook = Excel::Writer::XLSX->new('passwd.xlsx');
exceloutpasswd( $workbook->add_worksheet('unix users'), \@t_passwd, \%userlist );

$workbook->close();

Häufigkeiten von Würfelsummen - kleines Rätsel

Ich bin ein typischer Informatiker - wenn irgendwo ein Rätsel, Denksportaufgabe o.ä. abgedruckt ist, muss ich es probieren. Zuerst denke ich kurz darüber nach, ob es eine offensichtliche Lösung gibt, und da ich sehr ungeduldig bin, geht das nicht lange gut ;)

Danach denke ich darüber nach, wie ich die Aufgabe mit dem Rechner lösen kann - auch das Nachdenken über eine algorithmische Lösung ist schließlich Denksport ;)

Kürzlich fragte die "Spektrum der Wissenschaft" nach der Häufigkeitsverteilung beim Würfeln mit drei Würfeln. Das ist ein nettes Beispiel für eine Anfängeraufgabe, und natürlich versuchte ich mich damit, das "Problem" in perl zu lösen. Ich liebe perl, perl ist cool, genauso wie Fliegen cool sind ;)

Also zurück zur Aufgabe: welche Würfelsumme ist beim Würfeln mit drei Würfeln am häufigsten?

Der offensichtliche Ansatz ist eine dreifach geschachtelte Schleife, d.h. dreimal von 1 bis 6 zählen, Summe bilden und diese Summe (die zwischen 3 und 18 liegen kann) als Index verwenden, um in einem Array einen Zähler für diese Summe zu erhöhen.

Bei dieser Aufgabe kann man einige coole Features von perl gut zum Einsatz bringen, nämlich Arrays und einige sehr bequeme Funktionen und Operatoren, um mit Arrays umzugehen.

Natürlich will ich das kleine perl-Programm nicht einfach so hier in's Blog werfen, sondern ein paar der Besonderheiten von perl  ausführlicher kommentieren.

Zunächst verwende ich für das Zählen der Häufigkeiten ein assoziatives Array %sum, bei dem die Indizes beliebige Strings sein können, und kein Array mit numerischen Indizes. Das mag zunächst unnötig umständlich wirken, aber es erspart mir später einige Fallunterscheidungen, weil ich mir vorgenommen habe, Funktionen zu verwenden, die wenig bekannt sind. Aber natürlich gilt wie immer der perl-Leitsatz "there's more than one way to do it", und man kann die Aufgabe auch lösen, wenn man ein Array @sum verwendet.

Das Progrämmchen besteht aus drei Teilen: Variablendeklaration, Berechnung und Ausgabe. Die Kommentare unten markieren diese drei Teile. Ganz unten ist der vollständige Code zu finden, und hier im Text jeder Teil einzeln.

# Variablendeklaration
my %sum;


Wie schon beschrieben, wird bei der Berechnung einfach die Summe der drei ineinander geschachtelten Laufvariablen (i1, i2, i3) berechnet und als Index in das Array verwendet. Der auch aus C bekannte "++"-Operator addiert eins zum adressierten Array-Element. Die Schreibweise für die Schleifen finde ich besonders elegant: der perl-Operator ".." erzeugt eine Liste (oder auch Array genannt) von .. bis. Das funktioniert übrigens nur sauber in der Aufwärts-Richtung, es gibt grenzwertige Situationen, in denen man überrascht wird, wenn das bis kleiner ist als das von, also obacht hier!

# Berechnung
foreach my $i1 (1..6) {
    foreach my $i2 (1..6) {
        foreach my $i3 (1..6) {
            ++$sum{$i1+$i2+$i3};
        }
    }
}

Bei der Lösung solcher Aufgaben sollte man sich vorher überlegen, ob man den "brute force"-Ansatz wählt und einfach alle Varianten durchprobiert oder ob es Optimierungsmöglichkeiten gibt, mit denen man die Komplexität reduzieren kann. Bei drei Schleifen von 1 bis 6, mithin also 216 Schleifendurchläufen, ist das Programm selbst auf einem C-64 noch zu meinen Lebzeiten beendet ;)

# Ausgabe
print join("\n",
           map { sprintf("% 3d",$_) . " => $sum{$_}" }
               sort { $sum{$b} <=> $sum{$a} }
                    keys(%sum)
      ),"\n";

Bei der Ausgabe der Ergebnisse habe ich tief in die Trickkiste gegriffen und alles in einen einzigen "print"-Befehl gepackt. Dieser Befehl bekommt als Parameter das Ergebnis des "join"-Kommandos und hintendran wird noch ein einzelnes "\n", also ein Zeilenumbruch gehängt. Die Einrückungen habe ich so gewählt, dass man genau sieht, was zusammengehört.

print join("\n",
           map { sprintf("% 3d",$_) . " => $sum{$_}" }
               sort { $sum{$b} <=> $sum{$a} }
                    keys(%sum)
      ),"\n";

Der "join"-Befehl selbst nimmt zwei Parameter: das Verbindungszeichen "\n" und ein Array von Strings (man kann in perl alles als String verwenden, selbst Zahlen - es gibt keine strikte Unterscheidung, wie man ein "skalares Element" verwenden darf).

map { sprintf("% 3d",$_) . " => $sum{$_}" }
    sort { $sum{$b} <=> $sum{$a} }
         keys(%sum)

Das "Array von Strings", das "join" bekommt, wird von einem "map"-Befehl dynamisch erzeugt. "map" ist eigentlich ein versteckter Schleifenoperator und erzeugt aus einer Funktion und einem Array als Parameter wiederum ein Array. Dies ist eines der faszinierenden Features von perl, die ich oben erwähnt hatte: "map" nimmt als Parameter eine namenlose Funktion, die man in {} schreibt.

In dieser Funktion, genau wie im folgenden Befehl "sort" gibt es Pseudo-Variablen, die nur innerhalb dieser Funktion benutzbar sind. Bei "map" ist es die Variable "$_", die das aktuell bearbeitete Array-Element beinhaltet. Dieses Element ist der Index des Arrays und bedeutet hier eine spezielle Würfelsumme. Mit "sprintf" formatiere ich diese Zahl rechtsbündig, dahinter hänge ich mit dem Stringoperator "." noch ein bißchen Schmuck als Trennzeichen an und danach noch die tatsächliche Anzahl an Möglichkeiten, diese Würfelsumme zu werfen.

sort { $sum{$b} <=> $sum{$a} } keys(%sum)

Jetzt kommt noch ein weiteres cooles Feature von perl: es gibt einen eingebauten Befehl zum Sortieren von Arrays, und diesem Befehl kann ich wiederum in einer namenlosen Funktion mitgeben, wie ich die Sortierung wünsche. Da ich beim Sortieren immer zwei Elemente vergleichen muss, liefert mir perl bequemerweise zwei Pseudovariablen, die mit "$a" und "$b" bezeichnet werden. Diese Variablen sind nur innerhalb dieses "sort"-Befehls bekannt und beeinflussen eventuell "außerhalb" deklarierte Variablen "$a" und "$b" nicht!

Sortiert wird absteigend nach der Häufigkeit, mit der dieser Würfelwurf vorkommen kann, also nach dem Inhalt des Arrays an dieser Stelle, und der "<=>"-Operator erzählt mir, welcher der beiden Werte kleiner bzw. größer ist. Dies ist ein sogenannter "ternärer" Operator, der mir je nach Vergleichsergebnis -1, 0 oder 1 liefert (also drei mögliche Ergebnisse, deshalb "ternär").

Solche verketteten Ausdrücke in perl muss man also von hinten nach vorne lesen, damit man den Sinn versteht.

Nochmal aus dieser Sichtweise betrachtet: ich sortiere das Array nach der Häufigkeit und übergebe das sortierte Array an "map", um dort die einzelnen Array-Elemente hübsch lesbar zu machen. Mit "join" verknote ich alle diese aufgehübschten Array-Elemente, so dass "print" einen einzelnen String ausgeben kann.

Und dies ist das gesamte Skript ohne Erklärungen dazwischen:

#!/usr/bin/perl -w


# Variablendeklaration
my %sum;

# Berechnung
foreach my $i1 (1..6) {
    foreach my $i2 (1..6) {
        foreach my $i3 (1..6) {
            ++$sum{$i1+$i2+$i3};
        }
    }
}
 
# Ausgabe
print join("\n",
           map { sprintf("% 3d",$_) . " => $sum{$_}" }
               sort { $sum{$b} <=> $sum{$a} }
                    keys(%sum)
      ),"\n";


[Update 20160930: Schleife von for auf foreach geändert, Einrückungen bei print zur Verdeutlichung]

Zahlensysteme umwandeln in perl

Angeregt durch eine Diskussion mit einem Kollegen vor einiger Zeit, und jetzt nochmal in einem Facebook-Kommentar, habe ich ein kleines Perl-Skript geschrieben, mit dem man Zahlen von einem Zahlensystem in ein anderes umrechnen kann.

Dabei können sowohl Ausgangs- als auch Zielsystem beliebige Basis haben, man muss beim Aufruf angeben, von wo nach wo umgewandelt werden soll. Im Moment funktioniert es nur bis Basis 16. Wer größere Werte braucht, findet leicht die eine Stelle im Code, die geändert werden muss ;). In Vorlesungsskripten steht dann üblicherweise " ... left as an exercise for the reader".

Als kleines Bonbon ist es auch möglich, nicht nur die Zahlen auszugeben, sondern alternativ auch die ASCII-Zeichen, die diesen Werten entsprechen.

Damit kann man dann lustige, leicht unverständliche Kommentare schreiben wie

> 1000010 1101001 1101110 1100001 1100101 1110010 1100011 1101111 1100100 1100101 1101001 1110011 1110100 1100110 1110101 1100101 1110010 1010111 1100101 1101001 1100011 1101000 1100101 1101001 1100101 1110010 100001

>  01001110 01101001 01111000 00100000 01100100 01100001 00101100 00100000 01001000 01100101 01111000 00100000 01101001 01110011 01110100 00100000 01100110 11000011 10111100 01110010 00100000 01000110 01100001 01110101 01101100 01100101 01101110 01111010 01100101 01110010 00100001

 >  53 65 6c 62 73 74 76 65 72 73 74 61 65 6e 64 6c 69 63 68 2c 50 72 6f 67 72 61 6d 6d 69 65 72 65 72 73 69 6e 64 66 61 75 6c 3b 2d 29

So wird es benutzt:

$ ./code.pl -i16 -o2 48 61 6c 6c 6f
# out: 1001000 1100001 1101100 1101100 1101111

$ ./code.pl -a -i16 -o2 48 61 6c 6c 6f
# asc: Hallo

$ ./code.pl -a -i2 -o16 01101000 01100001 00100000 01101000 01100001
# asc: ha ha

$ ./code.pl -i10 -o2 1 2 3 4 5
# out: 1 10 11 100 101

#!/usr/bin/perl -w

use strict 'vars';
use strict 'refs';

use Getopt::Std;

use vars qw($opt_i $opt_o $opt_a $opt_v);

my ($in,$out,$inbase,$outbase,$ok);
my $chars="0123456789abcdef";

sub from {
    my $v=0;
    if ($inbase==1) {
        $v=ord($_[0]);
    }
    else {
        print "# c: " if ($opt_v);
        for my $c (split(//,$_[0])) {
            print ".$c" if ($opt_v);
            my $t=index($chars,lc($c));
            $v=($v*$inbase)+$t;
        }
        print " ($v)\n" if ($opt_v);
    }
    return $v;
}

sub to {
    my $c="";
    if ($outbase==1) {
        $c=chr($_[0]);
        print ".$c" if ($opt_v);
    }
    else {
        my $v=$_[0];
        while ($v>0) {
            my $t=$v%$outbase;
            $c=substr($chars,$t,1).$c;
            $v=int($v/$outbase);
            print ".$v%$t" if ($opt_v);
        }
        print " ($c)\n" if ($opt_v);
        $c=" ".$c;
    }
    return $c;
}

getopts("avi:o:");
$ok=0;
my $asc="";

if ($opt_i) { $inbase =$opt_i; $ok|=1; }
if ($opt_o) { $outbase=$opt_o; $ok|=2; }
if ($ok!=3) {
    print STDERR "# unknown base!\n";
    exit(1);
}

if ($#ARGV>=0) { $in=join(" ",@ARGV); }
else { $in=<>; }

print "# from: $inbase\n"  if ($opt_v);
print "# to  : $outbase\n" if ($opt_v);

if ($inbase==1) {
    $in=join(" ",split(//,$in));
}
foreach my $word (split(/\s+/,$in)) {
    my ($c,$a);

    print "# w: $word\n" if ($opt_v);
    $c=from($word);
    print "# c: $c\n" if ($opt_v);
    $a=to($c);
    $asc.=chr($c);
    $out.=$a;
}

print "# out:$out\n" unless ($opt_a);
print "# asc: $asc\n" if ($opt_a);

OpenOffice-Dokumente mit perl-Skript bearbeiten

Offene Dateiformate sind eine tolle Sache!

Das merke ich immer wieder bei lustigen Problemen, wenn mir z.B. jemand ein Office-Dokument schickt und ich damit irgendetwas total langweiliges erledigen soll.

Es macht viel mehr Spaß, dafür ein Programm oder ein Skript zu schreiben und den Computer die Arbeit machen zu lassen, statt selbst dröge Arbeiten zu erledigen, die nur aus Wiederholungen von Tastendrücken und Mausbewegungen bestehen!

Letzte Woche hatte ich so einen Auftrag: ein Kollege schickte mir eine Excel-Datei mit mehreren Tabellenblättern und bat mich, daraus mehrere Tables einer Datenbank zu befüllen.

Mein erster Ansatz war, jedes Blatt als Textdatei (CSV) abzuspeichern und mit ein wenig Skripting die SQL-Befehle pro CSV-Datei zu generieren.

Der nächste Gedanke war einiges cooler und hat mir deshalb noch viel besser gefallen: ich speichere die Excel-Datei im OpenOffice-Format (ODF=OpenDocumentFormat) ab und lasse ein Skript die ganze Arbeit machen! Die Datei enthält um die 15 Tabellenblätter - allein vor dem Abspeichern von 15 CSV-Dateien in Handarbeit grauste es mir schon!

Hinzu kommt, dass mein Arbeitgeber OpenOffice als Standardwerkzeug und Standardformat festgelegt hat und es somit vollkommen natürlich ist, mit dem OpenDocument-Format zu arbeiten. Erwähnte ich schon, dass mein Arbeitsplatz mit Linux ausgestattet ist?

Ein ODF-Dokument ist eigentlich ganz einfach aufgebaut: es ist im Wesentlichen eine zip-Datei und der Inhalt ist immer in der Datei content.xml zu finden. Alles andere ist Beiwerk (Stylesheets, Bilder, ...), das ich für meinen Zweck ignorieren kann.

Natürlich verwende ich perl zum Programmieren meiner Umwandlungsskripte, und natürlich gibt es ein Modul für jeden Zweck. Für die Verbindung zu OpenOffice gibt es sogar mehrere, und ich habe mir OpenOffice::OODoc ausgesucht. Mir ist nämlich in der Beschreibung aufgefallen, dass es eine ganz bestimmte Funktion gibt, die haargenau das erledigt, was ich mir als Lösungsweg überlegt hatte: den Tabelleninhalt als CSV-Text auszuliefern.

Damit war mein perl-Skript plötzlich fertig, kaum dass ich 20 Zeilen geschrieben hatte, wobei das meiste davon sogar ein fast fertiges Beispiel aus der man-page war! Ich musste nur ein wenig die Daten massieren, als ich mit einem Testskript anfing und die ersten Daten probeweise auf dem Bildschirm ausgeben ließ.

Das folgende Skript erledigt nun den ersten Teil meiner Aufgabe: es zerlegt ein OpenOffice-Spreadsheet in mehrere CSV-Dateien, eine pro Tabellenblatt.
Als Ziel schwebt mir vor, dass die temporären CSV-Dateien gar nicht mehr gebraucht werden und ich direkt den SQL-Code erzeuge, aber ich denke, die Umwandlung von .ods in .csv kann man immer mal brauchen.

Einzige Bedingung: der Name des Tabellenblatts sollte sinnvoll gesetzt sein, weil daraus nämlich der Name der CSV-Datei gebildet wird.  Wenn man das nicht macht, heißen die Dateien einfach "Sheet1.csv", "Sheet2.csv" usw.

#!/usr/bin/perl -w
use OpenOffice::OODoc;
sub out {
  my ($table,$data)=@_;
  my $f=$table->{'att'}->{'table:name'}.".csv";
  return unless (open(OUT,">",$f));
  print STDERR "# $f\n";
  print OUT $data;
  close(OUT);
}
my $file=shift||"file.ods";
my $doc = odfText(file => $file);
foreach my $table ($doc->getTableList()) {
  $doc->normalizeSheet($table);
  my $data = $doc->getTableText($table);
  $data=~s!(<<|>>)!!msgo;
  $data=~s!^[\s;]*$!!msgo;
  $data=~s!;$!!msgo;
  chomp($data);
  out($table,$data);
}

Die Ausgabe-Funktion bildet den Dateinamen aus dem Attribut table:name des Blatts. Die eigentliche Umwandlung findet in der Methode getTableText statt: hier wird ein gesamtes Tabellenblatt mit einstellbaren Trennzeichen für Spalten und Zeilen in CSV-Text zurückgeliefert. Manche Blattnamen werden von "<<" und ">>" eingerahmt, was ich natürlich in Dateinamen nicht brauchen kann, deshalb werden die Daten noch etwas gesäubert. Welche Blattnamen es gibt, kann man mit getTableList erfragen.

Natürlich kann man auch andere Methoden einsetzen, um einzelne Zeilen, Spalten oder Zellen zu adressieren, und man kann mit diesem perl-Modul auch Daten ändern und die Änderungen abspeichern. Ein geniales Modul! Wie gesagt, die bequemste Funktion war für mich die Umwandlung in CSV mit einem einzigen Aufruf.

[Update: OpenOffice optimiert die Tabellenstruktur in der internen Verwaltung (content.xml), wenn mehrere Zellen denselben Inhalt haben; deshalb muss man vor der Benutzung der Methode getTableText das XML wieder "entzerren". Dazu setze ich vor das Auslesen der Tabelle die Methode normalizeSheet ein. ]

Und zack!, schon ist der erste Teil der Aufgabe erledigt - das Auslesen einer ODF-Datei.

Den zweiten Teil - die Umwandlung von Text in SQL - gibt es bei der nächsten Märchenstunde.

Und jetzt am Schluss verrate ich noch ein Geheimnis: ich erzähle, wie man dieses Modul in sein eigenes perl integriert (Punkte zwischen [...] optional).

1. Modul herunterladen
2. Auspacken
3. In das Directory wechseln
4. perl Makefile.PL
5. make
6. [make test]
7. make install

oder noch viel bequemer mit dem CPAN-Modul:

1. perl -MCPAN -e 'install OpenOffice::OODoc'

[Update 20150521: Umbruch im perl-Skript repariert]
[Update 20180810: dito]

Erbsen zählen - zweiter Teil

Nachdem ich also im 1. Teil das Grundprinzip des Erbsenzählens beschrieben habe, kommt hier ein bißchen mehr Skripting zum Einsatz, damit sich der Tag "Automation" auch lohnt ;)

Das Datensammeln an sich ist eine triviale Sache. Man braucht ein kleines Skript, das mit Hilfe von cron regelmäßig ausgeführt wird.

Ich habe einfach mal willkürlich festgelegt, dass es einmal stündlich laufen soll:

2 * * * * /usr/local/sbin/ip-accounting.sh -I /var/log/lte-acct.in -O /var/log/lte-acct.out >/dev/null 2>&1

Der Inhalt des Skripts sieht ein bißchen aufgebläht aus, weil ein paar Kommandozeilenargumente ausgewertet werden wollen. Die wichtigste Zeile im Skript habe ich nochmal extra rot markiert, das ist die eigentliche Datensammlung.

#!/bin/sh

PATH=/opt/sbin:/opt/bin:/usr/bin:/usr/sbin${PATH:+:$PATH}

bytesin=0
bytesout=0
while getopts "iI:oO:" opt
do
  case "$opt" in
  i) bytesin=1;;
  I) filein="$OPTARG";;
  o) bytesout=1;;
  O) fileout="$OPTARG";;
  esac
done
shift $(expr $OPTIND - 1)
if [ "$bytesin$bytesout$filein$fileout" = "00" ]
then
  bytesin=1
  bytesout=1
fi

dt=$(date +%Y%m%d-%H%M%S)

out=$(iptables -L INET_OUT -v | awk -v D="$dt" '{if(NR>2){printf"%s OUT %-40s %s\n",D,$7,$2}}'|sort)
if [ "$bytesout" -eq 1 ]
then
  echo "$out"
fi
if [ -n "$fileout" ]
then
  echo "$out" >> "$fileout"
fi

out=$(iptables -L INET_IN  -v | awk -v D="$dt" '{if(NR>2){printf"%s IN  %-40s %s\n",D,$8,$2}}'|sort)
if [ "$bytesin" -eq 1 ]
then
  echo "$out"
fi
if [ -n "$filein" ]
then
  echo "$out" >> "$filein"
fi

Und was genau macht diese rot markierte Zeile? Schauen wir mal genauer hin. Es sind mehrere Befehle in einer Zeile, verbunden mit dem Weiterleitungszeichen | (pipe). Diese Pipe verbindet den Output des Programms vorne mit dem Input des Programms dahinter.

iptables -L INET_IN  -v |

Der erste Befehl zeigt die bis dahin aufgelaufene Datenmenge für alle überwachten Systeme an. Wichtig ist der Switch -v, sonst bekomme ich die Datenmenge nicht zu sehen.

awk -v D="$dt" '{if(NR>2){printf"%s IN  %-40s %s\n",D,$8,$2}}' |

Die Ausgabe enthält allerdings ziemlich viel Kram, der mich gar nicht interessiert, deswegen verwende ich awk, um mir gezielt nur das zu extrahieren, was ich für meine Neugier brauche. Natürlich könnte ich normalerweise auch grep verwenden, um etwas zu suchen, aber weil ich gleichzeitig ein wenig programmieren will und einzelne Felder aus jeder Zeile des Outputs ausschneiden will, verwende ich ganz gern awk, statt grep mit cut o.ä. zu kombinieren. Spart ein wenig CPU ;)

Bei diesem Befehl benutze ich zwei eingebaute Fähigkeiten von awk: es zählt automatisch die Zeilennummern in der Variablen NR (number of records) mit, was ich verwende, um die ersten zwei Zeilen mit der Überschrift des iptables-Outputs wegzuwerfen, und es zerlegt automatisch die Zeile in "Felder" gemäß einem vorgegebenen Trennzeichen (üblicherweise Whitespace). awk arbeitet also den printf-Befehl nur ab der dritten Zeile des Inputs ab und zeigt davon nur das achte und das zweite Feld an (Hostname und Datenmenge)

Bei der Chain INET_OUT ist  übrigens  der Hostname im siebten Feld enthalten, und bei der Chain INET_IN im achten Feld, weil ich ja einmal nach "source" und einmal nach "destination" suche.

Randbemerkung: damit awk einen Timestamp mit ausgeben kann, gebe ich dem Aufruf von awk einen solchen vorgefertigten Timestamp auf der Kommandozeile mit dem Switch -v NAME=WERT mit. Das können nicht alle awk unter allen Unix-Varianten, m.W. wurde das mit dem "new awk" (nawk) unter SunOS eingeführt, GNU awk unter Linux kann es auf jeden Fall.

sort

Der letzte Befehl sortiert das ganze schlicht und einfach alphabetisch. Ich könnte auch iptables mit dem Switch -n verwenden, um die IP-Adressen zu sehen anstatt der Hostnamen. Dann wäre es angebracht, bei sort ebenfalls -n zu verwenden, um numerische Sortierung zu erzwingen.

Dieses Skript sammelt also stündlich Daten pro überwachtem Hostname. Die gesammelten Daten sehen dann so aus:

server:/share/www/cgi-bin # tail -n2 /var/log/lte-acct.in /var/log/lte-acct.out
==> /var/log/lte-acct.in <==
20140109-150202 IN  nexus.moeller-seeling.local              23M
20140109-150202 IN  vettie68.moeller-seeling.local           286M

==> /var/log/lte-acct.out <==
20140109-150202 OUT nexus.moeller-seeling.local              6752K
20140109-150202 OUT vettie68.moeller-seeling.local           13M

Wie man sieht, ist der Output menschenfreundlich und es wird immer eine halbwegs lesbare Größenordnung bei der Datenmenge angezeigt: KB, MB oder GB. Ohne Einheit sind "Byte" gemeint. Diese Kleinigkeit ist beim Programmieren einer kleiner Stolperstein gewesen ;)

Das Auswerte-Skript habe ich als CGI-Skript in Perl gelöst. Es kann sowohl eine Tabelle als auch eine Grafik erzeugen (mit dem Perl-Modul GD). Das folgt dann im nächsten Teil.

Am Ersten des Monats sollte man übrigens die Zähler wieder auf Null setzen:

iptables -L INET_IN -Z
iptables -L INET_OUT -Z

Ich habe schon ein Skript, das mir meinen Verbrauchszähler auf Null setzt, dort werde ich das noch mit einbauen.

Kleine Perl-Spielerei mit Tonleitern

Vor einiger Zeit habe ich mich mal ein bißchen näher mit Noten beschäftigt, und fand es ganz schön faszinierend, wie systematisch man eine Tonleiter selbst aufschreiben kann. Es geht nur darum, den richtigen Nachfolger für jeden Ton zu finden, und schon kann man ganz leicht, ausgehend von C-Dur, jede andere Tonleiter zusammenbauen.

Die Profi-Musiker werden jetzt natürlich schon angefangen haben zu lachen, das ist mir klar ;). Die können das alles auswendig oder merken sich lustige Eselsbrücken ("geh, du alter esel, fische holen"). Da mein Gedächtnis für so etwas nicht geeignet ist, mache ich es anders.

Man kann natürlich sowas mit Stift und Papier erledigen. Das geht aber einem Programmierer an die Ehre, und warum etwas manuell erledigen, was man auch mit einem kleinen Progrämmchen schaffen kann?

Also ein wenig nachgedacht über eine sinnvolle Datenstruktur, und los geht's mit dem perl-Skript, um eine Tonleiter zu konstruieren, wenn der Anfangston gegeben ist. Ich bin ein Anhänger des Konzepts, dass man sich zuerst eine möglichst praktische Datenstruktur ausdenkt, und davon ausgehend ergibt sich der Programmcode nahezu von selbst. Dieses Konzept hat Niklaus Wirth als erster formuliert und dann gleich ein Buch drüber geschrieben ;)

Zunächst mal brauche ich zwei Informationen: wie groß ist der Abstand zwischen jeweils zwei benachbarten Noten, und welche Noten folgen aufeinander.

Mein erster Versuch war, die ganzen Noten und die Halbtöne in zwei Arrays zu packen:

my @toene1=("c",   "d",   "e", "f",   "g",   "a", "h");
my @toene2=("cis", "dis", "f", "fis", "gis", "b", "c");

Als ich schon fast fertig war, hat mir meine Tochter ganz empört erklärt, dass man Kreuze und B nicht mischen darf. Ich müsste also "ais" statt "b" schreiben, wenn ich eine Dur-Tonleiter (also die mit den Kreuzen ...) bauen will. Naja ...

Dann müsste ich in einer Schleife ausgehend vom Grundton, die nächsten 7 Töne suchen. Also eine Fallunterscheidung, ob jetzt ein Sprung um einen ganzen oder halben Ton nötig ist, und dann überlegen, welches der entsprechend entfernte Ton genau ist. Dazu muss man wissen, dass zwischen "c" und "d" ein Abstand von einem Ganzton liegt, von "e" zu "f" aber nur ein Halbton. Bei einer Tonleiter gelten ausgehend vom Grundton, bestimmte Regeln, wie groß der Abstand zum nächsten Ton jeweils ist.

Auf der Klaviertastatur sieht man das ganz wunderbar: es gibt immer abwechselnd Gruppen mit zwei und drei schwarzen Tasten mit Halbtönen, und es gibt pro Oktave zwei Stellen, bei denen oberhalb keine schwarze Taste liegt - links von dem Zweierpärchen schwarzer Tasten liegt jeweils das "c", und rechts davon die zwei weißen Tasten ohne eine schwarze dazwischen sind "e" und "f".

Diese Abstandsregel habe ich als "delta" hingeschrieben, und da ich nicht mit Gleitkommazahlen rechnen wollte, habe ich "2" als Ganzton und "1" als Halbton geschrieben. Das hat mich später auf eine Idee gebracht, wie ich die Datenstruktur der aufeinanderfolgenden Töne verbessern könnte, aber das kommt erst als übernächstes.

my @delta=(2,2,1,2,2,2,1);

Dann brauche ich noch eine Hilfsfunktion, die mir den Index liefert, an dem mein gewünschter Grundton in der C-Dur-Tonleiter liegt.

sub findstart {
        my ($start)=@_;

        for ( my $i=0; $i<$max; ++$i) {
                return ($i) if ($start eq $toene[$i]);
        }
        return 99;
}

my $start=lc($ARGV[0]); 
$ofs=findstart($start);

Diese Funktion liefert mir die Nummer des Tons im Array, und für den schlimmsten Fall (kein Treffer) eine 99, also ein Ergebnis außerhalb des möglichen Bereichs.

Außerdem brauche ich noch einen separaten Zähler (dachte ich zuerst), mit dem ich die Liste der Abstände (der Deltas) von Anfang an durchlaufe.

Als nächstes also eine Schleife und eine Fallunterscheidung:

for (my $i=0; $i<7; ++$i) {
  if ($delta[$o]==2) { # sprung um einen ganzton
    $neuerton=$toene1[$i];
  }
  else { # sprung halbton
    $neuerton=$toene2[$i];
  }
} 

Das bringt mir allerdings ein Problem, weil die primitive Datenstruktur mit zwei separaten Arrays "toene1" und "toene2" nur ganz schwer die numerische Information liefert, wann in der Tonleiter der Abstand nur einen Halbton ist (e/f und h/c).

Also flugs eine neue Datenstruktur ausgedacht, die das liefert. Ein Array von Arrays, und jedes Element enthält den Namen des Grundtons, den Ton einen Halbton darüber und den einen Ganzton darüber:

my @toene=(
  ["c", "cis", "d"  ],
  ["d", "dis", "e"  ],
  ["e", "f",   "fis"],
  ["f", "fis", "g"  ],
  ["g", "gis", "a"  ],
  ["a", "ais", "h"  ],
  ["h", "c",   "cis"]
);


Das Coolste an dieser Konstruktion ist, dass ich mir die Fallunterscheidung jetzt ganz sparen kann und sich der Sprung zum nächsten Ton in der Tonleiter ganz zwanglos aus dem "delta"-Array ergibt: der Index [0] ist der Grundton im inneren Array, der Index [1] ist der Halbton darüber, und der Index [2] der nächste Ton mit einem Ganzton Abstand. Der schönste Trick ist hier, dass ich $delta[$o], also den Abstand vom Ton an der Stelle $o zu seinem Nachfolger, als Index verwende, um den Namen dieses Tons zu finden.

for (my $i=0; $i<7; ++$i) {
  $neuerton=$toene[$i]->[$delta[$o]]; 
}


Im Endeffekt hat mir das aber auch nicht allzuviel gebracht, weil nach dem ersten Halbtonsprung (z.B. in D-Dur vom "e" zum "fis") der nächste Schritt in der Schleife mit dem "fis" anfangen müsste, meine Schleifenlogik aber vom "e" zum "f" an Index [0] springt. Der Output war dann "d", "e", "fis" (soweit ok), aber dann kam nochmal ein "fis", weil nach dem "e" in der ersten Spalte das "f" kommt, und das ist falsch.

So elegant diese Datenstruktur auch ist, so ungeeignet ist sie nach wie vor für das, was ich bezwecke. Es tat mir dann auch ein bißchen leid, dass ich sie aufgeben musste ;)

Also bin ich wieder zurückgekehrt zu einer flachen Datenstruktur, nämlich einem Array, in dem schlicht und einfach alle Töne und Halbtöne aufeinanderfolgen. Mir kam dann nämlich der Gedanke, dass ich mit dem "delta" 1 oder 2 ganz einfach in einem flachen Array entweder den Nachfolger mit Abstand 1 oder 2 nehmen kann, um den nächsten Ton zu finden.

Dieser Gedanke hat dann tatsächlich zum gewünschten Ergebnis geführt. Nebenbei hat es auch dazu geführt, dass ich die zweite Schleifenvariable entfernen konnte, und den Index des Grundtons (also mein Parameter von der Kommandozeile) mißbrauchen konnte, um zu zählen. Es ist nur wichtig zu bedenken, dass man nicht über das Ende des Arrays hinausgreifen darf. Deshalb verwende ich den "modulo"-Operator, um (wie bei einem Zifferblatt) dafür zu sorgen, dass nach der "11" bei der "0" weitergezählt wird.

Warum kommt es zu "12" als Größe des Arrays? Ganz einfach: es gibt in einer Tonleiter 7 verschiedene Töne (c/d/e/f/g/a/h), und eine "Oktave" höher findet sich wieder der Grundton. Zwischen "e" und "f" und nach dem "h" gibt es keinen Halbton (musikalisch schon, aber nicht mit einem eigenen Namen), deshalb also 2*7-2=12 verschiedene Töne mit Namen. Solche Überlegungen am Rand sind recht nützlich, um zu testen, ob bestimmte Grundannahmen im Programm plausibel sind, und ob man bei Aufzählungen auch alle Varianten wirklich in den Programmtext geschrieben hat oder noch etwas fehlt.


Und das kam als Endprodukt dabei heraus:

#!/usr/bin/perl -w

my @delta=(2,2,1,2,2,2,1);
my @toene=(
        "c",   "cis", "d",   "dis", "e",   "f",
        "fis", "g",   "gis", "a",   "ais", "h",
);
my $max=scalar(@toene);

sub findstart {
        my ($start)=@_;

        for (my $i=0; $i<$max; ++$i) {
                return ($i) if ($start eq $toene[$i]);
        }
        return 99;
}

my $start=lc($ARGV[0]);
my $ofs;

print "# $start-dur Tonleiter ($max)\n";
$ofs=findstart($start);

for (my $o=0; $o<7; ++$o) {
        print "# "," + ",$delta[$o]," = ",$toene[$ofs],"\n";
        $ofs=($ofs+$delta[$o]) % $max;
}

Hier ist der Probelauf für F-Dur noch mit der Debugging-Ausgabe, wie weit entfernt der nächste Ton liegt (also f+1=g, a+1/2=ais usw.):

server:~ # ~ths/perl/tonleiter.pl f
# f-dur Tonleiter
#  + 2 = f
#  + 2 = g
#  + 1 = a
#  + 2 = ais
#  + 2 = c
#  + 2 = d
#  + 1 = e

[Update 2013.11.12: Formatierung, Tippfehler]

Verbrauchtes LTE-Volumen protokollieren

Ich beschäftige mich weiter mit der Telekom, heute zur Abwechslung mal wieder ein technischer Beitrag, der beschreibt, wie man den Überblick über das schon verbrauchte Volumen behalten kann.

Bekanntlich ist unser Haushalt seit letztem Jahr mit LTE unterwegs im Internet. Bedauerlicherweise gibt es nur Verträge mit Pseudo-Flatrate, die nach einer bestimmten verbrauchten Datenmenge im Monat von der Nominalgeschwindigkeit ("bis zu" 16 MBit/s) auf DSL-light-Geschwindigkeit (384 KBit/s) gedrosselt werden.

Zu dieser Kontingentierung gehört übrigens auch mein Upload. Wenn ich also Bilder hochlade, um Papierabzüge zu bestellen, wird das voll gezählt.

Um das verbrauchte Volumen abzurufen, gibt es eine Info-Seite bei der Telekom, die mir berichtet, wieviel von meinem Kontingent schon verbraucht ist. Mit ein bißchen Getrickse in einem Skript kann ich daraus die zwei Zahlen extrahieren, die ich wissen will, und die protokollieren.

Mein Artikel besteht also aus zwei Teilen: dem Skript zum Abfragen, und einem (wahlweise zwei) Cron-Jobs zur regelmäßigen Aufzeichnung.

Das Skript ist sehr einfach: es verwendet eine "regular expression" in perl, um die Zahlen und die zugehörigen Maßeinheiten (KB, MB, GB) aus dem HTML-Wust herauszufischen.

Übrigens muss man kein Linux haben, um diese kleinen Hilfsmittel einzusetzen: wget, perl und die GNU Kommandozeilenwerkzeuge gibt es auch für Windows. Alternativ kann man auch die komplette CygWin-Umgebung installieren. Mit einem Cron-Job wird es etwas schwieriger, aber wenn man einen PC hat, der immer angeschaltet ist, kann man mit dem Windows-Befehl at auch so etwas zusammenbauen. Die Hilfefunktion wird mit at /? aufgerufen.

Zurück zum eigentlichen Thema: mein erster Versuch, um das HTML anzuschauen, war übrigens diese Kommandozeile:

wget -SO- http://pass.telekom.de/portal/home |\
  perl -pe 's!>!>\n!go' |\
  grep -B1 verbraucht

Diese drei Befehle fragen die Info-Seite ab (wget), und nach jedem HTML-Tag wird mit einem simplen perl-Einzeiler ein Zeilenumbruch eingefügt. Durch die nun entstandene Zeilenstruktur kann der "grep"-Befehl ein Stichwort finden ("verbraucht") und die gesamte Zeile, in der dieses Stichwort vorkommt, ausgeben. Außerdem hätte ich gern die Zeile davor ebenfalls in der Anzeige (der Switch -B anzahl zeigt soviele Zeilen vorher - "Before" - ebenfalls an - diese Option funktioniert nur beim GNU grep, nicht bei AIX, Solaris, etc.).

Mit genau demselben Prinzip, nur etwas aufgehübscht, funktioniert die eigentliche Protokollierung. Da das Werk als Cron-Job laufen soll, muss ich mich selbst um vernünftige Umgebungsvariablen wie PATH kümmern; in Cron-Jobs gibt es nur Minimaleinstellungen.

#!/bin/sh

PATH=/opt/bin:/usr/bin:/usr/local/bin:/usr/local/sbin${PATH:+:$PATH}

date=
file=

while getopts "df:" opt
do
  case "$opt" in
  d) date="%Y%m%d-%H%M%S ";;
  f) file="$OPTARG";;
  esac
done
shift $(expr $OPTIND - 1)

if [ -n "$file" ]
then
  d="${file%/*}"
  test -d "$d" || mkdir -p "$d"
fi

q=$(wget -qO- http://pass.telekom.de/portal/home |\
  perl -ne '
    print("$1 $2 $3 $4\n")
    if (m#<span.*?>([0-9,.]+).*([KMG]B)</span> von ([0-9,.]+).*([KMG]B) mit voller Geschwindigkeit verbraucht#i)')
test "$(/bin/tty)" = "not a tty" || date +"$date$q"
test -n "$file" && date +"%Y%m%d-%H%M%S $q" >> $file

Die Ausgabe wird hier auf Wunsch noch mit dem Datum der Abfrage versehen, und wenn man mit -f einen Dateinamen angibt, wird die Ausgabe zusätzlich noch an diese Datei angehängt.

Ein paar kleine Tricks will ich ein bißchen näher erklären:

• PATH=...${PATH:+:$PATH} - hier prüfe ich, ob in der Variablen PATH überhaupt irgendetwas enthalten ist. Falls ja, hänge ich einen Doppelpunkt und den alten Inhalt hinten dran und setze vorn neue Pfadnamen davor.
• d="${file%/*}" - Vom Dateinamen in $file schneide ich alles nach dem letzten / ab. Als Ergebnis steht in der Variablen $d der Pfadname der Datei.
• test -d "$d" prüft, ob dieses Verzeichnis existiert, und erzeugt es ggfs. mit mkdir -p mit allen Unterverzeichnissen dazwischen.
• In einem Cron-Job ist eine Ausgabe auf die Konsole sinnlos, deshalb prüfe ich, ob der Befehl /bin/tty mir das Ergebnis "not a tty" liefert.
• Der date-Befehl akzeptiert +Formatstring. Ich baue einfach das aktuelle Ergebnis in den Formatstring mit ein: date +"$date$q"

Mit einem Cron-Job wird dieses Skript nun stündlich aufgerufen:

57 * * * * /usr/local/bin/lte-quota.sh -f /var/spool/lte-quota.txt >/dev/null 2>&1

Und einmal am Tag lasse ich mir den aktuellen Stand auch noch als Mail zuschicken:

1 8 * * * (/bin/tail -1 /var/spool/lte-quota.txt | /bin/mail -s "LTE quota" ths) >/dev/null 2>&1

Das Ergebnis sieht dann bei mir etwa so aus:

20130603-225703 1,7 GB 30 GB
20130603-235702 1,9 GB 30 GB
20130604-005702 1,9 GB 30 GB
20130604-015702 1,9 GB 30 GB
20130604-025702 1,9 GB 30 GB
20130604-035702 1,9 GB 30 GB
20130604-045702 1,9 GB 30 GB
20130604-055702 2 GB 30 GB

[Update: die Telekom-Seite hat sich geändert, im Skript Regex angepasst]

perl erzeugt einen Graphen aus Messdaten

Mal ein schönes Beispiel dafür, wie man mit wenig Aufwand und den richtigen perl-Modulen eine hübsche Grafik zaubern kann ...

Als Beispiel dient hier meine Logdatei mit den "load average"-Werten. Die Daten lasse ich minütlich mit einem cron-Job speichern, und wenn ich mit einem Browser das CGI-Skript aufrufe, bekomme ich als Ergebnis ein hübsches PNG oder JPG.

Zur Erinnerung: die "load average" gibt an, wieviele Prozesse durchschnittlich während der Probezeit auf die Zuteilung von CPU-Zeit warten mussten. Werte für den Zeitraum "1 min", "5 min" und "15 min" werden erfasst. Diese Angaben erhält man auf der Kommandozeile am bequemsten mit dem Befehl "uptime" (so gut wie alle Unixe, AIX, Solaris, BSD etc.) oder mit dem /proc-Pseudo-Filesystem (nur Linux).

So funktioniert der Aufruf des CGI-Skripts im Browser:

Der Parameter "what" gibt an, welche "load average" gemeint ist (1, 5, 15), "xmax" und "ymax" überschreiben die Defaultwerte im Skript mit anderen Größenangaben. Weiterhin sind noch "hours" (anderer Zeitraum als 24h) und "single" möglich. Im Normalfall werden in einen Graphen alle drei Kurven gemalt; wenn "what" und "single" verwendet werden, ist in der Grafik nur diese eine Kurve enthalten.

http://meinserver.domain/cgi-bin/loadavg.pl?what=1&xmax=550&ymax=150

Hier ist der cron-Job:

# load avg

* * * * * /usr/local/bin/loadavg.pl -d 7 >/dev/null 2>&1

... und das Skript, das aufgerufen wird:

Das Skript speichert in der Datendatei maximal soviele Tage, wie im Parameter -d angegeben sind (default 1 Tag). Auf diese Weise hat das Skript seinen eigenen logrotate.

#!/usr/bin/perl -w
use Getopt::Std;
use strict 'vars';
use strict 'refs';
use vars qw( $opt_d );
$opt_d=1;
getopts("d:");
my $loadavg="/proc/loadavg";
my $outfile="/var/spool/loadavg";
sub out {
  my ($what,$val)=@_;
  my @val=();
  if (open(IN,"<","$outfile.$what")) {
    @val=<IN>;
    close(IN);
  }
  splice(@val,0,-1440*$opt_d);
  push(@val,$val);
  if (open(OUT,">","$outfile.$what")) {
    print OUT @val,"\n";
    close(OUT);
  }
}
if (open(F,"<",$loadavg)) {
  my ($l1,$l5,$l15)=(split(/\s+/,<F>))[0..2];
  out("1",$l1);
  out("5",$l5);
  out("15",$l15);
  close(F);
}

 ... und das hier ist das CGI-Skript, das die Grafik erzeugt: 

(Meine Erklärungen zu einzelnen Funktionen sind in blauer Schrift dazwischen)

Die Grafik wird eigentlich nur mit einem einzigen Befehl erzeugt, nämlich dem

print $graph->plot(\@data)->$format();

ganz am Ende. Der ganze Krams vorher dient dazu, eine schöne Beschriftung herzustellen und eine Skalierung zu berechnen, damit das hübsch aussieht. Und natürlich der CGI-Kram, um den Parameter aus der "Kommandozeile" auszuwerten.

#!/usr/bin/perl -w

use strict 'vars';
use strict 'refs';

use GD::Graph;
use GD::Graph::lines;
use GD::Graph::linespoints;
use GD::Graph::points;
use GD::Graph::bars;
use CGI qw(:standard);

my @data;
my $graph;
my $format;
my $maxscale;
# zeitabstand in sek.
my $index=60;
my ($xmax,$ymax)=(600,400); # die gewünschte Größe der Grafikdatei
my $hours=1;
my $dir="/var/spool";
my $file1 ="$dir/loadavg.1";
my $file5 ="$dir/loadavg.5";
my $file15="$dir/loadavg.15";
my $query;
# default 5 min.
my $req=5;
my $file;
my $single=0;

# X-Beschriftung
# werte1
# werte2
# ...
@data = (
[""],
[],
[],
[],
);
# loadread lädt aus der Datendatei $file die neuesten $min Einträge
sub loadread {
  my ($file,$min)=@_;
  my @val=();

  if (open(IN,"<","$file")) {
    @val=<IN>;
    chomp(@val);
    close(IN);
    if (scalar(@val)>$min) {
      splice(@val,0,-$min);
    }
  }
  return \@val;
}
# arraymax sucht aus einer Liste von Arrayrefs das maximale Element
sub arraymax {
  my $m=0;

  foreach my $a (@_) {
    foreach my $i (@{$a}) {
      $m=$i if ($i>$m);
    }
  }
  return $m;
}
# xtext erzeugt die Beschriftung der X-Achse
sub xtext {
  my ($ref,$start,$diff,$gap)=@_;
  my $cnt=scalar(@$ref);
  my $s=$diff/$gap;
  my $i;
  my $time;
  my @t;

  $start-=($cnt*$diff);
  for ($i=0; $i<$cnt; ++$i) {
    @t=(localtime($start+$i*$diff))[1..2];
    $time=sprintf("%02d:%02d",$t[1],$t[0]);
    if ($i % $s) {
      $data[0]->[$i]="";
    }
    else {
      $data[0]->[$i]=$time;
    }
  }
}

$query=new CGI();
$req=$query->param( 'what' ) || 1;
$xmax=$query->param( 'xmax' ) || 800;
$ymax=$query->param( 'ymax' ) || 600;
$hours=$query->param( 'hours' ) || 24;
$single=$query->param( 'single' ) || 0;
$single=0;

$graph = GD::Graph::lines->new($xmax, $ymax);
$format = $graph->export_format;

# calc minutes
$data[1]=loadread($file1, $hours*60);
$data[2]=loadread($file5, $hours*60);
$data[3]=loadread($file15,$hours*60);
$file=$file1;

$maxscale=arraymax($data[1],$data[2],$data[3]);
$maxscale=int($maxscale*100)/100;
xtext($data[1],(stat($file))[9],$index,$req);

unless ($single) {
  $data[1]=$data[2] if ($req==5);
  $data[1]=$data[3] if ($req==15);
  delete $data[2];
  delete $data[3];
}

$graph->set(
  x_label => 'Time',
  y_label => 'Load',
  title => 'Load avg '.$req,
  y_max_value => $maxscale,
  y_tick_number => 10,
  y_label_skip => 2,
  x_label_skip => 2*$index,
) or die $graph->error;
$graph->set(
  marker_size => 1,
) or die $graph->error;

print header("image/$format");
binmode STDOUT;
print $graph->plot(\@data)->$format();

perl gegen einen Facebook-Hoax

Auf Facebook und sicherlich auch an anderen Stellen kursiert derzeit ein Gerücht, dass angeblich eine bestimmte Konstellation von Wochentagen nur alle 823 Jahre vorkommt und man deshalb irgendetwas Abergläubisches tun müsste.

Genauer gesagt: es geht darum, dass angeblich das Auftreten von fünf kompletten Wochenenden (also Freitag, Samstag, Sonntag) in einem Kalendermonat extrem selten sein soll.

Klingt erstmal plausibel: die Woche hat sieben Tage, der Monat zwischen 28 und 31, wie häufig kann es also sein, dass fünf vollständige Wochenenden in so wenig Zeit passen? Gefühlt also extrem selten, und deshalb sind die meisten Leute gern gutgläubig und nehmen diese Behauptung für bare Münze, ohne selbst darüber nochmal nachzudenken.

Nehmen wir die Behauptung mal auseinander: damit in einen Monat wirklich fünf Wochenenden passen, muss der letzte Sonntag offensichtlich der 31. sein. In kürzeren Monaten mit 30, 29 oder 28 Tagen ist das nicht möglich.

Wenn also Sonntag der 31. ist, ist automatisch der 3. ein Sonntag (minus 28) und der 1. muss ein Freitag sein.

Was macht ein Informatiker nun? Er hackt sich ein kleines Programm zusammen, um mit brutaler Gewalt (wenn man aus der Fachsprache das "brute force" übersetzt) alle Möglichkeiten durchzuprobieren. Es reicht also, alle Monate mit 31 Tagen zu untersuchen, ob der 1. ein Freitag ist. Falls ja, haben wir einen solchen Treffer gefunden.

Hier ist ein solches Programm in der Skriptsprache perl, mal eben auf die Schnelle zusammen"gekloppt", um zu gegebenem Intervall (Anfangs- und Endejahr) alle Monate zu finden, auf die diese Bedingung zutrifft.

#!/usr/bin/perl -w
use POSIX;
my ($y,$m,$d);
# liste der monate mit 31 tagen
my @monate=(1,3,5,7,8,10,12);
# finde monate mit 5 vollen wochenenden
# das sind alle monate mit freitag als 1. und 31 tage
my ($anfang,$ende)=@ARGV;
$anfang=2000 unless ($anfang);
$ende=2019 unless ($ende);
# schleife fuer jahre
for ($y=$anfang; $y<$ende; ++$y) {
# schleife fuer monate
foreach $m (@monate) {
# unix timestamp fuer den 1. des monats $m im jahr $y mit der POSIX funktion mktime
# jahr 1900 ist 0, 2013 ist 113 fuer POSIX
# monate ab 0 gezaehlt (0=januar)
# tage ab 1 gezaehlt
my $time_t=POSIX::mktime( 0, 0, 0, 1, $m-1, $y-1900 ) || 0;
# den wochentag bestimmen (0=sonntag)
my $wday=(localtime($time_t))[6];
if ($wday==5) {
printf "# %02d.%04d\n",$m,$y;
}
}
}

Und siehe da: das ist gar nicht mal so selten. Man findet zwar in der Liste auch Jahre, in denen kein solches Vorkommnis vorkommt ;) (Sie sehen, dass Sie nichts sehen ...), aber es gibt auch Jahre mit sogar zwei Monaten, in denen der 1. auf einen Freitag fällt.

$ perl test.pl 2000 2019
# 12.2000
# 03.2002
# 08.2003
# 10.2004
# 07.2005
# 12.2006
# 08.2008
# 05.2009
# 01.2010
# 10.2010
# 07.2011
# 03.2013

 Wenn ich mein Skript von 1900 bis 2099 suchen lasse, finde ich insgesamt 198 Treffer.

$ perl test.pl 1900 2099 |wc -l
198