Beefy Boxes and Bandwidth Generously Provided by pair Networks
Clear questions and runnable code
get the best and fastest answer
 
PerlMonks  

ActivePerl Gtk2::Helper Hangs

by renegadex (Beadle)
on Nov 27, 2013 at 10:49 UTC ( [id://1064595]=perlquestion: print w/replies, xml ) Need Help??

renegadex has asked for the wisdom of the Perl Monks concerning the following question:

Hi Monkies, I am making a program in windows that would open a command line and monitor (read) its output, problem is it hangs after it read thru all the buffer. I have a similar code that works fine in linux, but hangs in windows.



#!/usr/bin/perl -w

use strict;
use Gtk2 '-init';
use Gtk2::Helper;
use Data::Dumper;
use IPC::Open2;
use FileHandle;

# file handles
my $wfh = FileHandle->new();
my $rfh = FileHandle->new();
open2($rfh,$wfh, "C:\\Windows\\System32\\cmd.exe");
my $tag = Gtk2::Helper->add_watch($rfh->fileno(), 'in',\&preview_call)
+;


my $window = Gtk2::Window->new();
$window->signal_connect("destroy",sub{Gtk2->main_quit();});
$window->set_size_request(200,200);
    my $vbox = Gtk2::VBox->new();
    $window->add($vbox);
        my $button = Gtk2::Button->new("TEST");
        $button->signal_connect('clicked'=>sub{
                mysub();
            });
        $vbox->pack_start($button,0,0,0);
        
$window->show_all();
Gtk2->main();

sub preview_call {
    my $buffer;
    my $rl = sysread($rfh,$buffer,1);
    if(defined($rl)){
        print "$rl + $buffer\n";
        while (Gtk2->events_pending()) {Gtk2->main_iteration();}
        return 1;
    }else{
        print "undefined\n";
        return 0;
    }
}

sub mysub {
    print $wfh "echo wako\n";
}

[download]


I think the problem is in the Gtk2::Helper->add_watch. Help! This shouldnt freeze the window, i should be able to press the button and the monitor should be able to see the echo command under the mysub subroutine

Mabuhay Civil Engineers! :D

Replies are listed 'Best First'.
Re: ActivePerl Gtk2::Helper Hangs
by syphilis (Archbishop) on Nov 27, 2013 at 12:31 UTC
    I think the problem is in the Gtk2::Helper->add_watch

    For me (on Windows), when I run your script, there's no problem until the Gtk2->main(); is executed (at the last line of your script).

    I don't know if that rules out the possibility that the problem is where you said it is ...

    Cheers,
    Rob
[reply]
[d/l]
      I don't know if that rules out the possibility that the problem is where you said it is ...

      Aaaah ... hang on ... in the Glib-1.301/t/9.t test script we find: 
      } elsif ($^O eq "MSWin32") {
    print "ok 12 # skip add_watch on win32\n";
    print "ok 13 # skip add_watch on win32\n";
    print "ok 14 # skip add_watch on win32\n";
}

      [download]
      This would suggest that add_watch() doesn't work on Windows, and you need to replace it with other code.
      The Gtk2 developers probably have a good idea of what's needed, if no-one here comes forward with a solution.

      Cheers,
      Rob
[reply]
[d/l]
        Hi Syphilis,

        Can you recommend an alternative code? Other way of reading the output of the cmd.exe

        Thanks in Advance! :)
        Mabuhay Civil Engineers! :D
[reply]
Re: ActivePerl Gtk2::Helper Hangs
by bulk88 (Priest) on Nov 28, 2013 at 08:05 UTC
    Running your first script, the perl process hung/blocked on a syncronous read to the NPFS Win32 Named Pipe that is the cmd.exe process std handles. 
         ntdll.dll!_KiFastSystemCallRet@0()     
     ntdll.dll!_NtReadFile@36()  + 0xc    
     kernel32.dll!_ReadFile@20()  + 0x67    
>    msvcr71.dll!_read_lk(int fh=0x00000005, void * buf=0x01ab870c, un
+signed int cnt=0x00000001)  Line 154 + 0x15    C
     msvcr71.dll!_read(int fh=0x00000005, void * buf=0x01ab870c, unsig
+ned int cnt=0x00000001)  Line 75 + 0xc    C
     perl512.dll!win32_read(int fd=0x00000005, void * buf=0x01ab870c, 
+unsigned int cnt=0x00000001)  Line 3746 + 0x12    C
     perl512.dll!PerlLIORead(IPerlLIO * piPerl=0x00285774, int handle=
+0x00000005, void * buffer=0x01ab870c, unsigned int count=0x00000001) 
+ Line 1049 + 0x11    C++
     perl512.dll!Perl_pp_sysread(interpreter * my_perl=0x00393f04)  Li
+ne 1711 + 0x34    C
     perl512.dll!Perl_runops_debug(interpreter * my_perl=0x00393f04)  
+Line 2049 + 0xd    C
     perl512.dll!Perl_call_sv(interpreter * my_perl=0x00393f04, sv * s
+v=0x00829f74, volatile long flags=0x0000000a)  Line 2605 + 0x36    C
     Glib.dll!gperl_closure_marshal(_GClosure * closure=0x00e025d0, _G
+Value * return_value=0x0006f888, unsigned int n_param_values=0x000000
+02, const _GValue * param_values=0x0006f8a8, void * invocation_hint=0
+x00000000, void * marshal_data=0x00393f04)  Line 105 + 0x96    C
     libgobject-2.0-0.dll!g_closure_invoke(_GClosure * closure=0x00e02
+5d0, _GValue * return_value=0x0006f888, unsigned int n_param_values=0
+x00000002, const _GValue * param_values=0x0006f8a8, void * invocation
+_hint=0x00000000)  Line 771 + 0x1b    
     libgobject-2.0-0.dll!io_watch_closure_callback(_GIOChannel * chan
+nel=0x00dcecf0, GIOCondition condition=G_IO_IN, void * data=0x00e025d
+0)  Line 94 + 0x15    
     libglib-2.0-0.dll!g_io_win32_dispatch(_GSource * source=0x00e0258
+0, int (void *)* callback=0x00b3c1c0, void * user_data=0x00e025d0)  L
+ine 979 + 0x1f    
     libglib-2.0-0.dll!g_main_dispatch(_GMainContext * context=0x00dc9
+698)  Line 2442 + 0xf    
     libglib-2.0-0.dll!g_main_context_dispatch(_GMainContext * context
+=0x00dc9698)  Line 3013 + 0x9    
     libglib-2.0-0.dll!g_main_context_iterate(_GMainContext * context=
+0x00dc9698, int block=0x00000001, int dispatch=0x00000001, _GThread *
+ self=0x00dc2ad8)  Line 3091 + 0x9    
     libglib-2.0-0.dll!g_main_loop_run(_GMainLoop * loop=0x00e3c2c8)  
+Line 3299 + 0x13    
     libgtk-win32-2.0-0.dll!gtk_main()  Line 1244 + 0x9    
     Gtk2.dll!XS_Gtk2_main(interpreter * my_perl=0x00393f04, cv * cv=0
+x0098af94)  Line 523    C
     perl512.dll!Perl_pp_entersub(interpreter * my_perl=0x00393f04)  L
+ine 2882 + 0x10    C
     perl512.dll!Perl_runops_debug(interpreter * my_perl=0x00393f04)  
+Line 2049 + 0xd    C
     perl512.dll!S_run_body(interpreter * my_perl=0x00393f04, long old
+scope=0x00000001)  Line 2308 + 0xd    C
     perl512.dll!perl_run(interpreter * my_perl=0x00393f04)  Line 2233
+ + 0xd    C
     perl512.dll!RunPerl(int argc=0x00000002, char * * argv=0x00283e08
+, char * * env=0x00284ed8)  Line 270 + 0x9    C++
     perl.exe!main(int argc=0x00000002, char * * argv=0x00283e08, char
+ * * env=0x00282c88)  Line 23 + 0x12    C
     perl.exe!mainCRTStartup()  Line 398 + 0xe    C
     kernel32.dll!_BaseProcessStart@4()  + 0x23

    [download]
    In Perl, the hang happened at 
    sub preview_call {
    my $buffer;
    my $rl = sysread($rfh,$buffer,1);<<<<<<<<<<<<<<<<<<<<<<<<<<
    if(defined($rl)){
        print "$rl + $buffer\n";
        while (Gtk2->events_pending()) {Gtk2->main_iteration();}
        return 1;
    }else{
        print "undefined\n";
        return 0;
    }
}

    [download]
    Long story short, select() on Win32, in C and in Perl, only works on sockets. Most POSIXy code assumes all FDs/handles are the same "type", so the authors never try to get Win32 async I/O models into their non-blocking POSIX code. You need to call PeekNamedPipe from kernel32 before doing a sysread() or read() from Perl. If the buffer has zero bytes, your read() will hang until some bytes are written to the pipe, or the other end of the pipe is closed.

    Here is some untested code for calling PeekNamedPipe 
    use Win32API::File;
use Win32;
use Win32::API;
{
my $api;
die "PeekNamedPipe"
    if ! ($api= Win32::API::More->Import("kernel32", "
BOOL PeekNamedPipe(
  HANDLE hNamedPipe,
  LPVOID lpBuffer,
  DWORD nBufferSize,
  LPDWORD lpBytesRead,
  LPDWORD lpTotalBytesAvail,
  LPDWORD lpBytesLeftThisMessage
);"));
}
##########################
my ($TotalBytesAvail, $ret) = (0);
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";
}
$ret = PeekNamedPipe($hnd, undef, 0, undef, $TotalBytesAvail, undef);
if(!$ret) {
    my $err = Win32::GetLastError();
    die "PNP failed $err $^E";
 }
if($TotalBytesAvail) {
    #can safely read
}

    [download]
    Code is recycled from https://rt.perl.org/Ticket/Display.html?id=120330.
[reply]
[d/l]
[select]
      Hi Bulk88, thanks for the fast reply, im still studying your code and how to use it. Its quite a handful to absorb hehehe!
      Mabuhay Civil Engineers! :D
[reply]
      Hi bulk88,

      I've been trying to adopt your codes to mine and I get this error that there was an overflow every time I call sub add_job on run-time by pressing the Button A 
      *** unhandled exception in callback:
***   Win32::API::Call: parameter 5 had a buffer overflow at (eval 18)
+ line 2.
***  ignoring at pipecall.pl line 65.

      [download]

      this is my new code 
      #!/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::More->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;
    
    
    $ret = PeekNamedPipe($hnd,undef,0,undef,$bAvail,undef);

    if(!$ret) {
        my $err = Win32::GetLastError();
        die "PNP failed $err $^E";
    }
    
    if($bAvail) {
        print "Available: $bAvail\n";
        sysread($rfh,$buffer,1);
        print $buffer . "\n";
    }else{

    }
    return 1;
}

sub add_job {
    print $wfh "dir\n";
}

      [download]
      Mabuhay Civil Engineers! :D
[reply]
[d/l]
[select]
        I think you hit a bug in Win32::API. 
        2013-06-27  Win32::API v0.76_02    bulk88
..........
   - Fixed, Win32::API::More::Import created Win32::API objs,
     not Win32::API::More

        [download]
        upgrade to 0.76_02 or newer (Win32::API::More objects do automatic packing and unpacking of pointers to numbers, Win32::API objects require you to call pack and unpack yourself to convert the string/buffer filled with C-style binary numbers to Perl numbers)

        or convert the Win32::API::More->Import( to Win32::API->Import(, then pad out $bAvail with $bAvail = "\x00" x 4;, then after PeekNamedPipe, if successful, do unpack('L', $bAvail). Previous sentence is a summary of Win32::API.

        What happened was, because there isn't automatic packing my $bAvail = 0; was stringfied to "0", which is 1 byte long. The C function PeekNamedPipe wrote 4 bytes to $bAvail, even though $bAvail had only 1 byte space. An anti-memory corruption detector in Win32::API caught the mistake.
[reply]
[d/l]
[select]
Re: ActivePerl Gtk2::Helper Hangs
by renegadex (Beadle) on Nov 27, 2013 at 23:12 UTC
    Hi Guys,
    I found out something that might help. Try this code out. 

    #!/usr/bin/perl -w

use strict;
use Gtk2 '-init';
use Gtk2::Helper;
use Data::Dumper;
use IPC::Open2;
use FileHandle;

# file handles
my $wfh = FileHandle->new();
my $rfh = FileHandle->new();
open2($rfh,$wfh, "C:\\Windows\\System32\\cmd.exe");


my $window = Gtk2::Window->new();
$window->signal_connect("destroy",sub{Gtk2->main_quit();});
$window->set_size_request(200,200);
    my $vbox = Gtk2::VBox->new();
    $window->add($vbox);
        my $button = Gtk2::Button->new("WRITE");
        $button->signal_connect('clicked'=>sub{
                write_fh();
            });
        $vbox->pack_start($button,0,0,0);
        $button = Gtk2::Button->new("READ");
        $button->signal_connect('clicked'=>sub{
                read_fh();
            });
        $vbox->pack_start($button,0,0,0);
        
$window->show_all();
Gtk2->main();

sub write_fh {
    print $wfh "dir\n";
}

sub read_fh {
    my $buffer;
    my $resp = sysread($rfh,$buffer,1);
    if($resp){
        if($buffer =~ /\n/){
            print "newline\n";
        }
    }
    print "[$resp]$buffer\n";
}

    [download]


    Run the program and press the read button until it hangs, it always hangs when it encounters the "end of file" but i think its not the end of file because I am reading the output of the command line. I tried using eof($rfh) and it hangs hehehe... Help please

    Mabuhay Civil Engineers! :D
[reply]
[d/l]
Re: ActivePerl Gtk2::Helper Hangs
by renegadex (Beadle) on Nov 29, 2013 at 09:50 UTC
    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";
}

    [download]

    thanks a bunch again! I hope somebody finds this helpful too!
    Mabuhay Civil Engineers! :D
[reply]
[d/l]
      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.
[reply]
        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";
    }
}

        [download]

        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
[reply]
[d/l]

Back to Seekers of Perl Wisdom

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?

www.com | www.net | www.org
Node Status?
node history
Node Type: perlquestion [id://1064595]
Approved by marto
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? • Last hour • Other CB clients
Other Users?
Others chilling in the Monastery: (5)
As of 2024-04-23 11:13 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found