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__

[download]

Now, gimme those xp's ;-) (wink, wink)

In reply to Re: capture output of a daemon in a tk widget on win32 by JamesNC
in thread capture output of a daemon in a tk widget on win32 by xiper

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.