Higher Order Perl

Max Maischein

Frankfurt.pm

Was ist Perl Höherer Ordnung ?

"Higher Order Perl" ist ein Buch von Mark Jason Dominus (2005), in dem er sehr interessante Programmiertechniken erläutert.

Warum?

Ein echter Fortran Programmierer programmiert Fortran in jeder Sprache

Eine harte Aussage, aber einen gewissen Dialekt behält man von jeder Sprache, die man lernt.

Finde den Programmierer

 1:  # C / C++
 2:  for (my $i = 0; $i++; 10 > $i) {
 3:      print "Hello World\n";
 4:  }
 5:  
 6:  # Perl
 7:  print "Hello World\n" x 10;

Tradition

  • C

  • Shell

  • sed, awk

Perl steht in der Tradition von C und *sh (und sed und awk), bzw. wurde durch Programmierer gelehrt, die selber Programmieren in sed und awk (und C und *sh) gelernt haben.

Wenn man einen Blick über diesen Tellerrand wirft, und Perl und C mit Lisp vergleicht, so fällt auf, daß Perl viel mehr Features mit Lisp gemein hat als C:

Vergleich mit C

  • Syntax

     1:    {} [] ->
  • libc / Funktionsaufrufe

     1:    printf getc socket ...

Vergleich mit Lisp

Perl und Lisp:

  • Automatische Speicherverwaltung

  • Dynamischer Zugriff auf die Symboltabelle

  • Der gesamte Sprachumfang ist immer vorhanden (eval)

  • Funktionen als Werte erster Klasse

Warum nur?

  • Seit 1957

  • Sehr von Lisp überzeugt

  • Komische Sprache

  • "Elfenbeinturm"

Lisp-Programmierer verwenden diese Features seit 1957, und hatten also genug Zeit herauszufinden, welche Techniken funktionieren und welche nicht.

Lisp has the visual appeal of fingernail clippings in oatmeal -- Larry Wall

Niemand möchte aber Lisp-Programmierern zuhören - sie sind sehr überzeugt von ihrer Programmiersprache und halten damit auch nicht hinterm Berg. Mark Jason Dominus hat sich mit den Themen ausführlich beschäftigt und zeigt, wie man Lisp-artige Techniken in Perl verwenden kann.

Überblick

Drei der Features, die Perl und Lisp gemeinsam haben, werden genauer betrachtet:

  • Referenzen

  • Rekursion

  • Dynamischer Zugriff auf die Symboltabelle

    - Ein Cache-Mechanismus, der ohne Änderung des Codes auskommt

  • Automatische Speicherverwaltung

    - Fast zu trivial

    - aber nur fast

  • Funktionen als Werte erster Klasse

    - map, grep

    - Callbacks

    - Iteratoren

    - unendliche Listen

Kurzer Refresher zu Referenzen

  • Skalare: my $ref = \$foo

     1:  print $$ref;
  • Arrays: my $ref = [ 'foo', 'bar', 'baz ]

     1:  push @$ref, "Noch ein Element";
     2:  print $ref->[0];

Kurzer Refresher zu Referenzen

  • Hashes: my $ref = { sprache => 'en-DE', name => Max }

     1:  %$ref = ( name => 'Max', sprache => 'de-DE' );
     2:  print "Hallo, ",$ref->{name};
  • Code: my $ref = sub { print "Hallo $_[0]!\n"; }

     1:  $ref->("Max");

Rekursion

Rekursiv, adj.: Siehe rekursiv

Klassische Beispiele:

  • Anzahl von Permutationen

  • Fibonacci-Funktion

Beispiel für Rekursion

  • 1. Jede Zahl ist entweder "gerade" oder "ungerade".

  • 2. Eine Zahl n heißt "gerade", wenn n-1 ungerade ist.

  • 3. Eine Zahl n heißt "ungerade", wenn n-1 gerade ist.

  • 4. 0 ist eine gerade Zahl.

Beispiel für Rekursion

Beispiel: Ist fünfhundertdreiundvierzig gerade?

  • 543 -> 542 -> ... -> 1 -> 0:

  • 0 ist gerade

  • 1 ist ungerade

  • ...

  • Fünfhundertdreiundvierzig ist ungerade

Beispiel für Rekursion

Die Regeln lassen sich direkt in Perl Code übersetzen:

 1:  sub gerade {
 2:      my $zahl = $_[0];
 3:      # 0 ist eine gerade Zahl.
 4:      return 1
 5:          if ($zahl == 0);
 6:      # Eine Zahl n heißt "gerade", wenn n-1 ungerade ist.
 7:      return 1
 8:          if (! gerade($zahl-1));
 9:      # Eine Zahl n heißt "ungerade", wenn n-1 gerade ist.
10:      return 0
11:          if (gerade($zahl-1));
12:      # Jede Zahl ist entweder "gerade" oder "ungerade".
13:      die "Die Zahl $zahl ist weder gerade noch ungerade.";
14:  };

Wo hilft Rekursion?

  • Probleme, die sich gut in gleichartige, aber kleinere Probleme teilen lassen

  • Beispiel: Hierarchische Daten

Hierarchische Daten

  • Dateisysteme

  • HTML, XML

  • LDAP-Verzeichnisse

Beispiel - Größe eines Verzeichnisbaums

  • Größe eines Verzeichnisses ist die Summe der Größen aller Unterverzeichnisse und der Größen aller Dateien im aktuellen Verzeichnis

  • Größe einer Datei wird von -s $file geliefert

Beispiel (2) - Größe eines Verzeichnisbaums

 1:  use strict;
 2:  use File::Spec;
 3:  
 4:  # Aufruf:
 5:  print dir_size('.');
 1:  sub dir_size {
 2:      my ($dir) = @_;
 3:      my $dir_handle;
 4:      if (! opendir $dir_handle, $dir) {
 5:          warn "Konnte '$dir' nicht lesen: $!";
 6:          return 0
 7:      };

Beispiel (3) - Größe eines Verzeichnisbaums

 1:      my $gesamt = 0;
 2:      for my $eintrag (readdir $dir_handle) {
 3:          next if $eintrag =~ /^\.{1,2}$/;
 4:          
 5:          if (-f File::Spec->catfile($dir,$eintrag)) {
 6:              #  Dateigröße aufaddieren
 7:              $gesamt += -s File::Spec->catfile($dir,$eintrag);

Beispiel (4) - Größe eines Verzeichnisbaums

 1:          } else {
 2:              # Verzeichnis, Größe rekursiv holen
 3:              $gesamt += dir_size(File::Spec->catdir($dir,$eintrag));
 4:          }
 5:      };
 6:      return $gesamt;
 7:  }

Anpassung / Adaption

Zielgerichtete Werkzeuge sind effizient

(Photo von itspaulkelly)

Anpassung / Adaption

... aber anpassungsfähige Werkzeuge sind besser

Callbacks

Anpassung durch mitgegebenen Code.

Eingebaute, anpassbare Funktionen sind zum Beispiel:

 1:  sort  map  grep
 1:  my @mp3s = grep { 
 2:                    print "Prüfe $_\n"; 
 3:                    /\.mp3$/i 
 4:                  } @dateien;

Eigene Callbacks

Statt der Größenberechnung wollen wir möglicherweise feststellen, welches Lied das längste mp3-Lied in einem Verzeichnisbaum ist.

dir_walk als Callback

 1:  Program 
 2:    -> dir_walk($callback, 'C:/') 
 3:         -> $callback->('C:/autoexec.bat')
 4:         -> $callback->('C:/config.sys')
 5:         ...
 6:         -> $callback->('C:/windows')
 7:         -> $callback->('C:/windows/system32')
 8:         ...

Callbacks

 1:  sub dir_walk {
 2:      my ($callback, $dir) = @_;
 3:      ...
 4:          if (-f File::Spec->catfile($dir,$eintrag)) {
 5:              # Callback aufrufen
 6:              $callback->(File::Spec->catfile($dir,$eintrag))
 1:          } else {
 2:              # Callback aufrufen
 3:              $callback->(File::Spec->catfile($dir,$eintrag));
 4:              # und absteigen
 5:              dir_walk($callback, File::Spec->catdir($dir,$eintrag))
 6:          }
 7:  }

dir_size mit Callback

Der folgende, naive Code funktioniert nicht immer - sobald dir_walk innerhalb von dir_walk aufgerufen wird, funktioniert er nicht mehr.

 1:    my $gesamt = 0;
 2:    sub collect_size { $gesamt += -s $_[0] };
 3:    dir_walk(\&collect_size, '.');
 4:    print "$gesamt\n";

dir_size mit Callback (2)

So funktioniert der Code:

 1:    sub dir_size {
 2:        my ($dir) = @_;
 3:        my $gesamt = 0;
 4:        return dir_walk(sub { $gesamt += -s $_[0] }, $dir);
 5:    };

Andere Verwendung von dir_walk

 1:    sub laengstes_mp3 {
 2:        my ($dir) = @_;
 3:        my ($name, $dauer);
 4:        dir_walk(sub { 
 5:          return if ($_[0] !~ /\.mp3$/i); # kein mp3
 6:          my $spieldauer = get_mp3_playlength($_[0]);
 7:          return if ($spieldauer <= $dauer); # zu kurz
 8:          $name = $_[0];
 9:        }, $dir);
10:        return $name;
11:    };

groesser_als

Ein weiteres Beispiel ist das Finden aller Dateien, die größer als eine bestimmte Datei sind:

 1:    sub groesser_als {
 2:        my ($file,$dir) = @_;
 3:        my $size = -s $file;
 4:        my @result;
 5:        dir_walk(sub{
 6:            push @result, $_[0]
 7:                if -f $_[0] and -s $_[0] > $size;
 8:        })
 9:        @result
10:    }

Was haben wir jetzt?

  • File::Find funktioniert genau so.

  • Nur besser (zumindestens oft)

  • Ist bei jedem Perl dabei

...

Caching und Memoize

Kleine Erweiterung von groesser_als:

Liefere den Namen der grössten Datei zurück:

 1:    sub ist_groesste_datei {
 2:        my ($file,$dir) = @_;
 3:        my @groessere_dateien = groesser_als($file,$dir);
 4:        @groessere_dateien == 0
 5:    };

Caching und Memoize

Finde die groesste Datei:

 1:    sub groesste_datei {
 2:        my ($dir) = @_;
 3:        my $groesste;
 4:        dir_walk(sub{
 5:            $groesste = $_[0]
 6:                if ist_groesste_datei($_[0],$dir);
 7:        }, $dir);
 8:        return $groesste;
 9:    }

Caching und Memoize

groesste_datei ist sicher nicht optimal:

 1:    /foo
 2:    /foo/bar.txt
 3:    /foo/baz.gz
 4:    /foo/zap.txt
  • Zuerst wird /foo/bar.txt angeschaut; die Größe jeder Datei wird untersucht.

  • Dann nochmal für /foo/baz.gz

  • Dann nochmal für /foo/zap.txt

  • Das geht schneller

Caching machts schneller

  • ... indem wir uns die Ergebnisse von groesser_als merken

  • Caching ist eine einfache Idee

  • Tausch: Arbeitsspeicher gegen Laufzeit

  • Ein Cache einzubauen ist in Perl nicht schwer

Einbauen eines Caches

 1:    {
 2:      my $real_groesser_als = \&groesser_als;
 3:      my %cache;
 4:      sub groesser_als_cached {
 5:        my ($file,$dir) = @_;
 1:        if (exists $cache{"$file\0$dir"}) {
 2:            # Wir kennen den Wert
 3:            return @{ $cache{"$file\0$dir"} }
 1:        } else {
 2:            # Wir kennen den Wert noch nicht
 3:            return $cache{"$file\0$dir"} 
 4:              = [ $real_groesser_als->($file,$dir) ]
 5:        }
 6:      }
 7:    }

Installieren des Caches

 1:    # Cache installieren:
 2:    *groesser_als = \&groesser_als_cached;

Caching

  • Keine neue Idee

  • Aber eine sehr einfache Idee

  • Und deshalb oft und viel verwendet

Universelles Cachen

  • Diese Methode des Cachings funktioniert für jede Funktion

  • Außer für Funktionen, die für denselben Wert verschiedene Ergebnisse liefern

  • Zum Beispiel time() und rand()

 1:    sub memoize {
 2:        my ($slow_code) = @_;
 3:        my %cache;
 4:        return sub {
 5:            my $key = join "\0", @_;
 6:            if (exists $cache{$key}) {
 7:                return $cache{$key}
 8:            } else {
 9:                return $cache{$key} = $slow_code->(@_)
10:            }
11:        }
12:    }

Memoize ist bequem

  • Caching hilft nicht immer

  • Man muß die richtigen Funktionen/Ergebnisse cachen

  • Mit Memoize kann man das Cache an- und abschalten

  • Der Name memoize kommt von der Lisp-Funktion.

 1:    *groesste_datei = memoize(\&groesste_datei);
 2:    
 3:    # oder
 4:    
 5:    use Memoize;
 6:    memoize('groesste_datei');
 7:    
 8:    # das ist alles

Exkurs: Automatische Speicherverwaltung

  • Perl verwaltet den Speicher für uns

  • Ganz automatisch und transparent

  • $liste[ 10000 ] = 1;

Sichtbarkeit und Lebensdauer

my erzeugt eine lexikalische Bindung ("binding") eines Namens an einen Wert:

 1:  my $x = 3;

Eine Bindung besteht nur innerhalb des Sichtbarkeitsbereichs. Perl speichert die aktuell gültigen Bindungen in einer speziellen Datenstruktur, dem "Pad".

use strict; hilft, bei lexikalischen Variablen (my) die Bindungen zu überprüfen.

Sichtbarkeit Beispiel 1

Sichtbarkeit hängt nur vom Quellcode ab:

  • Klar bei globalen Variablen

  • Auch klar bei lexikalischen Variablen

use vars qw($gruss); $gruss = "Hallo";
my $name = "Max";
sub foo {
my $nachricht = "$gruss, $name";
...;
}
my $anrede = "Herr";
...
...

Lebensdauer von Werten

Lebensdauer von Werten und Sichtbarkeit von Bindungen sind nicht das selbe.

Datenstruktur in Zeile 4:

 1:  my $x;
 2:  {
 3:      $x = 3;
 4:      my $r = \$x;
 5:  }

Hier stimmen Lebensdauer und Sichtbarkeit überein.

Lebensdauer von Werten (I/2)

Datenstruktur in Zeile 5 (Zwischenschritt):

 1:  my $x;
 2:  {
 3:      $x = 3;
 4:      my $r = \$x;
 5:  }

Lebensdauer von Werten (I/3)

Datenstruktur in Zeile 5:

 1:  my $x;
 2:  {
 3:      $x = 3;
 4:      my $r = \$x;
 5:  }

Lebensdauer von Werten (II/1)

Datenstruktur in Zeile 4:

 1:  my $r;
 2:  {
 3:      my $x = 3";
 4:      $r = \$x;
 5:  }

Lebensdauer von Werten (II/2)

Datenstruktur in Zeile 5:

 1:  my $r;
 2:  {
 3:      my $x = 3";
 4:      $r = \$x;
 5:  }

Verwendung mit Objekten

 1:  my %self = ...;
 2:  return bless \%self, $class;
  • Geht nicht mit C!

  • Auto-Variable (bzw. Variable auf dem Stack) dürfen nicht nach dem return verwendet werden.

  • In C: malloc / new / free

Anwendung auf memoize

Für das allgemeine Cache sieht das Pad beim Aufruf aus wie folgt:

 1:  sub memoize {
 2:    my %cache;
 3:    my ($func) = @_;
 4:    return sub {
 5:        ...
 6:    };
 7:  };
 1:  my $groesser_als_c = memoize(\&groesser_als);

Doppelter Aufruf: Problem?

  • Was passiert, wenn memoize zwei Mal aufgerufen wird?

     1:  my $x = memoize(groesser_als);
     2:  my $y = memoize(groesser_als);
  • Alles in Ordnung - für jede anonyme Subroutine erstellt Perl ein eigenes Pad und packt es in den CV.

  • Beim Aufruf wird das Pad aktiviert und die Subroutine sieht "ihre" Variablen (d.h. Bindungen).

Beispiel zu Pads und anonymen Subroutinen

Ein ganz simples Beispiel:

 1:  sub neuer_zaehler {
 2:      my ($n) = @_;
 3:      return sub {
 4:          print "n ist jetzt ",$n++,"\n";
 5:      };
 6:  }

Beispiel (Datenstruktur)

 1:  my $x = neuer_zaehler(7);
 2:  my $y = neuer_zaehler(20);

Beispiel (Live-Demo)

 1:  $x->(); $x->(); $x->();
 2:  $y->(); $y->(); $y->();
 3:  
 4:  $x->(); $y->();
Live demo

Zusammenfassung

Das alles war nötig, nur um zu sehen, daß Memoize und Callbacks tatsächlich so funktionieren, wie wir das wollen.

  • Natürlich funktioniert es.

  • In C und anderen Sprachen mit weniger Dynamik funktioniert es nicht.

Ablaufkontrolle

Bild: Staudamm?

  • Callbacks haben ein Problem

  • Hat man einen Callback-Mechanismus angestoßen,

  • ... so ist es schwer, wieder aufzuhören

Ablaufkontrolle

  • Es gibt einen anderen Mechanismus, der die Daten stückweise auf Anfrage liefert.

  • Diamant-Operator, <...>

  • Ist in Perl eingebaut

  • Eine Zeile pro Schleifendurchlauf

Eigene Implementation

  • Eigene Implementation

  • Dateiunabhängig

  • tie: Rel. schwierig, nicht effizient

  • Funktionsaufruf:

     1:    sub mein_iterator { return $naechste_zeile };
     2:    
     3:    my $iterator = \&mein_iterator;
     4:    
     5:    print $iterator->(); # Aufruf

Iteratoren

Dateihandle als Iterator:

 1:  sub witz {
 2:    open my $fh, "<", "witze.txt"
 3:      or die "Heute nichts zu lachen: $!";
 4:    return $fh
 5:  };
 1:  my $witz = witz();
 2:  while (<$witz>) {
 3:      print "Noch ein Witz:\n";
 4:      print "$_\n"; # Ha ha
 5:  };
 6:  # Applaus, Vorhang

Iteratoren

Nachbau eines Iterators als Subroutine:

 1:  sub witz {
 2:    return 'Ein guter PHP Programmierer'
 3:  };
 1:  while (defined (local $_ = witz())) {
 2:      print "Noch ein Witz:\n";
 3:      print "$_\n"; # Ha ha
 4:  };
 5:  # Applaus, Vorhang

Iteratoren, ähnlich wie Filehandles

Iteratoren als Variable:

 1:  my $witz = sub {
 2:    return 'Ein guter PHP Programmierer'
 3:  };
 1:  while (defined (local $_ = $witz->())) {
 2:      print "Noch ein Witz:\n";
 3:      print "$_\n"; # Ha ha
 4:  };
 5:  # Nie Applaus, nie Vorhang

Iteratoren, ähnlich wie Filehandles

 1:  my @witze = (
 2:    'Ein guter PHP Programmierer',
 3:    'Die neue Version von Perl6',
 4:    'Ein lustiger Platzhalter',
 5:  );
 6:  my $witziger = sub {
 7:    return shift @witze;
 8:  };
 1:  while (defined ($_ = $witz->())) {
 2:      print "Noch ein Witz:\n";
 3:      print "$_\n"; # Ha ha
 4:  };
 5:  # Applaus, Vorhang

Erstellen von Iteratoren

open erstellt einen Datei-Iterator. mach_witze erstellt einen Witz-Iterator aus einer Liste:

 1:  sub mach_witze {
 2:      my @witze = @_;
 3:      return sub {
 4:          return shift @witze
 5:      }
 6:  }
 7:  
 8:  my $p_witze = mach_witze(
 9:    'Ein guter PHP Programmierer',
10:    'Die neue Version von Perl6',
11:    'Ein lustiger Platzhalter',
12:  );

Hilfsroutinen

Aus einer Liste machen wir oft Iteratoren, daher definieren wir:

 1:  sub list_iterator(@) {
 2:      my @items = @_;
 3:      return sub {
 4:        return shift @items;
 5:      } 
 6:  }

Erstellen von Iteratoren

open erstellt einen Datei-Iterator. datei_witze erstellt einen Witz-Iterator aus einer Datei:

 1:  sub datei_witze {
 2:      my ($datei) = @_;
 3:      open my $fh, "<", $datei
 4:        or die "Nicht lustig: $!";
 5:      my @witze = chomp <$fh>;
 6:      return sub {
 7:          return shift @witze
 8:      }
 9:  }
10:  
11:  my $alte_huete = datei_witze('best_of_1920.txt');

Ausgabe von Iteratoren

Wir möchten die Ergebnisse von Iteratoren bequem ausgeben, wie Perl-Arrays.

  • Ausgabe von Iteratoren ist mühsam

  • Generische Routine:

 1:  sub output {
 2:      my ($iterator) = @_;
 3:      while (defined (local $_ = $iterator->())) {
 4:          print "$_\n";
 5:      }
 6:  }
 7:  
 8:  output( mach_witze( 'perl6.txt' ));
 1:  # ...
 2:  # ...
 3:  # ...

(Potentiell) Unendliche Iteratoren

  • Iteratoren liefern immer nur ein Element, statt alle Elemente auf einen Schlag.

  • Potentiell unendliche Listen sind möglich:

 1:    sub zaehler {
 2:        my $n = $_[0] || 1;
 3:        return sub {
 4:            return $n++
 5:        }
 6:    }

(Potentiell) Unendliche Iteratoren

 1:    my $zahlen = zaehler();
 2:    output( $zahlen );
 3:    # 1
 4:    # 2
 5:    # 3
 6:    # 4
 7:    # ...
 8:    # bzw. Hitzetod des Universums

Filtern von Iteratoren

  • Nicht alle Zahlen sind interessant

  • Nur gerade Zahlen sind interessant

 1:    sub filter(&$) {
 2:        my ($filter,$i) = @_;
 3:        return sub {
 4:            local $_;
 5:            while (defined (local $_ = $i->())) {
 6:                return $_
 7:                    if $filter->();
 8:            };
 9:            return ()
10:        }
11:    }

filter heißt in Perl grep, aber grep funktioniert nur auf Listen, nicht auf Iteratoren

Filtern von Iteratoren

 1:    my $gerade = filter { $_ % 2 == 1 } $zahlen;
 2:    output( $gerade );
 3:    # 2
 4:    # 4
 5:    # 6
 6:    # 8
 7:    # 10
 8:    # ...

Von hier bis zur Unendlichkeit

Wir können also auch mit unendlichen Mengen arbeiten, solange wir sie nicht auf den Bildschirm ausgeben, oder sonstwie zum Ende der Liste gehen wollen.

Transformationen

Das Verbindungssteckergesetz

  • Jedes Interface ist maximal unbrauchbar

  • a) Iterator zu Callbacks

  • b) Callback zu Iterator

Iterator zu Callback

Iterator zu Callback - ganz einfach:

 1:  sub for_iterator {
 2:      my ($iterator,$callback) = @_;
 3:      while (defined my $val = $iterator->()) {
 4:          $callback->($val)
 5:      }
 6:  };
 1:  for_iterator(mach_witze('stefan_raab.txt'), sub { 
 2:    print $_[0]
 3:  });

Callback zu Iterator

Callback zu Iterator - nicht immer einfach.

"Mund voller Kirschkerne"-Ansatz:

 1:  sub dir_walk_iter {
 2:      my ($dir) = @_;
 3:      my @dateien;
 4:      
 5:      # Das dauert:
 6:      dir_walk($dir,sub { push @dateien, $_[0] });
 1:      return list_iterator { @dateien };
 2:  }

Callback zu Iterator (Verwendung)

Verwendung des Iterators

 1:  my $dateien = dir_walk_iter('.');
 2:  while (defined my $datei = $dateien->()) {
 3:      print "$datei\n";
 4:  }
  • Kein Laufzeitgewinn

  • Kein Gewinn, wenn man nicht alle Dateinamen braucht

Alternativen zum Kirschkern-Ansatz

  • Alles lesen ist nicht faul

  • Alternative 1: zweiter Prozeß mit Dateihandle

  • Alternative 2: Eigener Code

Alternativ-Ansatz mit eigenem Prozess:

 1:  sub dir_walk_iter {
 2:      my ($dir) = @_;
 3:      open my $fh, "find '$dir' |"
 4:          or die "$dir: $!";
 5:      return sub {
 6:          eof $fh ? () : <$fh>
 7:      }
 8:  }

Alternativ-Ansatz mit eigenem Prozess:

 1:  sub dir_walk_iter {
 2:      my ($dir) = @_;
 3:      my $cmd = q{$^X -MFile::Find -le }
 4:              . q{"find(sub{print$File::Find::name},@ARGV);}
 5:              . qq{END{warn 'Einlesen fertig.'}" $dir |};
 6:      warn $cmd;
 7:      open my $fh, $cmd
 8:          or die "$dir: $!";
 9:      return sub {
10:          #local $/ = \0;
11:          my $res = <$fh>;
12:          chomp $res;
13:          return defined $res ? $res : () 
14:      }
15:  }

Eigener Prozeß

Vorteile

  • Multitasking

  • Echtes Filehandle

  • Abgeschotteter Prozeß

Nachteile

  • Keine feine Fehlerkontrolle

  • Abgeschotteter Prozeß

  • Schwierig echt portabel zu halten

Callback zu Iterator

Wir wollen einen Iterator bauen, der nur die nötigsten Daten im Speicher hält, und nicht alles gleich zu Anfang aufsammelt.

  • "Fauler" Iterator

  • Merkt sich, was noch zu tun ist

  • Tut aber nur das nötigste

Fauler dir_walk

  • Merke Dir alle Einträge im aktuellen Verzeichnis

  • Wenn der aktuelle Eintrag ein Verzeichnis ist, liefere den Namen zurück, und ersetze den Verzeichnisnamen durch alle Einträge im Unterverzeichnis

  • Wenn der aktuelle Eintrag eine Datei ist, liefere den Dateinamen zurück und vergiß die Datei

  • Wenn die Liste leer ist, liefere ebenfalls die leere Liste zurück

Fauler dir_walk

 1:    sub dir_walk {
 2:        my ($cb, @dirs) = @_;
 3:        my @agenda = @dirs;
 4:        return sub {
 5:            my $eintrag = shift @agenda;
 6:            
 7:            if (-d $eintrag) {
 8:                print "*** Lese $eintrag ein\n";
 9:                opendir my $dh, $eintrag
10:                    or die "$eintrag: $!";
11:                my @eintraege = grep { /^\.\.?$/ } 
12:                    readdir $dh;
13:                unshift @agenda, map { "$eintrag/$_" }
14:                  @eintraege;
15:            };
16:            return $eintrag;
17:        }
18:    }

Fauler dir_walk

 1:    output( dir_walk( 'C:\.cpan\build\Catalyst-5.64\' ));
 2:    # ...
 3:    # *** Lese C:\.cpan\build\Catalyst-5.64\lib\Catalyst\Plugin ein
 4:    # C:\.cpan\build\Catalyst-5.64\lib\Catalyst\Plugin
 5:    # *** Lese C:\.cpan\build\Catalyst-5.64\lib\Catalyst\Plugin\ConfigLoader ein
 6:    # C:\.cpan\build\Catalyst-5.64\lib\Catalyst\Plugin\ConfigLoader
 7:    # C:\.cpan\build\Catalyst-5.64\lib\Catalyst\Plugin\ConfigLoader\YAML.pm
 8:    # C:\.cpan\build\Catalyst-5.64\lib\Catalyst\Plugin\ConfigLoader.pm
 9:    # *** Lese C:\.cpan\build\Catalyst-5.64\lib\Catalyst\Plugin\Static ein
10:    # C:\.cpan\build\Catalyst-5.64\lib\Catalyst\Plugin\Static

Filter für mp3-Dateien:

 1:    sub mp3s {
 2:        return filter { /\.mp3$/i } dir_walk @_;
 3:    };
 4:    
 5:    output(mp3s);

Fauler Filter für Dateien (und Pipes)

  • Dateien können groß werden

  • Uns interessiert immer nur eine Zeile zur selben Zeit

  • Zum Beispiel bei Log-Dateien

 1:    sub zeilen {
 2:        my ($fh) = @_;
 3:        
 4:        # merken, wo wir waren
 5:        my $pos = tell $fh;
 6:        
 7:        return sub {
 8:            seek $fh, $pos, 0;
 9:            my $line = <$fh>;
10:            $pos = tell $fh;
11:            return $line;
12:        }
13:    }

Fauler Filter für Dateien

  • Warum?

  • Beispiel: Sessions live verfolgen

  • Nicht alle gestarteten Sessions enden auch

  • Wir merken uns alle "laufenden" Sessions

 1:    http://datenzoo.de/session/start/1 10:00
 2:    http://datenzoo.de/session/start/2 10:01
 3:    http://datenzoo.de/session/start/3 10:05
 4:    http://datenzoo.de/session/start/4 10:15
 5:    http://datenzoo.de/session/stop/3  10:16
 6:    http://datenzoo.de/session/stop/4  10:30
 7:    http://datenzoo.de/session/stop/1  10:55
 8:    (Timeout von Session 2)            11:01

Ziel des Session Filters

Das Hauptprogramm soll den Filter in einer einfachen Schleife verwenden können:

 1:  while (my ($nr,$start,$ende) = $session->())) {
 2:      print "Session $nr beendet ($start-$ende)";
 3:  }

Fauler Session-Log-Filter

 1:    sub session_finished {
 2:        my ($zeilen) = @_;
 3:        my %offen;
 4:        return sub {
 5:            while (defined (local $_ = $zeilen->()) {
 6:                if (m!/start/(\d)\s+(\d+:\d+)$!) {
 7:                    $offen{$1} = $2;
 8:                };
 9:                if (m!/stop/(\d)\s+(\d+:\d+)$!) {
10:                    if ($offen{$1}) {
11:                        delete $offen{$1};
12:                        return [$1, $offen{$1}, $2];
13:                    }
14:                }
15:            }
16:        }
17:    }
 1:    output session_finished zeilen \*DATA;

Andere Sortierung

  • session_finished liefert uns die Sessions in Reihenfolge des Endes

  • Wir wollen die Sessions anders sortieren, z.B. nach Reihenfolge der Eröffnung

  • Was ist mit Sessions, die nie enden?

  • => Timeout von 1h - alle Sessions enden nach 1h

  • "cutsort" zum Sortieren unendlicher Listen

Andere Sortierung

 1:  sub nach_start {
 2:      my ($sessions) = @_;
 3:      my @ausgeben;
 4:      my @beendete_sessions;
 5:      return sub {
 6:        if (! @ausgeben) {
 7:          while (my $s = $sessions->()) {
 8:            while (@beendete_sessions 
 9:                    && $s->[1] > $beendete_sessions[0]) {
10:                push @ausgeben, shift @beendete_sessions;
11:            };
12:            @pending = sort { $a->[1] cmp $b->[1] } (@pending,$s);
13:          }
14:        };
15:        return shift @ausgeben
16:          if (@ausgeben);
17:      };
18:  }

Danke

Fragen?