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


in reply to Re^2: ActivePerl Gtk2::Helper Hangs
in thread ActivePerl Gtk2::Helper Hangs

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

Replies are listed 'Best First'.
Re^4: ActivePerl Gtk2::Helper Hangs
by bulk88 (Priest) on Dec 17, 2013 at 07:50 UTC
    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".