Ziel dieses Artikels ist es zu zeigen, wie ein Widget erstellt wird, das auf einem anderen Widget basiert. Im Speziellen geht es um die Ableitung eines Widgets mit Hilfe von Tk::Derived.
Das ist immer dann nützlich, wenn ein Widget grundlegend die Funktionen hat, die man möchte, aber einem für die eigene Applikation noch etwas fehlt.
Es muss also nicht immer eine Ergänzung zum Perl/Tk-Paket sein, sondern kann auch eine ganz konkrete Erweiterung für einen spezifischen Anwendungsfall sein. Ein Widget, das z.B. nur in der eigenen Anwendung verwendet wird. Das bedeutet in der Folge, dass man so etwas auch nicht unbedingt auf CPAN laden muss. Außer natürlich ganz viele Menschen sagen, dass es da gut aufgehoben wäre, da es für andere Programmierer praktisch wäre. Das kann im Zweifelsfall auch über prepan.org herausgefunden werden.
Natürlich gibt es andere Wege, das gewünschte Ergebnis zu erhalten. Perl hat TIMTOWTDI ganz groß auf den Fahnen stehen. Dieser Artikel soll einfach einmal einen dieser Wege aufzeigen. Er gilt nicht als Referenz oder Paradebeispiel. Er soll den Leser aber befähigen, das Gelesene selbst anzuwenden.
Konkret: Das neue Widget soll Tk::MyOptionScale heißen und für meine Anwendung einige nützliche Funktionen bereit stellen. Zum Beispiel:
Letzteres ist bereits mit der normalen Tk::Scale möglich. Die Methoden heißen get() und set(). Auch das Minimum und das Maximum sind schon vorhanden. Sie entsprechen den Optionen -from respektive -to.
Was fehlt ist also der Default-Wert und die Methode zum Zurücksetzen.
Vorarbeit: ein Rahmen für das Modul muss her. Da gibt es viele Methoden. Ich zeige eine händische mit etwas Arbeit.
Mit h2xs wird ein Modulrahmen erstellt. Eine Anleitung dafür findet sich hier: Wie erstelle ich ein Modul?. Das neue Modul wird im Verzeichnis meines Programms erstellt und soll später mit ausgeliefert werden. Das Programm OptionsDialog liegt im Verzeichnis D:\OptionDialog. Die ausgeführten Befehle lauten wie folgt:
D:
cd OptionDialog
h2xs -b 5.16.3 -XA -n Tk::MyOptionScale
Das Verzeichnis Tk-MyOptionScale wurde nun erstellt. Es stellt den Rahmen für unser Modul dar. Im lib-Verzeichnis gibt es nun das Modul MyOptionScale. Dieses sieht wie folgt aus:
package Tk::MyOptionScale;
use 5.016003;
use strict;
use warnings;
require Exporter;
our @ISA = qw(Exporter);
# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.
# This allows declaration use Tk::MyOptionScale ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
our %EXPORT_TAGS = ( 'all' => [ qw(
) ] );
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
our @EXPORT = qw(
);
our $VERSION = '0.01';
# Preloaded methods go here.
1;
__END__
# Below is stub documentation for your module. You'd better edit it!
=head1 NAME
Tk::MyOptionScale - Perl extension for blah blah blah
=head1 SYNOPSIS
use Tk::MyOptionScale;
blah blah blah
=head1 DESCRIPTION
Stub documentation for Tk::MyOptionScale, created by h2xs. It looks like the
author of the extension was negligent enough to leave the stub
unedited.
Blah blah blah.
=head2 EXPORT
None by default.
=head1 SEE ALSO
Mention other useful documentation such as the documentation of
related modules or operating system documentation (such as man pages
in UNIX), or any relevant external documentation such as RFCs or
standards.
If you have a mailing list set up for your module, mention it here.
If you have a web site set up for your module, mention it here.
=head1 AUTHOR
A. U. Thor, E<lt>a.u.thor@a.galaxy.far.far.awayE<gt>
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2013 by A. U. Thor
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.16.3 or,
at your option, any later version of Perl 5 you may have available.
=cutDinge, die ich nicht benutze fliegen raus. Dazu zählt der Exporter mit seinen per our definierten Variablen. $VERSION bleibt erhalten.
Die Modul-Dokumentation in Form von POD steht derzeit am Ende des Moduls. Da ich ein Fan von Dokumentation an den Stellen bin, wo die Methoden geschrieben werden, wird der POD-Code in das Modul gezogen. Der Zwischenstand sieht wie folgt aus:
package Tk::MyOptionScale;
use 5.016003;
use strict;
use warnings;
our $VERSION = '0.01';
=head1 NAME
Tk::MyOptionScale - Perl extension for blah blah blah
=head1 SYNOPSIS
use Tk::MyOptionScale;
blah blah blah
=head1 DESCRIPTION
Stub documentation for Tk::MyOptionScale, created by h2xs. It looks like the
author of the extension was negligent enough to leave the stub
unedited.
Blah blah blah.
=head1 SEE ALSO
Mention other useful documentation such as the documentation of
related modules or operating system documentation (such as man pages
in UNIX), or any relevant external documentation such as RFCs or
standards.
If you have a mailing list set up for your module, mention it here.
If you have a web site set up for your module, mention it here.
=head1 AUTHOR
A. U. Thor, E<lt>a.u.thor@a.galaxy.far.far.awayE<gt>
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2013 by A. U. Thor
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.16.3 or,
at your option, any later version of Perl 5 you may have available.
=cut
1; # /Tk::MyOptionScaleBevor ich anfange zu programmieren mache ich mir Gedanken, was ich eigentlich erreichen will. Das wird sofort in Dokumentation umgemünzt. Die Modul-Beschreibung (DESCRIPTION) und die Kurzbeschreibung in NAME entstehen.
package Tk::MyOptionScale;
use 5.016003;
use strict;
use warnings;
our $VERSION = '0.01';
=head1 NAME
Tk::MyOptionScale - Extended Tk::Scale with handy methods for minimum, maxiumum, and default value.
=head1 SYNOPSIS
use Tk::MyOptionScale;
blah blah blah
=head1 DESCRIPTION
Tk::MyOptionScale is a L<Tk::Scale> with additional methdos for minimum, maximum, and default value.
The widget knows it's default value and it is to reset to the default value by calling C<reset_scale>.
The current value of the L<Tk::Scale> is accessible via C<current_value>.
=head1 SEE ALSO
This is a L<Tk> widget. It's derived from L<Tk::Scale>.
=head1 AUTHOR
Author Name, E<lt>author@name.tldE<gt>
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2013 by A. U. Thor
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.16.3 or,
at your option, any later version of Perl 5 you may have available.
=cut
1; # /Tk::MyOptionScaleJetzt geht es ans Entwerfen und Kodieren. Tk-Widgets werden mit Tk::Derived abgeleitet. Eine Beschreibung dazu findet sich hier: Tk::Derived.
Die Definition wovon sich das Modul ableitet wird übernommen und angepasst. In diesem Fall wird von Scale abgeleitet. Die Elternklassen sind also Tk::Derived und Tk::Scale.
Der Befehl Construct erzeugt mein Widget mit dem ausgewählten Namen MyNewWidget.
Die Methoden werden in die Sektion METHODS aufgenommen und sofort beschrieben (wenn auch erst einmal nur kurz und knapp). Die Methoden werden nach Bedarf angepasst.
Zeit für einen ersten Test. Alle Methoden des geerbten Widgets müssten ja noch funktionieren. Ein Test-Skript wird es zeigen.
#!perl
use strict;
use warnings;
use utf8;
use Data::Dumper qw/Dumper/;
use FindBin qw/$Bin/;
use lib $Bin . '/Tk-MyOptionScale/lib';
use Tk;
use Tk::MyOptionScale;
my $mw = tkinit();
my $value = 25;
my $scale = $mw->MyOptionScale(
-label => 'Scale',
-orient => 'horizontal',
-from => 10,
-variable => \$value,
)->pack;
$mw->MainLoop;
exit(0);
Jetzt geht es an die Erweiterung. Das Widget soll wissen, was der Default-Wert, das Minimum und das Maximum sind. Minimum und Maximum gibt es bereits als Parameter. Es fehlt noch der Default-Wert.
Dieser wird nun einfach in der Methode Populate hinzugefügt.
Für den Fall, dass –default nicht definiert wurde, sollte das Verhalten halbwegs logisch ausfallen. Bei der herkömmlichen Tk::Scale steht die Skala auf 0, wenn man das Widget ohne weitere Infos aufruft. Wenn man den Minimalwert ändert und sonst nichts angibt, dann steht die Skala auf dem Minimalwert.
Dieses Verhalten wird mit folgenden Zeilen bewirkt:
sub Populate {
my( $self, $args ) = @_;
$self->SUPER::Populate( $args );
my $default = delete $args->{-default};
unless( defined $default ) {
if( exists $args->{'-variable'} and defined ${$args->{'-variable'}} ) {
$default = ${$args->{'-variable'}};
}elsif( exists $args->{'-from'} and defined $args->{'-from'} ) {
# Imitate behavior of Tk::Scale. If no -variable is given, the scale starts with -from value.
$default = $args->{'-from'};
}else{
# Imitate behavior of Tk::Scale. If no -from and no -variable is given, the scale starts from 0.
$default = 0;
}
}
$self->ConfigSpecs(
'DEFAULT' => [$self],
'-default' => [ 'PASSIVE', 'default', 'Default', $default ],
);
$self->Delegates(
'DEFAULT' => $self,
);
return;
} # /PopulateEs fehlt jetzt noch eine Methode, um das Widget auf den Default-Wert zu setzen. Diese schreiben wir noch schnell dazu:
=head2 reset_to_default()
Resets the scale to the default value.
=cut
sub reset_to_default {
my $self = shift;
$self->set($self->cget('-default'));
return;
} # /reset_to_defaultDie neue Funktion und der Default-Wert werden umgehend mit einem kleinen Programm getestet:
#!perl
use strict;
use warnings;
use utf8;
use Data::Dumper qw/Dumper/;
use FindBin qw/$Bin/;
use lib $Bin . '/Tk-MyOptionScale/lib';
use Tk;
use Tk::MyOptionScale;
my $mw = tkinit();
my $value = 25;
my $scale = $mw->MyOptionScale(
-label => 'Scale',
-orient => 'horizontal',
-default => 50,
-from => 10,
-variable => \$value,
)->pack;
$mw->Button(
-text => 'reset to default',
-command => sub{
$scale->reset_to_default;
return;
},
)->pack;
$mw->MainLoop;
exit(0);Das Ergebnis sieht wie folgt aus: es erscheint eine Scale mit dem Wert, der ihr zugewiesen wurde. Dieser muss nicht zwingend der Default-Wert sein. Ein Button erlaubt es, die Scale auf den Default-Wert zurückzusetzen. Die Variable, die durch die Option -variable an die Skala gebunden wurde, wird dabei ebenfalls (automatisch) auf den neuen Wert gesetzt.
Bei der Ausführung von h2xs wurden neben dem Modulrahmen noch weitere Dateien erstellt. Im Einzelnen sind diese hier beschrieben: Wie erstelle ich ein CPAN-konformes Modul?.
Diese Dateien werden nun noch abschließend angepasst, damit aus ihnen und dem Modul-Quellcode ein CPAN-konformes Modul entsteht. Das hat den Vorteil, dass man es dann bequem per cpan-Kommando installieren kann. Wenn das Modul in einem passenden Namensraum liegt, dann kann es sogar auf CPAN veröffentlicht werden.
Der erste wichtige Schritt zur Distribution ist die Anpassung des Makefiles. Im Makefile.PL stehen verschiedene Angaben wie Abhängigkeiten und Infos zu Autor und minimaler Perl-Version. Das durch h2xs erstellte Makefile.PL sieht wie folgt aus:
use 5.016003;
use ExtUtils::MakeMaker;
# See lib/ExtUtils/MakeMaker.pm for details of how to influence
# the contents of the Makefile that is written.
WriteMakefile(
NAME => 'Tk::MyOptionScale',
VERSION_FROM => 'lib/Tk/MyOptionScale.pm', # finds $VERSION
PREREQ_PM => {}, # e.g., Module::Name => 1.1
($] >= 5.005 ? ## Add these new keywords supported since 5.005
(ABSTRACT_FROM => 'lib/Tk/MyOptionScale.pm', # retrieve abstract from module
AUTHOR => 'A. U. Thor <a.u.thor@a.galaxy.far.far.away>') : ()),
);Da das Modul von Tk::Scale abgeleitet wird, erfordern wir die Module Tk und Tk::Scale. Tk::Derived ist immer in Tk enthalten. Als Version der Module wird die Version angegeben, mit der entwickelt wurde - sofern vorherige Versionen nicht explizit getestet wurden. Die restlichen Informationen werden der Vollständigkeit halber angepasst. Eine Übersicht über die Informationen, die man der Distribution mitgeben kann, findet sich in der Dokumentation von ExtUtils::MakeMaker.
Das neue Makefile.PL könnte wie folgt aussehen:
use 5.016003;
use ExtUtils::MakeMaker;
# See lib/ExtUtils/MakeMaker.pm for details of how to influence
# the contents of the Makefile that is written.
WriteMakefile(
NAME => 'Tk::MyOptionScale',
VERSION_FROM => 'lib/Tk/MyOptionScale.pm', # finds $VERSION
PREREQ_PM => {
# e.g., Module::Name => 1.1
'Tk' => '804.03',
'Tk::Scale' => '4.004',
},
ABSTRACT_FROM => 'lib/Tk/MyOptionScale.pm', # retrieve abstract from module
AUTHOR => 'Author Name, E<lt>author@name.tldE<gt>',
MIN_PERL_VERSION => 5.016003,
LICENSE => 'perl',
);Auf die Feinarbeit an den Dateien README, MANIFEST, usw. wird an dieser Stelle nicht weiter eingegangen.
Die Changes-Datei wird noch kurz geprüft, ob alle interessanten Informationen enthalten sind und dann wird das Modul mittels folgender Befehle in eine Distribution umgewandelt:
D:
cd OptionDialog\Tk-MyOptionScale
perl Makefile.PL
dmake dist
Das Programm ist in diesem Beispiel dmake (und nicht make), weil es das make-Programm für Windows in der 64-Bit-Version nicht gibt.
Das Ergebnis ist ein Ordner der Tk-MyOptionScale-0.01 heißt. Wird dieser noch mit dem favorisierten Zip-Programm (z.B. 7-Zip) in eine .tar.gz-Datei umgewandelt, dann hat man ein vollwertiges Modul, das man verteilen kann und das jeder mit der Anleitung Wie installiere ich ein Modul? installieren kann: Tk-MyOptionScale-0.01.tar.gz
Zu beachten ist, dass hier das Testing gänzlich außen vor gelassen wurde. Sollte ein Modul verteilt werden, dann sollte es natürlich auch mit Tests geprüft werden. Ein interessantes eBook zu diesem Thema ist Test Automation using Perl.
