DarrenM-
I've struggled with this same problem myself, and I offer the solution that I've come up with. It may not be a very popular one, but it suits my needs, and I've come to like it.
If you're familiar with Object-Oriented Patterns, you may recognize this as the Publisher-Subscriber pattern. In the olden days, we referred to this as a vector-table in writing C code.
The basic problem occurs when you want this bit of code way over here, to know about something from that bit of code way over there, and the logistics of setting up subroutine calls is too messy. Simply put, a publisher-subscriber (PS) setup allows a piece of code to say Anytime someone announces that THIS happens (the publisher), please run THAT bit of code for me (the subscriber). I use this in my big PerlTK GUIs when I have a number of windows that all need to highlight something upon a mouseclick in a single window.
The implementation of this is very simple, but it does make following the code a bit more difficult for new folks (or for yourself if your memory is as bad as mine). Here was my first implementation of PS as a module:
package itemDispatch;
use strict;
use warnings;
# The index to the dispatch hash is an item name, the contents is
# a list of the callbacks that have been subscribed...
my %DISPATCH; # Dispatch hash
####################################################################
# Subroutine: Subscribe (external)
# This routine subscribes a callback function to a dispatch item
# Arguments:
# $_[0] - Item Name
# $_[1] - Callback function
####################################################################
sub Subscribe
{
my $item = shift || die "missing dispatch item";
my $callback = shift || die "Missing callback function";
push(@{$DISPATCH{$item}}, $callback);
}
####################################################################
# Subroutine: Activate (external)
# This routine activates a dispatch item
# Arguments:
# $_[0] - Item Name
# $_[1]..$[-1] - Callback args
####################################################################
sub Activate
{
# Get arguments...
my $item = shift || die "Missing dispatch item";
my @args = @_; # Callback arguments
my $coderef;
foreach $coderef (@{$DISPATCH{$item}}) {
&$coderef(@args);
}
}
1;
If you combine that module, with a module that does some work, like this example module:
package doWork;
use strict;
use Tk;
use itemDispatch;
my $PROGRESS = 0;
sub StartWork {
my $increment = shift || die "Missing Increment";
my $c=0;
while ($c<99) {
sleep 1;
itemDispatch::Activate('PROGRESS', $increment);
$c += $increment;
}
}
1;
Then an example perl script using these two modules would look like this:
use strict;
use Tk;
use Tk::StatusBar;
use itemDispatch;
use doWork;
# Subscribe to PROGRESS events...
itemDispatch::Subscribe('PROGRESS', \&_updateProgress);
my $PROGRESS = 0;
my $INCREMENT = 5;
my $mw = MainWindow->new();
$mw->Button( -text => 'Start', -command =>
# Publish a START event...
sub{ doWork::StartWork($INCREMENT)})->pack();
my $sb = $mw->StatusBar();
$sb->addProgressBar(
-length => 60,
-from => 0,
-to => 99,
-variable => \$PROGRESS,
);
MainLoop();
sub _updateProgress {
my $progress = shift || die "Missing Progress\n";
print STDERR "Updating progress by $progress\n";
$PROGRESS += $progress;
$mw->update;
}
Hope that helps!
-Craig | 