This is tested this on Win32(2K and XP) on AS 5.8
FileEvent doesn't work on Win32 Tk and threads won't work with Tk. My problem was that I had several long running SQL queries which blocked Tk's updates and the user couldn't do anything else while the queries were still executing. Worse even still, if the user moved something over the main window, it would erase the window (LOL).
After a LOT of experimentation, I found the following solution. I have commented out the database stuff and put in a mock filler for the hash table which displays the message you sent to the child from the text box. (Some SQL in my case.)
When you press run, some text gets sent to the child which then imitates doing a long bit of work ( sleeps for 10 seconds, adding a value to a hash as it goes) about the only thing exciting (well for me when I got it to work) is that you can move the window around and do other things while the child does it stuff and while we keep looking for a return message that our job is complete. When the job finishes, the child sends a status message back to the parent "OK" or the actual error message. I used the Storable module to save and retrieve the hash. You can dream up your own stuff.
You should note, that in Tk you have to spawn the child before the main loop, and that I have to manually reap the child by catching a DESTROY.
Cheers,
JamesNC
use IO::Handle;
use IO::Select;
use Tk;
use Tk::Button;
use Storable;
use DBI;
# Author: James Moosmann , 2004
# Info: Non-block Tk Child
#Set up 2 way communication with child
pipe PREAD, CWRITE;
pipe CREAD, PWRITE;
my %hash;
my $href =\ %hash;
my $sql_statement = "SELECT * FROM Customers";
$|=1;
my $ID;
my $tmpdir = $ENV{TEMP};
$tmpdir =~s/\\/\//ig;
my $tempfile = $tmpdir."/hash.dat";
my $mw = tkinit;
my $var = "Status: ";
my $l = $mw->Label(-text, "Message: ", -textvariable, \$var)->pack(-si
+de, 'top');
my $txt = $mw->Text(-height, 2, -width, 40)->pack(-expand, 1, -fill, '
+both', -pady, 4, -padx, 4);
$txt->insert('end', $sql_statement);
my $b = $mw->Button(-text, "Run", -width, 10, -command, sub { &send_ms
+g($txt->get('0.1','end')); })->pack();
#$mask = 0;
#vec($mask, fileno(STDIN), 1);
#vec($mask, fileno(PREAD), 1);
#my ($read, $write) = ($mask, $mask);
my $pid = fork();
if($pid==0){
# $pid == 0 for the child... this will act as our AGENT for proces
+sing long running DBI calls
# We have to create the child before we enter the MainLoop in Tk o
+r Tk goes bonkers...
# DO NOT attempt to create any widgets from here... and do not att
+empt to land on Europa
# Perhaps we could eval an output of the child to create widgets ?
close CWRITE;
close CREAD;
#my $dbh = DBI->connect('dbi:ODBC:data');
while(1){
#select(undef,undef,undef, 0.05); #dead end
# This seems to work fine... it doesn't block and tells me if data
+ is there
# when $r == NO Bytes to read
# when $r > 0 we have a sql statment to read and process
my ($r) =(stat(PREAD))[7]; #<<<--- No Block :0) tells me if I ha
+ve data... I just poll for it
if($r > 0){
while(<PREAD>){
my $t = time;
my $msg = $_;
my $sth;
# $sth = $dbh->prepare($_);
# my $err = $dbh->errstr;
#unless( $err){
#$sth->execute();
#while(my $hr = $sth->fetchrow_hashref){
# foreach(keys %$hr){
# $hash{$_} = $$hr{$_};
# }
#}
#}
for(1..10){
sleep 1;
$hash{$_} = $msg. ": ".$_;
}
print "Finished in ", (time-$t), "secs \n";
#Data is not shared between parent and child
#so we will use storable module to do this for use :)
#maybe slow, but at least we can use complex structures
store \%hash, $tempfile;
if($err=~/\w/){ $msg = "Error:".$err; }else{ $msg = "OK"; }
syswrite PWRITE, "$msg\n";
last;
}
}
}
# This will likely become a zombie...
# bind to a destroy to reap this puppy
}
close PREAD;
close PWRITE;
$mw->bind('<Any-Destroy>', sub{ &_cleanup;});
MainLoop;
sub send_msg {
my $sql = $_[0];
$sql =~s/\n/\r/g;
syswrite CWRITE, $sql."\n";
$ID = $mw->repeat(100, \&datacheck);
}
sub datacheck{
#Do we have anything to get?
my ($r) =( stat(CREAD))[7]; # <<<---- Doesn't block :o)
$var = "Status: ";
my $var1;
if ($r > 0){ $ID->cancel; while(<CREAD>){
chomp; $var1 .= $_;
%hash = %{retrieve($tempfile)};
$var1 =~s/Error:.*]\s+The/The/ig;
$var1 =~s/\(.*\)//ig;
if($r>0){ my (@list) = split /\./, $var1; $var .= "$_.\n" foreach
+@list; $var=~s/\n\.\n+$//g;}
print "$_ => $hash{$_}\n" for keys %hash;
last; } }
}
sub _cleanup {
kill 9, $pid;
unlink $tempfile;
}
__END__
Now, gimme those xp's ;-) (wink, wink)