Beefy Boxes and Bandwidth Generously Provided by pair Networks
more useful options
 
PerlMonks  

Gtk2 app on Windows, driving a background process

by kikuchiyo (Hermit)
on May 30, 2017 at 20:45 UTC ( [id://1191637]=perlquestion: print w/replies, xml ) Need Help??

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

Say I have a large, complex Gtk2-Perl GUI application that needs to work on both Linux and Windows. This application also has to start and communicate with a second program, that accepts newline-terminated commands on stdin and responds on stdout.

The problem is that for the GUI to remain responsive reading the application's responses must be done in a non-blocking way. As far as I know, there is no way to put an anonymous pipe into non-blocking mode on Windows, so I can't use open2 or similar because reads would block. I can't or shouldn't use threads because, to quote the documentation, "please lie down and wait until the feeling passes", and they are "discouraged" anyway.

The only way I could think of is to use an external utility, netcat, to start the console program and tie its stdin/stdout to a local socket, and then from the perl program connect to that socket, because those at least I can use in non-blocking mode even on Windows. However, even that was not straightforward, because apparently there is a bug in Glib that makes Glib::IO watchers unusable on recent perls (specifically, the entire event loop freezes the first time any data is received on the socket if perl is 5.18 or newer).

So how to do it in a sane way? Is it possible at all?

  • Comment on Gtk2 app on Windows, driving a background process

Replies are listed 'Best First'.
Re: Gtk2 app on Windows, driving a background process
by marioroy (Prior) on May 31, 2017 at 03:08 UTC

    Hello kikuchiyo,

    The thread Non-blocking Reads from Pipe Filehandle from 10 years ago is a good read. Thank you for posting the link. Queues typically have non-blocking capabilities. Thus, the reason for taking MCE::Hobo and MCE::Shared for a drive.

    I've added a $poll variable to have the timer code leave early unless awaiting a reply.

    #!/usr/bin/perl
##
#   Gtk2 app on Windows, driving a background process:
#   http://www.perlmonks.org/?node_id=1191637
#
#   Gtk2 and MCE::Hobo demonstration base on:
#   http://www.perlmonks.org/?node_id=1191649
##
use strict;
use warnings;

use Gtk2 -init;
use IPC::Open2;
use MCE::Hobo ();
use MCE::Shared ();

my $cmd  = $^O eq 'MSWin32' ? 'bc.exe' : 'bc';
my $qjob = MCE::Shared->queue();
my $qres = MCE::Shared->queue();

sub background {
    my $pid = open2( my $reader, my $writer, $cmd );
    print STDERR "=== pid hobo : $$\n";
    print STDERR "=== pid bc   : $pid\n";
    while ( defined ( my $text = $qjob->dequeue() ) ) {
        print $writer $text;
        $qres->enqueue(scalar <$reader>);
    }
    kill 'TERM', $pid;
    waitpid $pid, 0;
}

my $hobo = MCE::Hobo->create(\&background);

my $w = Gtk2::Window->new();
my $vbox = Gtk2::VBox->new();
my $l = Gtk2::Label->new();
my $i = Gtk2::Entry->new();
my $poll = 0;

$w->signal_connect(destroy => \&cleanup);
$i->signal_connect(activate => sub {
    my $text = $i->get_text();
    $qjob->enqueue("$text\n"), $poll = 1;
    print STDERR ">>> $text\n";
    $i->set_text('');
});

Glib::Timeout->add(60, \&update_label);

# Emulated fork on Windows returns a negative pid.
# The hobo worker can send the bc pid if desired.
# E.g.: $qres->enqueue($pid); from inside hobo
#       my $bc_pid = $qres->dequeue;

$l->set_text( "init ".$hobo->pid() );

$vbox->add($i);
$vbox->add($l);
$w->add($vbox);
$w->show_all();

Gtk2->main();

sub update_label {
    return Glib::SOURCE_CONTINUE unless $poll;
    my $read = $qres->dequeue_nb();
    if (length $read) {
        $poll = 0, chomp $read;
        chop $read if $^O eq 'MSWin32';
        print STDERR "<<< $read\n";
        $l->set_text($read);
    }
    return Glib::SOURCE_CONTINUE;
}

sub cleanup {
    $qjob->end(), $hobo->join();
    Gtk2->main_quit();
}

    [download]

    Regards, Mario.

[reply]
[d/l]
Re: Gtk2 app on Windows, driving a background process
by choroba (Cardinal) on May 30, 2017 at 21:32 UTC
    The threads being "discouraged" just means certain people got tired of answering the same questions again and again. You can use them, and you can even find some Monks who understand them well. Just be prepared for the learning curve and surprises along the way.

    ($q=q:Sq=~/;[c](.)(.)/;chr(-||-|5+lengthSq)`"S|oS2"`map{chr |+ord
}map{substrSq`S_+|`|}3E|-|`7**2-3:)=~y+S|`+$1,++print+eval$q,q,a,

    [download]
[reply]
[d/l]
Re: Gtk2 app on Windows, driving a background process
by huck (Prior) on May 30, 2017 at 23:15 UTC
[reply]
Re: Gtk2 app on Windows, driving a background process
by Marshall (Canon) on May 30, 2017 at 23:16 UTC
    This application also has to start and communicate with a second program, that accepts newline-terminated commands on stdin and responds on stdout.
    This "one text line in" results in "text line out" seems perfect for a TCPIP client-server. Make the second program into a server. The GUI program should start the server (if not already started), which is a wrapper around program 2. Connect with TCP/IP to the server and send your line-in. You can then do a non-blocking read on the incoming socket.
[reply]
Re: Gtk2 app on Windows, driving a background process
by Anonymous Monk on May 30, 2017 at 23:11 UTC

    (OP here, I just don't have my login on this machine)

    Shortly after posting, I did find a solution of sorts, here on Perlmonks, of all places. With some modification to the code found here: Non-blocking Reads from Pipe Filehandle, I was able to make a short example GUI program that seems to work.

    #!/usr/bin/perl

use strict;
use warnings;

use Gtk2 -init;
use Win32API::File qw[ GetOsFHandle ];
use Win32::API qw();
use IPC::Open2;

use constant ERROR_BROKEN_PIPE => 109;

my $PeekNamedPipe = Win32::API::More->new(
    'Kernel32', q[
        BOOL PeekNamedPipe(
            HANDLE hNamedPipe,
            LPVOID lpBuffer,
            DWORD nBufferSize,
            LPDWORD lpBytesRead,
            DWORD *lpTotalBytesAvail,
            LPDWORD lpBytesLeftThisMessage
        )
    ]
) or die $^E;

sub nonblocking_readline {
    my $fh = shift;
    my $osfh = GetOsFHandle( $fh ) or die $^E;
    my( $bufsize, $buffer, $cAvail, $read ) = ( 1024, chr(0)x1024, 0, 
+0 );
    $PeekNamedPipe->Call( $osfh, $buffer, $bufsize, $read, $cAvail, 0 
+) 
        or $^E == ERROR_BROKEN_PIPE or die $^E;
    return if $^E == ERROR_BROKEN_PIPE;
    my $eolPos = 1+index $buffer, $/;
    return '' unless $eolPos;
    sysread( $fh, $buffer, $eolPos ) or die $!;
    return $buffer;
}

my $cmd = 'bc.exe';
my ($reader, $writer);
my $pid = open2($reader, $writer, $cmd);

my $w = Gtk2::Window->new();
my $vbox = Gtk2::VBox->new();
my $l = Gtk2::Label->new();
my $i = Gtk2::Entry->new();
$w->signal_connect(destroy => \&cleanup);
$i->signal_connect(activate => sub {
    my $text = $i->get_text();
    print {$writer} $text . "\n";
    print STDERR ">>> $text\n";
    $i->set_text('');
});

Glib::Timeout->add(100, \&update_label);
#Glib::IO->add_watch(fileno($reader), ['in', 'hup'], \&update_label); 
+# blocks
    
$l->set_text("init $pid\n");

$vbox->add($i);
$vbox->add($l);
$w->add($vbox);
$w->show_all();

Gtk2->main();

sub update_label {
    if ($reader) {
        my $read = nonblocking_readline($reader);

        if (length $read) {
            chomp $read;
            chop $read;
            print STDERR "<<< $read\n";
            $l->set_text($read);
        } elsif (not defined $read) {
            cleanup();
        }
    }
    return Glib::SOURCE_CONTINUE;

}

sub cleanup {
    kill 'TERM', $pid; # XXX
    Gtk2->main_quit;
}

    [download]

    This program puts up a small GUI window and sends the contents of the input field to the background process (which is bc.exe from here), and puts the result in a label.

    You can observe that the GUI is responsive by pasting an expression that takes a long time to calculate (e.g. scale = 20; a = 0; for (i=1; i < 1000000; i++) { a += 1/i^2 }; sqrt(6*a)) and dragging the window around.

    Glib IO watchers don't work here either so I had to poll the reader pipe in a Glib timeout, which is not optimal. But still, it's better than nothing.

    Thanks, BrowserUK-from-10-years-ago and BrowserUK in the present!

[reply]
[d/l]
[select]
Re: Gtk2 app on Windows, driving a background process
by zentara (Archbishop) on May 31, 2017 at 13:34 UTC
    Hi, I don't have any trouble with Glib. Here are few examples. If need be put your stdin reader in a thread. These work well on Linux, I hope they help you sort it out. 
    #!/usr/bin/perl 
use warnings;
use strict;
use Glib;

my $main_loop = Glib::MainLoop->new;

Glib::IO->add_watch (fileno 'STDIN', [qw/in/], \&watch_callback, 'STDI
+N');    

#just to show it's non blocking
my $timer1  = Glib::Timeout->add (100, \&testcallback, undef, 1 );

$main_loop->run;

sub watch_callback {
#    print "@_\n";
    my ($fd, $condition, $fh) = @_;
    my $line = readline STDIN;
    print $line;
    if ($line eq "q\n"){exit}
    #always return TRUE to continue the callback
    return 1;
}    

sub testcallback{
   print "\t\t\t".time."\n";
   return 1;  
}
__END__

    [download]
    or 
    #!/usr/bin/perl -w
use strict;
use Gtk2 -init;
use Glib  qw(TRUE FALSE);


Glib::IO->add_watch (fileno 'STDIN', [qw/in/], \&watch_callback, 'STDI
+N');    

Gtk2->main;

sub watch_callback {

    my ($fd, $condition, $fh) = @_;

        if(sysread(STDIN, my $buf, 1024)){ print "$buf\n" }
      
    #always return TRUE to continue the callback
    return TRUE;
}

    [download]
    or last resort put your stdin reading in a thread. Remember Gtk2 runs on Glib so this will work in a Gtk2 Mainloop as well. I use a Glib mainloop to show the simplicity. 
    #!/usr/bin/perl
use warnings;
use strict;
use Glib;
use Term::ReadKey;
use threads;

$|++;
ReadMode('cbreak');

# works non-blocking if read stdin is in a thread
my $count = 0;
my $thr = threads->new(\&read_in)->detach;

my $main_loop = Glib::MainLoop->new;

my $timer  = Glib::Timeout->add (1000, \&timer_callback, undef, 1 );
# can also have filehandle watches
#my $watcher;
#$watcher = Glib::IO->add_watch( fileno( $pty ), ['in', 'hup'], \&call
+back);

# must be done after main_loop is running
#Glib::Idle->add( sub{});
#print "$ps\n";

my $timer1  = Glib::Timeout->add (10, \&testcallback, undef, 1 );

$main_loop->run;

ReadMode('normal'); # restore normal tty settings

sub testcallback{
    my $ps = `ps auxww`;
    print "$ps\n";
    return 0; #only run once
 }

sub timer_callback{
     #do stuff
     $count++;
     print "\n$count\n";
    return 1;
}

sub read_in{
        while(1){
         my $char;
         if (defined ($char = ReadKey(0)) ) {
            print "\t\t$char->", ord($char),"\n";    
            #process key presses here
            if($char eq 'q'){exit}
            #if(length $char){exit}  # panic button on any key :-)
        
            if($char eq 'p'){
             Glib::Idle->add( 
                   sub{
                     my $ps = `ps auxww`;
                     print "$ps\n";
                     return 0;  # run only once
                   } );
               }
                
            }
          }
}

__END__

    [download]
    I'm not really a human, but I play one on earth. ..... an animated JAPH
[reply]
[d/l]
[select]

      Have you actually tried these on Windows?

      In the first two programs the GUI freezes as soon as I begin to type into STDIN. As for threads, the official FAQ recommends that secondary (worker or other) threads should be created before any GUI widgets, and that the GUI should be touched from only one (the main) thread. In any case, threads would complicate my (real) program to an unacceptable degree.

[reply]
        In the first two programs the GUI freezes as soon as I begin to type into STDIN

        For me on Windows 7, I think the first one might be working fine (as a standalone script, at least). I find that output ceases as soon as I start to enter something into STDIN, but then resumes as soon as I hit 'Enter'.
        Output for me on perl 5.24.0 is: 
        C:\_32\pscrpt\gtk2>perl timer1.pl
                        1496276122
                        1496276122
                        1496276122
                        1496276122
                        1496276122
                        1496276122
my input
my input
                        1496276130
                        1496276131
                        1496276131
                        1496276131
                        1496276131
                        1496276131
                        1496276131
                        1496276131
                        1496276131
my next input
my next input
                        1496276143
                        1496276144
                        1496276144
                        1496276144
                        1496276144
                        1496276144
                        1496276144
                        1496276144
                        1496276144
                        1496276144
                        1496276145
                        ....

        [download]
        However,YMMV.
        Even if that is correct behaviour, the script is definitely buggy on perl-5.16.0.
        I haven't tested versions in between.

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

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://1191637]
Front-paged by Corion
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? • Last hour • Other CB clients
Other Users?
Others scrutinizing the Monastery: (8)
As of 2024-04-18 10:03 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found