Perl/Tk bietet die Möglichkeit, Ereignisse zeitgesteuert auszuführen.
Also mit einer Verzögerung, wie man das von einem Timer oder einer Eieruhr kennt.
Die Ereignisse nennt man Callback, eine Art Rückruf an die Applikation, dass was getan werden soll.
In Einführung in Perl/TK
Mit after() kann man eine Sub nach Ablauf einer Zeitspanne ausführen lassen.
Man kann sich das wie eine Eieruhr vorstellen.
Der nachfolgende Quellcode zeigt ein Perl/Tk-Programm, in dem nach einem Klick auf einen Button 1 Sekunde gewartet wird.
Nach Ablauf der Sekunde wird ein Fortschrittsbalken um einen Schritt hochgezählt.
Das wird über after() realisiert.
Bemerke: man kann mehrmals klicken. Es wird jeweils 1 Sekunde gewartet.
#!perl
use strict;
use warnings;
use utf8;
use Tk;
use Tk::ProgressBar;
# Ein neues Hauptfenster erzeugen:
my $mw = Tk::MainWindow->new(
-width => 640,
-height => 480,
);
$mw->packPropagate(0);
my $percent_done = 0;
my $progress = $mw->ProgressBar(
-width => 20,
-length => 200,
-from => 0,
-to => 10,
-blocks => 10,
-colors => [0, 'green', 5, 'yellow' , 8, 'red'],
-variable => \$percent_done
)->pack(-fill => 'both', -expand => 1,);
$mw->Button(
-text => '1 Sekunde warten und dann den Fortschrittsbalken ein Stück füllen',
-command => sub{
$mw->after(1000, sub{
my $val = $progress->value();
my $max = $progress->cget('-to');
# es läuft bereits eine WDH
if( $val >= $max ) {
# Balken ist voll, auf 0 zurücksetzen
$percent_done = 0;
}else{
# Balken ist noch nicht voll
$percent_done++;
}
});
},
)->pack;
$mw->MainLoop;
exit(0);
Der nachfolgende Quellcode zeigt ein Perl/Tk-Programm, in dem nach einem Klick auf einen Button 10 Sekunden gewartet wird.
Nach Ablauf der 10 Sekunden wird ein Alarm-Popup eingeblendet.
Das wird über after() realisiert.
Beim Klick auf den Button wird per after(10000, sub{...}) definiert, dass nach 10.000 Millisekunden die anonyme Sub (der Inhalt von sub{}) aufgerufen wird.
#!perl
use strict;
use warnings;
use Tk;
use Tk::After;
my $mw = MainWindow->new();
$mw->geometry("400x200");
$mw->Button(-text => 'Warte...', -command => sub{
$mw->after(10000, sub{
my $answer = $mw->messageBox(
-icon => 'info',
-type => 'ok',
-title => 'Fertig!',
-message => 'Zehn Sekunden sind um',
);
});
})->pack;
$mw->MainLoop();
exit(0);
repeat($x_millisekunden, $callback) führt einen $callback immer wieder nach $x_millisekunden.
Der Prozess kann mit $timer_id->cancel(); wieder beendet werden.
Per repeat() wird übrigens auch gerne bei Perl/Tk in Verbindung mit Threads gepollt, ob es etwas neues gibt.
Oder man aktualisiert ein Text-Widget mit dem Inhalt einer überwachten Log-Datei.
Die Aufgabe ist nicht ganz so trivial, aber das liegt eher am Überwachen der Datei und weniger am repeat()-Befehl.
Der nachfolgende Quellcode prüft regelmäßig, ob auf die Datei zugegriffen wurde.
Wird ein neuer Zugriff festgestellt, wird der neue Inhalt in das Read-Only-Text-Widget eingefügt.
So ein Zugriff kann z.B. eine Schreib-Operation gewesen sein, bei der Log-Meldungen an die Datei angefügt wurde.
Das klappt für Apache-Webserver-Logdateien zum Beispiel nicht, weil der Apache die Datei permanent im Zugriff hat. Wer sowas braucht, der kann hier schauen: Apache-Logmeldungen in Tk-Fenster beobachten.
#!perl
use strict;
use warnings;
use utf8;
use FindBin qw/$Bin/;
use Tk;
use Tk::ROText;
my $dat = {
'dname' => $Bin . '/logdatei.txt',
'dtime' => 0,
'lines' => 0,
};
my $mw = MainWindow->new;
my $ro = $mw->Scrolled('ROText',
-scrollbars => 'ose',
-wrap => 'word',
-width => 80,
-height => 20,
-bg => 'white',
-font => [ 'small font', 7 ],
)->pack(-fill => 'both', -expand => 1,);
# repeat ( [Zeit in ms] => [Subfunktion] )
$mw->repeat(1000 => \&check_and_fill);
$mw->MainLoop;
exit(0);
sub check_and_fill { # Nur ausführen, wenn 'atime' anders ist, als gemerkter Wert
if (-M $dat->{'dname'} != $dat->{'dtime'}) { # Logdatei öffnen
# Datei geöffnet, Zeilen überspringen, die schon eingelesen wurden
if (open my $log, '<encoding(utf8)', $dat->{'dname'}) {
for (0 .. $dat->{'lines'}) { my $tmp = <$log>; }
# weitere Zeilen auslesen und nun auch verarbeiten
while (my $tmp = <$log>) {
$tmp .= "\n" unless $tmp =~ m/\n$/;
# hinten im Textfeld die neuen Zeilen anfügen
$ro->insert('end', $tmp);
# Zeilen mitzählen fürs nächste mal Einlesen
$dat->{'lines'}++;
}
close $log;
# Nach unten scrollen, (wenn möglich/nötig)
$ro->yview('end');
# geänderte Dateieigenschaft 'atime' merken
$dat->{'dtime'} = -M $dat->{'dname'};
}
}
} # /check_and_fill
afterIdle($callback) führt einen $callback aus, wenn die Ereignis-Schleife (MainLoop) das nächste Mal nichts zu tun hat.
Deshalb wird auch keine Zeitangabe übergeben. Die Bedingung, die erfüllt sein muss, damit der Callback ausgeführt wird, ist der Umstand, dass die GUI gerade nichts zu tun hat - und nicht der Ablauf einer bestimmten Zeit.
Der MainLoop hat dann z.B. nichts zu tun, wenn keine Ereignisse durch den Benutzer ausgelöst werden.
Wenn also keiner klickt, keiner das Fenster bewegt, nichts aktualisiert wird usw.
Typischerweise wird der afterIdle()-Befehl dann verwendet, wenn man die GUI während einer längeren Berechnung nicht einfrieren lassen will (und man für dieses Problem keine Threads benutzt).
Hat man eine längere Berechnung durchzuführen und möchte aber trotzdem, dass die GUI weiterhin reagiert, kann man die Berechnung in lauter kleine Teile aufteilen.
Jeder Teil für sich sollte so schnell bearbeitet werden können, dass die GUI trotz der Zeit, die der Prozessor für die Aufgabe benötigt, nicht einfriert.
Üblicherweise wird nach Ausführung solch einer Teilaufgabe dann $mw->update();, um die GUI wieder zu beleben.
update() ist allerdings eine eher rechenaufwendige Operation.
Geschickter ist hier, den Befehl afterIdle() zu verwenden.
Als Callback wird die Teilaufgabe angegeben. Und immer, wenn der MainLoop nichts zu tun hat, treibt er die Aufgabe ein bisschen weiter.
So kann beispielsweise ein Fortschrittsbalken aktualisiert werden, in Abhängigkeit zum Erfüllungsgrad der Gesamtaufgabe.
Von der Auswirkung auf die Performance her ist afterIdle() besser als update() oder update idletasks.
Das nachfolgende Beispiel zeigt eine solche Verwendung von afterIdle().
#!perl
use strict;
use warnings;
use utf8;
use 5.016;
use FindBin qw/$Bin/;
use Tk;
use Tk::ROText;
use File::Slurper qw/write_text/;
#
# Programm zum Auffinden von Primzahlen in einer Datei mit je 1 Zahl pro Zeile.
#
# Datei, in der Testdaten gespeichert werden
my $test_file = 'prime-candidates.txt';
my $mw = Tk::MainWindow->new;
my $ro = $mw->Scrolled('ROText',
-scrollbars => 'ose',
-wrap => 'word',
-width => 80,
-height => 20,
-bg => 'white',
-font => [ 'small font', 7 ],
)->pack(-fill => 'both', -expand => 1,);
my $button_frame = $mw->Frame->pack(-side => 'bottom', -fill => 'x');
$button_frame->Button(
-text => 'Test-Datei erstellen',
-command => sub{
my $content = '';
foreach my $num ( 1 .. 50000 ) {
$content .= "$num\n";
}
File::Slurper::write_text($test_file, $content);
return;
},
)->pack;
$button_frame->Button(
-text => 'Prüfung starten',
-command => sub{
# Datei öffnen, damit man sie abarbeiten kann
open(my $fh, '<:encoding(UTF-8)', $test_file) or die "Could not open file '$test_file' $!";
tick($fh); # 1st trigger
},
)->pack;
$mw->MainLoop;
exit(0);
sub tick {
my $fh = shift;
say "Mir ist langweilig...";
my $num = <$fh>;
chomp($num);
my $is_prime = isPrime($num);
$ro->insert('end', "$num is " . ($is_prime == 0 ? 'not ' : '') . "a prime\n");
$ro->see('end');
# 1 Sekunde Verzögerung, um dem Nutzer die Chance für eine Eingabe zu geben
$mw->after(1000, sub{
$mw->afterIdle(sub{ tick($fh); });
});
}
sub isPrime {
my $number = shift;
my $sqrt = sqrt $number;
my $d = 2;
while (1) {
return 0 if ( $number % $d == 0 );
return 1 if ( $d > $sqrt );
$d++;
}
}