#!/usr/bin/perl
use strict;
use warnings;
=pod
=head AUFGABE
Erstellen Sie mithilfe des Moduls "Tk" ein PERL-Skript mit grafischer
Oberfläche, welches die Möglichkeit bietet, eine Ausgangsdatei im
Textformat (.txt) zu spezifizieren. Der User muss außerdem den Namen
einer Ausgabedatei selbst festlegen können. Durch das Anklicken eines
Buttons soll das Skript die bestehnde Datei einlesen und jeweils an
der ersten Stelle einer Zeile eine fortlaufende Zeilennummerierung
einfügen. Außerdem müssen die festgelegte Ausgabedatei generiert und
der Ergebnistext in die Datei ausgegeben werden, wobei über die
grafische Oberfläche (Listbox) die erfolgreiche Ausführung angezeigt
werden soll.
=cut
use Tk;
use Tk::LabFrame;
use Tk::ErrorDialog;
#
# MainWindow
#
my $mw = new MainWindow;
$mw->title("Komische Aufgabe von Satanica");
#
# Eingabedatei auswaehlen:
#
my $f1 = $mw->LabFrame(-label => 'Eingabedatei',
-labelside => 'acrosstop',
)
->pack(-side => 'top',
-expand => 1,
-fill => 'x',
);
my $ein_entry = $f1->Entry(-width => 50,
)
->pack(-side => 'left',
-expand => 1,
-fill => 'x',
);
my $ein_btn = $f1->Button(-text => 'Durchsuchen',
-command =>
sub {
my $typen = [
['Textdateien', '.txt' ],
['Alle Dateien', '*' ],
];
my $dn = $mw->getOpenFile(-filetypes => $typen,
);
if (defined $dn and $dn ne '') {
$ein_entry->delete(0, 'end');
$ein_entry->insert('end', $dn);
}
},
)
->pack(-side => 'left',
-expand => 0,
-fill => 'none',
);
#
# Ausgabedatei auswaehlen:
#
my $f2 = $mw->LabFrame(-label => 'Ausgabedatei',
-labelside => 'acrosstop',
)
->pack(-side => 'top',
-expand => 1,
-fill => 'x',
);
my $aus_entry = $f2->Entry(-width => 50,
)
->pack(-side => 'left',
-expand => 1,
-fill => 'x',
);
my $aus_btn = $f2->Button(-text => 'Durchsuchen',
-command =>
sub {
my $typen = [
['Textdateien', '.txt' ],
['Alle Dateien', '*' ],
];
my $dn = $mw->getSaveFile(-filetypes => $typen,
-defaultextension => 'txt',
);
if (defined $dn and $dn ne '') {
$aus_entry->delete(0, 'end');
$aus_entry->insert('end', $dn);
}
},
)
->pack(-side => 'left',
-expand => 0,
-fill => 'none',
);
#
# DoIt-Button:
#
my $doit_btn = $mw->Button(-text => 'do it',
-command => sub {do_it( $ein_entry->get(), $aus_entry->get())},
)
->pack(-side => 'top',
-expand => 1,
-fill => 'x',
);
#
# Beweisausgabe:
#
my $anzeige = $mw->Scrolled("Text",
-scrollbars => 'osoe',
-background => '#d7d7d7',
-foreground => 'blue',
-width => 80,
-height => 25,
-relief => 'flat',
-font => '{Courier New} 10 {normal}',
-wrap => 'none',
)
->pack(-side => 'top',
-expand => 1,
-fill => 'both',
);
#
# Exit-Button:
#
my $exit_btn = $mw->Button(-text => 'Ende',
-command => sub { $mw->destroy() },
)
->pack(-side => 'top',
-expand => 1,
-fill => 'x',
);
#
# Bindungen:
#
$mw->bind ('<Return>', sub{$doit_btn->invoke()});
$mw->bind ('<Escape>', sub{$exit_btn->invoke()});
MainLoop();
sub do_it {
my ($ein, $aus) = @_;
die "Fehlende Parameter in do_it"
unless defined $ein
and defined $aus;
die "Eingabedatei '$ein' nicht vorhanden in do_it"
unless -f $ein;
open (IN, $ein ) or die "Kann '$ein' nicht zum Lesen oeffen: $!";
open (OUT, ">$aus") or die "Kann '$aus' nicht zum Schreiben oeffen: $!";
while (<IN>) {
print OUT $. . ':' . $_;
}
close OUT or die "Kann '$aus' nicht schliessen: $!";
close IN or warn "Kann '$ein' nicht schliessen: $!";
open (IN, $aus ) or die "Kann '$aus' nicht zum Lesen oeffen: $!";
while (<IN>) {
$anzeige->insert('end', $_);
}
close IN or warn "Kann '$aus' nicht schliessen: $!";
}