Beefy Boxes and Bandwidth Generously Provided by pair Networks
good chemistry is complicated,
and a little bit messy -LW
 
PerlMonks  

comment on

( [id://3333]=superdoc: print w/replies, xml ) Need Help??
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)

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":



  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or How to display code and escape characters are good places to start.
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others imbibing at the Monastery: (3)
As of 2024-03-29 06:34 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found