Book HomeMastering Perl/TkSearch this book

15.6. Nonblocking Wait Activities

Perl/Tk provides three commands that wait for particular events to occur. Although the wait is nonblocking (Tk events continue to be processed), program flow is logically suspended at the wait point only until the appropriate event occurs. The commands are:

$widget->waitVariable(varRef)
Waits until the variable referenced by varRef changes (i.e., it is written or undef).

$widget->waitVisibility
Waits until $widget's visibility state changes. The most common use for this command is to wait for a window to appear on the display. (Event type = Visibility.)

$widget->waitWindow
Waits until $widget is destroyed. (Event type = Destroy.)

waitVariable can be employed in a number of ingenious situations. In Chapter 23, "Plethora of pTk Potpourri", we use it as a means of effecting interprocess communications. But perhaps the most common is waiting for a user response to, say, a Dialog widget. A Dialog posts a message and one or more Buttons, then waits for the user to make a selection by clicking a Button. The specified Button label text is then stored in the variable that waitVariable is watching, and logical program flow continues.

15.6.1. Tk::waitVariableX

Although waitVariable is nonblocking in the sense that Tk events continue to be processed, the program flow at the wait point is blocked until the variable changes. If the variable never changes, then that thread of execution can never continue. So, we can imagine a waitVariable with a timeout such that, after a certain amount of time, program flow resumes even if the variable never changes. We can go a step further and wait for a list of variables with a timeout. It's actually very easy to implement these features, using the existing waitVariable command and Tie::Watch.

We'll call this new command waitVariableX. The scheme is sublimely simple and clever. Our new command employs waitVariable to wait for a single scalar to change value. That scalar is set either by a timer callback or a Store callback invoked by watchpoints placed on the list of variables. Furthermore, waitVariableX tells us why it completed, by returning zero if the timer expired or a reference to the variable that changed.

Here is a typical calling sequence, where we wait for $splash_var to change value, or 3000 milliseconds, whichever occurs first. If the timeout is zero, no timer callback is queued.

$mw->waitVariableX(3 * 1000, \$splash_var);

In typical Perl/Tk style, we've decided that the first argument passed to waitVariableX can also be an array reference. In this case, the first element is the millisecond timeout value (or zero) and the second, a standard Perl/Tk callback that is invoked just before waitVariableX returns:

$self->waitVariableX( [$millis, $destroy_splashscreen] );

Here's the code for waitVariableX:

$Tk::waitVariableX::VERSION = '1.0';

package Tk::waitVariableX;

use Carp;
use Exporter;

use base qw/Exporter/;
@EXPORT = qw/waitVariableX/;
use strict;

sub waitVariableX {

    use Tie::Watch;

    my ($parent, $millis) = (shift, shift); # @_ has list of var refs

    croak "waitVariableX:  no milliseconds." unless defined $millis;
    my ($callback, $st, $tid, @watch, $why);

    if (ref $millis eq 'ARRAY') {
        $callback = Tk::Callback->new($millis->[1]);
        $millis = $millis->[0];
    }

    $st = sub {my $argv = $_[0]->Args('-store'); $why = $argv->[0]};
    foreach my $vref (@_) {
        push @watch,
            Tie::Watch->new(-variable => $vref, -store => [$st, $vref]);
    }
    $tid = $parent->after($millis => sub {$why = 0}) unless $millis == 0;

    $parent->waitVariable(\$why); # wait for timer or watchpoint(s)

    $_->Unwatch foreach @watch;
    $parent->afterCancel($tid);
    $callback->Call($why) if defined $callback;

    return $why;						# why we stopped waiting: 0 or $vref

} # end waitVariableX

1;

Once again, we have an Exporter module, not a mega-widget class module. We first save the parent widget reference and the milliseconds arguments, leaving the list of variables in @_. If the milliseconds argument is really an array reference, we create a Tk::Callback object and reset $millis.

Now we create the Store callback used by the list of variable watchpoints. If and when invoked, the callback calls the Tie::Watch method Args to fetch a reference to the list of Store arguments we supply to the Tie::Watch constructor, new. The first argument in the argument vector $argv is a reference to the watched variable, which is then stored in the lexical $why.

The foreach loop creates the actual watchpoint objects, using our callbacks $st and $vref, which, because we have a closure, uniquely point to each watched variable in turn. If and when the $st callback is invoked, it uses Args to fetch the closed $vref. Each variable's Store callback then stores $vref in the same lexical variable, $why.

If a millisecond timeout was specified, we use after to queue a timer event that sets $why to zero, assuming the timer ever expires. This is the same lexical variable set by the Store callbacks.

Finally, with everything in place, we wait for $why to change. When it does, we destroy all the watchpoint objects, cancel any outstanding timer event, execute the optional completion callback (passing it $why for completeness), and return $why; why waitVariableX is returned.

Note that:



Library Navigation Links

Copyright © 2002 O'Reilly & Associates. All rights reserved.