I'm writing a perl tk wrapper for a text manipulation script that I've written, which I would ultimately like to make into a binary to run on different platforms.

It's pretty much finished, with one minor (major?) catch.

The text manipulation subroutine itself typically takes about 15 minutes to run. I'm trying to add a button widget that would allow the user to abort the subroutine and return to the MainLoop, without exiting the application.

I'm aware that the 15 minute subroutine blocks the MainLoop, which is ok, in the sense that I've disabled all the widgets (and don't want to allow further user input) while the script is running (apart from an 'abort' option). During the 15 minute script, I do update the main window at intervals which does allow button press callbacks through.

As a minimal example:

#!/usr/bin/perl 
use Tk;
use strict;
use warnings;

my $mw = MainWindow -> new;

my $frameSetUp = $mw -> Frame() 
        -> pack(
            -side => 'top',
            -fill => "both",
            -expand => 1);

my $startLoopButton = $frameSetUp -> Button(
            -text => 'Start', 
            -command => \&startLoop
            )
                -> pack(
                    -side => 'left',
                    -ipadx => 10,
                    -fill => "both",
                    -expand => 0);

my $endLoopButton = $frameSetUp -> Button(
            -text => 'Abort', 
            -command => \&interruptLoop
            )
                -> pack(
                    -side => 'left',
                    -ipadx => 10,
                    -fill => "both",
                    -expand => 0);

my $quitProgramButton = $frameSetUp -> Button(
            -text => 'Quit', 
            -command => \&quitProgram
            )
                -> pack(
                    -side => 'left',
                    -ipadx => 10,
                    -fill => "both",
                    -expand => 0);
        
MainLoop;

sub startLoop
    {
        while (1)
            {
                sleep (2);
                print STDERR "startLoop: still sleeping\n";
                $mw -> update();
            }
    }

sub interruptLoop
    {
        #something to interrupt startLoop and return to MainLoop?
        print STDERR "I've been pressed\n";
        die "but startLoop keeps running...\n\n";
    }

sub quitProgram
    {
        exit;
    }

sub Tk::Error
    {
         my ($widget,$error,@locations) = @_;
        print STDERR "ERROR: $error\n";
    }
[download]

After pressing start, pressing Quit exits the application, and I would like pressing Abort to result in ending the startLoop, and returning to MainLoop.