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.

You may find the technique described here http://www.nntp.perl.org/group/perl.tcltk/2011/03/msg524.html of interest. I use it to talk to various sockets and to vlc via http all the time

This application also has to start and communicate with a second program, that accepts newline-terminated commands on stdin and responds on stdout.

(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!

#!/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]

#!/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]

#!/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]

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.

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

Sorry, I avoid Windows like it's a virus. BrowserUk is the expert on Windows. Read Re^3: How to Multiplex a Client using IO::Select

Just remember, in Gtk2 create your async thread before any Gtk2 statements, even before the "use Gtk2" statement.

---

I'm not really a human, but I play one on earth. ..... an animated JAPH