Here's a useful class to create a flexible progress bar dialog. Features include:
Arbitrary number of progress bars.
Space for debug messages to be outputted, with colour and everything!
Nice OO interface.
Uses pipes to communicate, so you can run the MainLoop in one process and update the widgets in another process.
TODO:
Scroll the text widget down when it gets filled.
Not exiting correctly?
Sample usage:
END
{
$widget->quit;
}
# create two bars - 'execution report' and 'some other report'
my $widget = new ProgressWidget("Execution Report", "Some Other Report
+");
my $pid;
if ($pid = fork)
{
# run the Tk Mainloop off by itself
$widget->run();
waitpid($pid, 0);
}
else
{
# actually do the work. increment each progress bar
# the bars scale from 0% to 100%, so scale your
# range down between these two values.
# (progress/totalProgress*100)
for (my $i=0; $i<100; $i++)
{
$widget->incrementBar(0, $i);
}
sleep 5;
for (my $i=0; $i<100; $i++)
{
$widget->incrementBar(1, $i);
}
# put a green 'info' message into the dialog.
$widget->insertText('info', 'green', "Complete");
}
package progressWidget;
use warnings;
use strict;
use Tk;
use Fcntl;
use Tk::ProgressBar;
sub new
{
my $classname = shift;
my $self = {};
# create the pipe
pipe(FROM, TO) or die "pipe $!";
fcntl(FROM, F_SETFL, O_NONBLOCK) or die "can't fcntl $!\n";
fcntl(TO, F_SETFL, O_NONBLOCK) or die "can't fcntl $!\n";
$self->{fromFh} = \*FROM;
$self->{toFh} = \*TO;
$self->{mainTk} = new MainWindow(-title => 'Generating report ...'
+);
# $self->{mainTk} = new MainWindow;
my $maxsize = 0;
for (my $i=0; $i<@_; $i++)
{
if (length($_[$i]) > $maxsize)
{
$maxsize = length($_[$i]);
}
}
for (my $i=0; $i<@_; $i++)
{
my $frame = $self->{mainTk}->Frame;
$frame->Label(-text => $_[$i],
-width => $maxsize
)->pack(-side => 'left', -expand => 1);
$self->{bars}[$i] = $frame->ProgressBar(
-borderwidth => 2,
-relief => 'sunken',
-width => 20,
-length => 200,
-anchor => 'w',
-blocks => 50,
-from => 0,
-to => 100
)->pack(-expand => 1);
$frame->pack;
}
my $frame = $self->{mainTk}->Frame;
require Tk::ROText;
$self->{output} = $frame->Scrolled('ROText');
$self->{output}->pack(-side => 'left', -expand => 1, -fill =>'both
+');
$frame->pack(-fill => 'both', -expand => 1);
$self->{mainTk}->after(50, \&guiUpdateLoop, $self);
return bless($self, $classname);
}
sub incrementBar
{
my $self = shift;
my $barnum = shift;
my $barvalue = shift;
my $fh = $self->{toFh};
select($fh); $|=1;
print $fh "$barnum:$barvalue\n";
select(STDOUT);
}
sub insertText
{
my $self = shift;
my $title = shift;
my $colour = shift;
my $message = shift;
my $fh = $self->{toFh};
select($fh); $|=1;
print $fh "log:$title:$colour:$message\n";
select(STDOUT);
}
sub quit
{
my $self = shift;
my $fh = $self->{toFh};
select($fh); $|=1;
print $fh "exit\n";
select(STDOUT);
}
sub run
{
my $self = shift;
MainLoop;
}
sub guiUpdateLoop
{
my $self = $_[0];
my $fh = $self->{fromFh};
while (my $stuff = <$fh>)
{
if ($stuff =~ /exit/)
{
# exit;
}
elsif ($stuff =~ /^log:/)
{
my ($log, $title, $colour, $text) = split(/:/, $stuff, 4);
# find the end.
my $tag = 'foo' . ++$self->{tag};
$self->{output}->insert('end', $title . ": ", $tag);
$self->{output}->tagConfigure($tag, 'foreground', $colour)
+;
$self->{output}->insert('end', $text);
}
else
{
my @break = split(/:/, $stuff);
my $bar = $self->{bars}[$break[0]];
$bar->value($break[1]);
}
$self->{mainTk}->update;
}
$self->{mainTk}->after(5, \&guiUpdateLoop, $self);
}
1;