http://qs321.pair.com?node_id=1064931


in reply to ActivePerl Gtk2::Helper Hangs

Hi bulk88,
Thanks for helping me out, below is the final code I made that seems to be working fine.
#!/usr/bin/perl -w use strict; use Gtk2 '-init'; use Gtk2::Helper; use Data::Dumper; use FileHandle; use IPC::Open2; use Win32API::File; use Win32; use Win32::API; { my $api; die "PeekNamedPipe" if ! ($api= Win32::API->Import("kernel32", " BOOL PeekNamedPipe( HANDLE hNamedPipe, LPVOID lpBuffer, DWORD nBufferSize, LPDWORD lpBytesRead, LPDWORD lpTotalBytesAvail, LPDWORD lpBytesLeftThisMessage );")); } my $wfh = FileHandle->new(); my $rfh = FileHandle->new(); open2($rfh,$wfh,"C:\\Windows\\System32\\cmd.exe"); my $hnd = Win32API::File::FdGetOsFHandle($rfh->fileno()); #get Win32 k +ernel handle from Perl land if($hnd == Win32API::File::INVALID_HANDLE_VALUE()) { die "bad hnd"; } my $tag = Gtk2::Helper->add_watch($rfh, 'in',\&preview_call); my $window = Gtk2::Window->new(); $window->signal_connect("destroy",sub{Gtk2->main_quit();}); $window->set_size_request(300,300); my $hbox = Gtk2::HBox->new(); $window->add($hbox); my $button = Gtk2::Button->new("A"); $button->signal_connect('clicked'=>sub{ add_job(); }); $hbox->pack_start($button,1,1,0); $button = Gtk2::Button->new("B"); $button->signal_connect('clicked'=>sub{ print "i do nothing\n"; }); $hbox->pack_start($button,1,1,0); $window->show_all(); Gtk2->main(); sub preview_call { my $bRead = 0; my $bLeft = 0; my $bAvail = 0; my $ret = 0; my $buffer; $bAvail = "\x00" x 4; $ret = PeekNamedPipe($hnd,undef,0,undef,$bAvail,undef); if(!$ret) { my $err = Win32::GetLastError(); die "PNP failed $err $^E"; } $bAvail = unpack('L', $bAvail) . "\n"; if($bAvail > 0) { print "Available: $bAvail\n"; sysread($rfh,$buffer,$bAvail); print $buffer . "\n"; } while (Gtk2->events_pending()) {Gtk2->main_iteration();} return 1; } sub add_job { print $wfh "dir\n\n"; }

thanks a bunch again! I hope somebody finds this helpful too!
Mabuhay Civil Engineers! :D

Replies are listed 'Best First'.
Re^2: ActivePerl Gtk2::Helper Hangs
by bulk88 (Priest) on Nov 30, 2013 at 05:07 UTC
    Yes, that design will not block your GUI, but it is also a polling design (bad!) and low performance (responsiveness of the buffer being read/emptied, which if the buffer in the pipe is filled, the child process's write() call will sync block). The ideal design uses async Win32 ReadFile with an Event object (which goes into WaitForMultipleObjects, which is Glib on Win32's internal loop I think) or an IOCP queue. Doing an async ReadFile with Perl is extremely complex, since the ReadFile in Win32API::File doesn't have any provisions for truncating the read buffer after the read is done, nor any provisons to prevent you from freeing the scalar's buffer from pure Perl during the async reading (while your Perl process is doing other random things, bytes are randomly being written to the memory block given to C ReadFile, eventually Windows will signal you somehow that the "writing" into the memory block is done and you can look at it/take ownership back of the memory block). I might one day release a CPAN module that fixes the lack of any async I/O capabilty of Perl on Win32 that I never finished but does sorta work.
      Hi Bulk88,
      I have updated my codes and added a queuing system to handle the output chronologically.
      I have had problems when sending a single command multiple times at very fast speeds. I have been using this for creating a "live view" for a camera. The previous code was unable to read the output chronologically because of the time it takes for the camera to send a reply. With that I came up with a simple queue system to read all output (depending on the size of the output) and chop the output into lines, and push each line to the array.
      Then I have a another sub that reads 1 line from the array, this is being read continuously.

      Sample Code Below
      #!/usr/bin/perl -w use strict; use Gtk2 '-init'; use Gtk2::Helper; use Data::Dumper; use FileHandle; use IPC::Open2; use Win32API::File; use Win32::API; my @queue; { my $api; die "PeekNamedPipe" if ! ($api= Win32::API->Import("kernel32", " BOOL PeekNamedPipe( HANDLE hNamedPipe, LPVOID lpBuffer, DWORD nBufferSize, LPDWORD lpBytesRead, LPDWORD lpTotalBytesAvail, LPDWORD lpBytesLeftThisMessage );")); } my $wfh = FileHandle->new(); my $rfh = FileHandle->new(); open2($rfh,$wfh,"C:\\Windows\\System32\\cmd.exe"); my $hnd = Win32API::File::FdGetOsFHandle($rfh->fileno()); if($hnd == Win32API::File::INVALID_HANDLE_VALUE()){ die "bad hnd"; } my $tag = Glib::Timeout->add(10,\&repeat_call); my $window = Gtk2::Window->new(); $window->signal_connect("destroy",sub{Gtk2->main_quit();}); my $hbox = Gtk2::VBox->new(); $window->add($hbox); my $button = Gtk2::Button->new("DIR"); $button->signal_connect('clicked'=>sub{ print $wfh "dir\n"; }); $hbox->pack_start($button,0,0,0); $button = Gtk2::Button->new("TIME"); $button->signal_connect('clicked'=>sub{ print $wfh "time /t\n"; }); $hbox->pack_start($button,0,0,0); $window->show_all(); Gtk2->main(); sub repeat_call { my $bAvail = 0; my $ret = 0; my $buffer; $bAvail = "\x00" x 4; $ret = PeekNamedPipe($hnd,undef,0,undef,$bAvail,undef); if(!$ret) { my $err = Win32::GetLastError(); die "PNP failed $err $^E"; } $bAvail = unpack('L', $bAvail) . "\n"; if($bAvail > 0) { sysread($rfh,$buffer,$bAvail); chomp($buffer); my (@q) = split(/\n/,$buffer); foreach my $qq (@q){ chomp($qq); push @queue, $qq; } } action_call(); while (Gtk2->events_pending()) {Gtk2->main_iteration();} return 1; } sub action_call { my $count = @queue; if($count){ my $line = shift(@queue); print $line . "\n"; } }

      This is a bit slow, but still does the work! Thanks again for your inputs! BTW I added this as a reference for my blog. Thanks!
      Mabuhay Civil Engineers! :D
        I would try to remove the "while (Gtk2->events_pending()) {Gtk2->main_iteration();}", it is a waste of memory/stack recursion and CPU. repeat_call is called from a 10 ms timer, from the event loop. When repeat_call returns, more events will run automatically. "while (Gtk2->events_pending()) {Gtk2->main_iteration();}" is to make the app responsive when doing CPU intensive data processing in a single thread. It isn't for generic eventloops running (which is Gtk2->main();). By putting "while (Gtk2->events_pending()) {Gtk2->main_iteration();}" in an event handler, you basically wrote
        sub foo { #process the event if(rand() > 0.5) { foo(); } } foo();
        0.5 might be anywhere from 0.001 to 0.9. IDK what it will be in your app. Never do something with recursion when it can be processed with a loop. You will blow the stack of whatever language you are using. Perl might, but no guarantee of it doing this, give you a "Deep recursion on subroutine "%s"" warning, see Deep recursion on subroutine "%s".