Take a look at 372499 for one way to do long running tasks whilst retaining UI responsiveness in tk.

Tk and threads are very hard to cooperate, they are mostly not compatible, as many sources say.

To write threaded Tk program, many many actions should be taken

Tk with threads are nothing to fear of. Yes, it's not trivial. But GUIs + threads are hardly a triviality in any language. And yet, it's being done, and many programs have GUIs and several threads, including in Perl/Tk.

For your second question, there may be better ways to do what you want without blocking, but you don't show us what foo() does. Generally, you use fileevent with a piped open, to fork-off a long process, then use the fileevent to read the filehandle, and test for when it's done, or collect return values. You can also get more sophisticated, and use IPC::Open3 to be able to write to, and read from the forked process.

Since you are on windows, you might want to look at IPC::Run, which is known to work on win32.

There are plenty of examples here on perlmonks in the archives, or on google. Just search for "Tk fileevent" or "Tk IPC::Open3"

You can also use threads, to spawn a worker thread to run some code, but it is tricky to use with Tk (but doable). I don't know how well threads work on windows.

Here is a simple example to show threads working with Tk, on Linux. There are 2 basic rules to remember when using threads with Tk.

1. Create the threads first, and put them to sleep, before creating the Tk gui.

2. A thread must reach the end of it's code block, for it to return properly, thus the need for the goto in the code. ( Also check out Tk-with-worker-threads ).

#!/usr/bin/perl
use strict;
use Tk;
use threads;
use threads::shared;

my $data_out:shared = 0;
my $data_in:shared = 0;
my $thread_die = 0;

my $wthr = threads->new( \&update_thread )->detach;
create_tk_window();

exit;

######################################################### 

sub update_thread {
    print "update_thread called...\n";
    while (1) {
          if($thread_die == 1){goto END}
          $data_in = 'thread-processing'.$data_out;
          sleep 1;
          }
END:
}
######################################################### 

sub create_tk_window {
  my $mw = MainWindow->new(
        -background => 'black',
        -foreground => 'yellow',
        -title      => "Thread Test"
    );
    $mw->geometry("802x618");
    $mw->minsize( 802, 618 );
    $mw->maxsize( 802, 618 );

  my $sent_recvd_listbox = $mw->Scrolled('Listbox',
        -height     => 10,
        -width      => 60,
        -background => 'black',
        -foreground => 'yellow'
    )->pack( -side => 'bottom', -anchor => 's', -pady => 2 );

  my $server_list_listbox = $mw->Scrolled(
        "Listbox",
        -height     => 10,
        -width      => 60,
        -background => 'white',
        -foreground => 'black',
        -scrollbars => 'se',
    )->pack();

  my $repeater;

  $mw->Button(-text=> 'Exit',
              -command => sub{
                $thread_die = 1;
                $repeater->cancel;
                $mw->withdraw;
                kill 9, $$;
            })->pack;

  $repeater = $mw->repeat(1000, sub{
    $data_out++;
    $server_list_listbox->insert( 'end', "Sent $data_out " );
    $server_list_listbox->see('end');

    $sent_recvd_listbox->insert( 'end', "Recived $data_in" );
    $sent_recvd_listbox->see('end');
    });
MainLoop;
}
[download]

So here's the state of the Full Monty, incl. the TK callback solution (as suggested by Randal L. Schwartz) --under the heading of "GUI (TK)".
The app is a further hack of the code in 443617, all for fun & no profit.
There's still a lot of polishing left, including a possible refactoring to allow a table driven config (reading Mark Dominus' HOP at the moment...:)

(Update apr.26: made a couple of regex'es more robust...)


#!/usr/bin/perl -w
# polls what's current playing on radio KOIT in San Francisco,
# get the lyrics from lyricsbox.com
# TODO: (1) make the title search a little fuzzier
#       (2) search more sites for lyrics
#       (3) nicer interface? color, scrolling?
# ====================================================================
# Pragmas & Libs
use strict;
use LWP::Simple;
use URI::Escape;
use Time::Local;
use HTML::Entities;

# Main vars
my @lyrics = (\&lyrics_matrix, \&lyrics_seeklyrics, \&lyrics_musicsong
+);
my $rlyrics = \@lyrics;
my @channels = (
    ["TEST", \&nowplay_TEST],           
    ["KOIT", \&nowplay_KOIT],
    ["HITZ", \&nowplay_HITZ]
    );
my $TRACE = 1;


# ===================================================================
#                       Text UI (STDOUT)
# ===================================================================
select((select(STDOUT), $| = 1)[0]);                # Autoflush STDOUT
my $sleep = 60;                                     # Poll once/min
=cut
#print play_station(\&nowplay_TEST, $rlyrics);
while (1) {
    print play_station(\&nowplay_KOIT, $rlyrics);
    print play_station(\&nowplay_HITZ, $rlyrics);
    sleep $sleep;                                   # Wait & retry 
}
=cut

# ===================================================================
#                       GUI (TK)
# ===================================================================
use Tk;
my $mw = MainWindow->new();
    $mw->minsize(qw(100  20));                                        
    $mw->maxsize(qw(600 700));

my $list; $list= $mw->Scrolled("Listbox", -height=>5, -scrollbars=>"e"
+)
    ->pack(qw/-fill x/);
    $list->bind("<1>",  sub { do_lyrics($list->curselection()) });
    $list->bind("<3>",  sub { $rlyrics = ($rlyrics ? undef() : \@lyric
+s);
                        do_lyrics($list->curselection())} );
    for (@channels) { $list->insert("end", $_->[0]); }

my $detail; 
sub detail_add {
    $detail = $mw->Scrolled("Text", -height=>20, -width => 40,
    -scrollbars=>"se", -wrap=>'none')->pack(qw/-fill both -expand 1/);
}
# -------------------------------------------------------------------
    MainLoop;

sub do_lyrics {
    my $idx = shift;
    $detail->destroy if Tk::Exists($detail); detail_add();
    reset_station($idx); lyrics($idx);
    $detail->repeat(60000, sub { lyrics($idx); } );
}
sub lyrics {
    my $lyrics = play_station($channels[$_[0]]->[1], $rlyrics);
    $detail->insert("end", $lyrics); $detail->see("end");
}


# ===================================================================
#                       Play station
# ===================================================================
my %current;            # Map Statiom -> current $artist$title ("class
+ data")
sub play_station {
    my ($station, $rlyrics) = @_;
    my ($artist, $title, $tdif) = $station->(); # Now playing on $stat
+ion..
    unless ($artist and $title) { return "*"; }
    my $ret;
    if (!defined($current{$station}) or $current{$station} ne "$artist
+$title") {
        $ret = build_header($artist, $title, $tdif);
        $current{$station} = "$artist$title";
        for (@$rlyrics) {                       # Probe @lyrics sites 
+for texts
            if ( my $ly = $_->($artist,$title) )
            { $ret .= "$ly\n"; last unless ($TRACE or $ly =~ /Not Foun
+d/i); }
        }
    } else { $ret = "." }
    return $ret;
}
sub reset_station {
    delete($current{$channels[shift]->[1]});
}
    
# -------------------------------------------------------------------
sub build_header {
    my ($artist, $title, $tdif) = @_;
    my $hdr = "\n" . "-"x50 . "\n";
    my $LOC=time(); $tdif ||= 0;
    my $STA=$LOC+($tdif*60*60);
    $hdr .= "LocalTm: " .  scalar(localtime($LOC)) . "\n";
    $tdif and $hdr .= "Station: " . scalar(localtime($STA)) . "\n\n";
    $hdr .= "[$artist]: [$title]\n\n";
    return $hdr;
}

# ===================================================================
#                       Stations
# ===================================================================
sub nowplay_TEST {
    my @case = (
        ["Bryan Adams", "(everything I Do) I Do It For You"],
        ["Backstreet Boys", "I'll Never Break Your Heart"],
        ["Roxette", "It Must Have Been Love"],
    );
    my ($artist, $title) = ($case[0][0], $case[0][1]);
    for (\$artist, \$title) { clean_at($_); }
    return ($artist, $title);

}
# -------------------------------------------------------------------
sub nowplay_KOIT {
    my $url = "http://koit.com/nowplay_data.cfm";
    my $tdif = -9;   # cf Copenhagen
    my $data = get($url);
    my ($artist, $title) = $data =~ m|box=(.+) - (.+)&|;
    for (\$artist, \$title) { clean_at($_); }
    return ($artist,$title,$tdif);
}
# -------------------------------------------------------------------
sub nowplay_HITZ {
    my $url = "http://hitzradio.com/";
    my $data = get($url);
    my ($artist, $title) = $data =~ m|<span id="nowplaying">(.+) - (.+
+)</span>|;
    for (\$artist, \$title) { clean_at($_); }
    #??for ($artist,$title) {  s/\(.*?\)+//g; s/\(.*//g; }
    return ($artist,$title);
}

# ===================================================================
#                       Lyrics
# ===================================================================
sub lyrics_lyricsbox {  # Pt Broken...
    my ($artist, $title) = @_;
    my $lyricsbox   = "http://www.lyricsbox.com";
    my $lyrics_list = "$lyricsbox/cgi-exe/am.cgi?a=search&p=1&l=artist
+&s=";
    my $list = get($lyrics_list.uri_escape($artist));
    my ($song, $ly);
    my ($url) =  $list =~ m|<A href="([^"]+)">\Q$title\E.*?</A></td>|i
+;
    if ($url)  { $song = get($lyricsbox.$url); }
    if ($song) { ($ly) = $song =~ m|<PRE.*?>(.+)</PRE>|si; }
    return "LyricsBox: " . ($ly ? $ly : "Not Found...");
}
# -------------------------------------------------------------------
sub lyrics_matrix {
    my ($artist, $title) = @_;
    for ($title) { s/\s/_/g; s/\'//g; }
    my $t = lc(substr($title,0,1));
    my ($url, $ly) = ("http://www.ntl.matrix.com.br", "");
    foreach my $try ("html/lyrics/$t", "oldies_list/top/lyrics") {
        $url .= lc("/pfilho/$try/${title}.txt");
        $TRACE and print "[$url]\n";
        $ly = get($url); last if $ly;
    }
    if ($ly) { $ly = clean_ly($ly); }
    return "Matrix: " . ($ly ? $ly : "Not Found...");
}
# -------------------------------------------------------------------
sub lyrics_musicsong {
    my ($artist, $title) = @_;
    my $a = ($artist =~ /^\d+/ ? "0" : uc(substr($artist,0,1)));
    for ($artist,$title) { s/\s//g; s/ & //g; s/(.*)/\L$1/g; }
    my ($url, $song, $ly) = ("http://www.musicsonglyrics.com", "", "")
+;
    $url .= "/$a/${artist}lyrics/$artist${title}lyrics.htm";
    $TRACE and print "[$url]\n";
    $song = get($url);
       eval { if ($song) {
        ($ly) = $song =~ m|<span.*?>(.+)</span>|si; }
    };  $@ and warn $ly = "Parse error: $@ \n";
    if ($ly) { $ly = clean_ly($ly); }
    return "MusicSong: " . ($ly ? $ly : "Not Found...");
}
# -------------------------------------------------------------------
sub lyrics_seeklyrics {
    my ($artist, $title) = @_;
    for ($artist,$title) { s/^\s+//; s/\s+$//; }
    my ($a, $t) = ($artist, $title);
    for ($artist,$title) { s/(['\w]+)/\u\L$1/g; s/('|\s)+/-/g; }
    my ($url, $song, $ly) = ("http://www.seeklyrics.com", "", "");
    for my $try ($artist, uc($artist)) {
        $url .= "/lyrics/$artist/$title.html";
        $song = get($url);
        $TRACE and print "[$url]\n"; last if $song;
    }
    eval { if ($song) {
        ($ly) = $song =~ m|<b>$a - $t Lyrics</b>\s*<pre>(.*?)</pre|si;
+ }
    };  $@ and warn $ly = "Parse error: $@ \n";
    if ($ly) { $ly = clean_ly($ly); }
    return "SeekLyrics: " . ($ly ? $ly : "Not Found...");
}
# -------------------------------------------------------------------
sub lyrics_007 {
#   <To-Be-Done>
    my $lyrics007 = "http://www.lyrics007.com";
#   http://www.lyrics007.com/<artist>%20Lyrics/<title>%20Lyrics.html
#   where <artist> & <title> spaces & specs are %20 encoded
}
# -------------------------------------------------------------------
#   <To-Be-Done>
#   http://www.lyricsspot.com/
# -------------------------------------------------------------------


# ===================================================================
#                       Utils
# ===================================================================
sub clean_at {
    my $rat = shift;
    for ($$rat) { s/^\W+//g; s/[()]//g; s/\W+$//g; }
}
# -------------------------------------------------------------------
sub clean_ly{
    my $ly = shift;
    for ($ly) {
        s/<.*?>//gi; decode_entities($_);       # HTML tags & char enc
+oding
        s/^\s+//; s/\s+$//;                     # Strip WS
        s/(\x0D)*\n/\n\t/g; s/\x92/\x27/g;      # Handle NL & '
        tr/\200-\377/*/s;                       # Zap 8bit chars
    }
     return $ly;
}

# END
[download]

  while (1) {
    DoOneEvent(DONT_WAIT);
    # do your own (short) action
    select undef,undef,undef,0.0001;
  }
[download]

It's not perfect, but if your code can be broken up like this, it's pretty easy to implement.

It's a complex program that involves more than *just* Tk + threads. The threads part gave me least problems - it works very nicely.