Beefy Boxes and Bandwidth Generously Provided by pair Networks
Just another Perl shrine
 
PerlMonks  

Re: capture output of a daemon in a tk widget on win32

by JamesNC (Chaplain)
on Mar 24, 2004 at 17:40 UTC ( [id://339487]=note: print w/replies, xml ) Need Help??


in reply to capture output of a daemon in a tk widget on win32

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)

Replies are listed 'Best First'.
Re: Re: capture output of a daemon in a tk widget on win32
by eserte (Deacon) on Mar 24, 2004 at 18:17 UTC
    It is absolutely legal to fork after MainLoop was fired. You only must not use exit(), but rather CORE::exit() or (unfortunately needed in Tk804.026) POSIX::_exit() to quit the child process.

    At least I hope that this is true for Windows...

      Why would I make this up? Forking after MainLoop on Win32 doesn't work. The latest version of Tk on Win that is not beta is 800.024, I have tried beta 10 (804.XX) and it dies there too on Win32(2K and XP)... and that is why I said that. Believe me I have tried. Win32 doesn't really fork. It creates a thread I am told. Hence it's odd behavior ( FRUSTRATING BEHAVIOR ) in some modules. I didn't just make it up, and that is why the gent asked the question because it (and fileEvent and lots of other Tk behaviors should work but don't. I would not try to tell stuff works on platforms I cannot test on.
      JamesNC
        I agree with JamesNC on this one, while it should be possible to fork after MainLoop and use CORE::exit, in reality it doesn't work reliably (or at all in most cases). Ditto for many other things on win32, especially related to IPC, blocking, filehandles, shared memory, etc... This question (along with my last 50 or so...) relates to a project that i started a couple of months ago, developing a medium sized Tk app involving about 6-7 different processes client-side and a handful of networking. Needless to say, i've run into many bugs along the way, and agree it's frustrating when things dont behave as documented or expected.

        Back to the question.

        In response to your program, it doesn't really address my problem. You're simply forking another process, using pipes to communicate, and polling each end while you wait for something to do. Keeps MainLoop running while you do stuff, sure, (been there, achieved that) but my question was more than that. So, no bucket just yet! :)

        I've just simplified it by removing the requirement of stderr for the time being. This leaves two remaining issues: non-blocking read, and MainLoop. Solve the first, and the second shouldn't be an issue!

        My output is now (varies):

        read_stdout() sysread() got 9 bytes: [stdout1 ] read_stdout() sysread() got 9 bytes: [stdout2 ]
        <pause for 10 seconds>
        read_stdout() sysread() got 9 bytes: [stdout3 ] read_stdout() sysread() got 9 bytes: [stdout4 ] read_stdout() sysread() got 0 bytes: []

        - ><iper

        use japh; print;

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://339487]
help
Chatterbox?
and the web crawler heard nothing...

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

    No recent polls found